Skip to content

Commit 4d750a7

Browse files
locallycompactlocallycompact
committed
Add bech32 encoding for StandardInvoice
1 parent a9e376e commit 4d750a7

File tree

11 files changed

+491
-10
lines changed

11 files changed

+491
-10
lines changed

‎bech32-records/README.md‎

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
1+
# bech32-records
2+
3+
Encodes and decodes "tagged fields" represented as `Word5`s from the [bech32](https://hackage.haskell.org/package/bech32)
4+
library.
5+
6+
This is the expected format for extra metadata in the [BOLT11](https://github.com/lightning/bolts/blob/master/11-payment-encoding.md#tagged-fields) spec.
7+
8+
A bech32 record follows the following standard adapted from the
9+
[Tagged Fields](https://github.com/lightning/bolts/blob/master/11-payment-encoding.md#tagged-fields)
10+
section of the BOLT11 spec.
11+
12+
Each Tagged Field is of the form:
13+
14+
type (5 bits)
15+
data_length (10 bits, big-endian)
16+
data (data_length x 5 bits)
17+
18+
This is deserialised into a `Map` where the key is a single `Word5` and the value is the `data`.

‎bech32-records/bech32-records.cabal‎

Lines changed: 57 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,57 @@
1+
cabal-version: 3.8
2+
name: bech32-records
3+
version: 0.1.0.0
4+
synopsis:
5+
Utilities for converting bech32 data to and from records and lists.
6+
7+
description:
8+
Utilities for converting bech32 data to and from records and lists.
9+
10+
category: Cardano
11+
author: IOG
12+
copyright: IOG 2025
13+
license: Apache-2.0
14+
license-file: LICENSE
15+
build-type: Simple
16+
extra-source-files:
17+
ChangeLog.md
18+
README.md
19+
20+
source-repository head
21+
type: git
22+
location: https://github.com/cardano-scaling/bech32
23+
24+
common lang
25+
build-depends: base >=4.18 && <5
26+
default-language: GHC2021
27+
default-extensions: PackageImports
28+
ghc-options:
29+
-Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude
30+
-Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module
31+
-Wno-safe -Wno-unsafe
32+
33+
library
34+
import: lang
35+
build-depends:
36+
, bech32
37+
, containers
38+
, parsec
39+
40+
exposed-modules: Codec.Binary.Bech32.Records
41+
hs-source-dirs: src
42+
43+
test-suite tests
44+
import: lang
45+
ghc-options: -threaded -rtsopts -with-rtsopts=-N
46+
hs-source-dirs: test
47+
main-is: Main.hs
48+
type: exitcode-stdio-1.0
49+
other-modules: Test.Codec.Binary.Bech32.RecordsSpec
50+
build-depends:
51+
, base
52+
, bech32
53+
, bech32-records
54+
, containers
55+
, hedgehog
56+
, tasty
57+
, tasty-hedgehog

‎bech32-records/src/Codec/Binary/Bech32/Records.hs‎

Lines changed: 121 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,121 @@
1+
-- |
2+
-- Module : Codec.Binary.Bech32.Records
3+
-- Description : Bech32 Tagged Fields
4+
-- Copyright : IOG 2025
5+
-- License : Apache
6+
-- Maintainer : daniel.firth@iohk.io
7+
--
8+
-- A bech32 record follows the following standard adapted from the
9+
-- [Tagged Fields](https://github.com/lightning/bolts/blob/master/11-payment-encoding.md#tagged-fields)
10+
-- section of the BOLT11 spec.
11+
--
12+
-- Each Tagged Field is of the form:
13+
--
14+
-- type (5 bits)
15+
-- data_length (10 bits, big-endian)
16+
-- data (data_length x 5 bits)
17+
--
18+
-- This is deserialised into a `Map` where the key is a single `Word5` and the value is the `Data`.
19+
--
20+
-- Additionally, this module supports encoding and decoding lists and big-endian integers.
21+
module Codec.Binary.Bech32.Records (
22+
-- * Records
23+
parseField,
24+
fieldToWords,
25+
parseRecord,
26+
wordsToRecord,
27+
recordToWords,
28+
29+
-- * Lists
30+
parseElement,
31+
elementToWords,
32+
parseSequence,
33+
wordsToSequence,
34+
sequenceToWords,
35+
36+
-- * Integers
37+
parseIntBE,
38+
wordsToInt,
39+
intToWords,
40+
) where
41+
42+
import "base" Data.List qualified as List
43+
import "bech32" Codec.Binary.Bech32 (Word5)
44+
import "containers" Data.Map (Map)
45+
import "containers" Data.Map qualified as Map
46+
import "parsec" Text.Parsec qualified as P
47+
48+
-- * Records
49+
50+
-- | Parse a single tagged field into a key-value pair.
51+
parseField :: P.Parsec [Word5] a (Word5, [Word5])
52+
parseField = do
53+
typeWord <- P.anyToken
54+
dataWords <- parseElement
55+
pure (typeWord, dataWords)
56+
57+
-- | Print a key-value pair as a sequence of type (5-bits): data_length (10 bits, big-endian) : data (data_length * 5 bits)
58+
fieldToWords :: Word5 -> [Word5] -> [Word5]
59+
fieldToWords typeWord dataWords = typeWord : elementToWords dataWords
60+
61+
-- | Parse a sequence of tagged fields into a `Map`.
62+
parseRecord :: P.Parsec [Word5] a (Map Word5 [Word5])
63+
parseRecord = Map.fromList <$> P.many parseField
64+
65+
-- | Parse a a sequence of tagged fields into a `Map` and run the parser.
66+
wordsToRecord :: [Word5] -> Either P.ParseError (Map Word5 [Word5])
67+
wordsToRecord = P.runParser parseRecord () "Bech32 Record Parser"
68+
69+
-- | Print a `Map` of key-value pairs into a sequence of tagged fields.
70+
recordToWords :: Map Word5 [Word5] -> [Word5]
71+
recordToWords = concatMap (uncurry fieldToWords) . Map.toList
72+
73+
-- * Lists
74+
75+
-- | Parse a single sequent element (just the `data_length : data` section)
76+
parseElement :: P.Parsec [Word5] a [Word5]
77+
parseElement = do
78+
len <- parseIntBE 2
79+
P.count len P.anyToken
80+
81+
-- | Parse many sequence elements into a list.
82+
parseSequence :: P.Parsec [Word5] a [[Word5]]
83+
parseSequence = P.many parseElement
84+
85+
-- | Parse many sequence elements into a list.
86+
wordsToSequence :: [Word5] -> Either P.ParseError [[Word5]]
87+
wordsToSequence = P.runParser parseSequence () "Bech32 Sequence Parser"
88+
89+
-- | Print a single piece of data as a sequence of data_length (10 bits, big-endian) : data (data_length * 5 bits)
90+
elementToWords :: [Word5] -> [Word5]
91+
elementToWords dataWords =
92+
let len = length dataWords
93+
hi = len `div` 32
94+
lo = len `mod` 32
95+
in toEnum hi : toEnum lo : dataWords
96+
97+
-- | Print a list of data as as a sequence using `elementToWords`.
98+
sequenceToWords :: [[Word5]] -> [Word5]
99+
sequenceToWords = concatMap elementToWords
100+
101+
-- * Integers
102+
103+
-- | Parse a big-endian integer with length n.
104+
parseIntBE :: Int -> P.Parsec [Word5] a Int
105+
parseIntBE len = do
106+
integerWords <- P.count len P.anyToken
107+
return $ foldl (\acc w -> acc * 32 + fromEnum w) 0 integerWords
108+
109+
-- | Print a big-endian integer over n bits.
110+
intToWords :: Int -> Int -> [Word5]
111+
intToWords len n
112+
| n < 0 = error "negative number"
113+
| otherwise = map toEnum $ reverse padded
114+
where
115+
lsbDigits = List.unfoldr (\x -> if x == 0 then Nothing else Just (x `mod` 32, x `div` 32)) n
116+
truncated = take len lsbDigits
117+
padded = truncated ++ replicate (len - length truncated) 0
118+
119+
-- | Parse a big-endian integer with length n and run the parser.
120+
wordsToInt :: Int -> [Word5] -> Either P.ParseError Int
121+
wordsToInt len = P.runParser (parseIntBE len) () "Bech32 Integer Parser"

‎bech32-records/test/Main.hs‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
module Main (main) where
2+
3+
import Test.Codec.Binary.Bech32.RecordsSpec (tests)
4+
import Test.Tasty (defaultMain)
5+
6+
main :: IO ()
7+
main = defaultMain tests

‎bech32-records/test/Test/Codec/Binary/Bech32/RecordsSpec.hs‎

Lines changed: 54 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,54 @@
1+
module Test.Codec.Binary.Bech32.RecordsSpec (
2+
tests,
3+
) where
4+
5+
import "base" Control.Monad (replicateM)
6+
import "bech32" Codec.Binary.Bech32 (Word5)
7+
import "bech32-records" Codec.Binary.Bech32.Records qualified as Bech32
8+
import "containers" Data.Map (Map)
9+
import "containers" Data.Map qualified as Map
10+
import "hedgehog" Hedgehog (Gen, Property, Range, forAll, property, tripping)
11+
import "hedgehog" Hedgehog.Gen qualified as Gen
12+
import "hedgehog" Hedgehog.Range qualified as Range
13+
import "tasty" Test.Tasty (TestTree, testGroup)
14+
import "tasty-hedgehog" Test.Tasty.Hedgehog (testProperty)
15+
16+
genList :: Range Int -> Gen [[Word5]]
17+
genList r = do
18+
numLists <- Gen.int r
19+
replicateM numLists (Gen.list r genWord5)
20+
21+
genRecord :: Range Int -> Gen (Map Word5 [Word5])
22+
genRecord r = do
23+
numFields <- Gen.int r
24+
allKeys <- Gen.shuffle [minBound .. maxBound :: Word5]
25+
let keys = take numFields allKeys
26+
values <- traverse (\_ -> Gen.list r genWord5) keys
27+
pure $ Map.fromList (zip keys values)
28+
29+
genWord5 :: Gen Word5
30+
genWord5 = Gen.enumBounded
31+
32+
prop_roundtrip_int :: Property
33+
prop_roundtrip_int = property $ do
34+
xs <- forAll $ Gen.int $ Range.linear 0 (2 ^ 63 - 1)
35+
tripping xs (Bech32.intToWords 16) (Bech32.wordsToInt 16)
36+
37+
prop_roundtrip_list :: Property
38+
prop_roundtrip_list = property $ do
39+
xs <- forAll $ genList $ Range.linear 0 100
40+
tripping xs Bech32.sequenceToWords Bech32.wordsToSequence
41+
42+
prop_roundtrip_record :: Property
43+
prop_roundtrip_record = property $ do
44+
xs <- forAll $ genRecord $ Range.linear 0 100
45+
tripping xs Bech32.recordToWords Bech32.wordsToRecord
46+
47+
tests :: TestTree
48+
tests = do
49+
testGroup
50+
"Codec.Binary.Bech32.Records"
51+
[ testProperty "roundtrip int encoding" prop_roundtrip_int
52+
, testProperty "roundtrip list encoding" prop_roundtrip_list
53+
, testProperty "roundtrip record encoding" prop_roundtrip_record
54+
]

‎hydra-invoices/ChangeLog.md‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,9 @@
11
# Changelog for hydra-invoices
22

3+
## 0.1.0.0
4+
5+
* Add bech32 encoding and decoding functions `encodeStandardInvoice` and `decodeStandardInvoice`.
6+
37
## 0.0.5.0
48

59
* Use `hashWith id` instead of `hashWith CBOR.serialise'`.

‎hydra-invoices/hydra-invoices.cabal‎

Lines changed: 27 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
cabal-version: 3.8
22
name: hydra-invoices
3-
version: 0.0.5.0
3+
version: 0.1.0.0
44
synopsis: Invoice types and functions for Hydra lightning payments.
55
description: Invoice types and functions for Hydra lightning payments.
66
category: Cardano
@@ -32,11 +32,37 @@ common lang
3232
library
3333
import: lang
3434
build-depends:
35+
, bech32
36+
, bech32-records
37+
, bech32-th
3538
, bytestring
3639
, cardano-api
3740
, cardano-crypto-class
41+
, cardano-ledger-mary
42+
, containers
43+
, extra
44+
, parsec
3845
, random
46+
, text
3947
, time
4048

4149
exposed-modules: Hydra.Invoice
4250
hs-source-dirs: src
51+
52+
test-suite tests
53+
import: lang
54+
ghc-options: -threaded -rtsopts -with-rtsopts=-N
55+
hs-source-dirs: test
56+
main-is: Main.hs
57+
type: exitcode-stdio-1.0
58+
other-modules: Test.Hydra.InvoiceSpec
59+
build-depends:
60+
, base
61+
, cardano-api
62+
, cardano-api:gen
63+
, hedgehog
64+
, hydra-invoices
65+
, tasty
66+
, tasty-hedgehog
67+
, text
68+
, time

0 commit comments

Comments
 (0)