Skip to content

Commit 9dac0bb

Browse files
functorafunctora
committed
bolt11 refactoring
1 parent 46be634 commit 9dac0bb

File tree

2 files changed

+93
-82
lines changed
  • ghcjs/lightning-verifier/src/App/Widgets
  • pub/functora/src/bolt11/Functora

2 files changed

+93
-82
lines changed

‎ghcjs/lightning-verifier/src/App/Widgets/Bolt11.hs‎

Lines changed: 17 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -64,7 +64,7 @@ invoiceWidget ln =
6464
B11.BitcoinRegtest -> "Bitcoin Regtest"
6565
B11.BitcoinSignet -> "Bitcoin Signet",
6666
pair "Amount"
67-
. maybe "0" defShow
67+
. maybe "0" B11.inspectBolt11HrpAmt
6868
. B11.bolt11HrpAmt
6969
$ B11.bolt11Hrp ln,
7070
pair "Timestamp"
@@ -75,29 +75,33 @@ invoiceWidget ln =
7575
>>= invoiceTagWidget
7676
)
7777
<> [ pair "Signature"
78-
. defShow
78+
. B11.inspectHex
7979
$ B11.bolt11Signature ln
8080
]
8181
)
8282

8383
invoiceTagWidget :: B11.Tag -> [FieldPair DynamicField Identity]
8484
invoiceTagWidget = \case
85-
B11.PaymentHash x -> simple "Preimage Hash" x
86-
B11.PaymentSecret x -> simple "Payment Secret" x
85+
B11.PaymentHash x -> hex "Preimage Hash" x
86+
B11.PaymentSecret x -> hex "Payment Secret" x
8787
B11.Description x -> pure . pair "Description" $ inspect x
88-
B11.PayeePubkey x -> simple "Payee Pubkey" x
89-
B11.DescriptionHash x -> simple "Description Hash" x
90-
B11.Expiry x -> simple "Expiry" x
91-
B11.MinFinalCltvExpiry x -> simple "Min Final CLTV Expiry" x
92-
B11.OnchainFallback x -> simple "Onchain Fallback" x
88+
B11.PayeePubkey x -> hex "Payee Pubkey" x
89+
B11.DescriptionHash x -> hex "Description Hash" x
90+
B11.Expiry x -> pure . pair "Expiry" $ inspect x
91+
B11.MinFinalCltvExpiry x -> pure . pair "Min Final CLTV Expiry" $ inspect x
92+
B11.OnchainFallback x -> hex "Onchain Fallback" x
9393
B11.ExtraRouteInfo -> mempty
94-
B11.FeatureBits x -> simple "Feature Bits" x
94+
B11.FeatureBits x ->
95+
pure
96+
. pair "Feature Bits"
97+
. from @Prelude.String @MisoString
98+
$ Prelude.show x
9599
where
96-
simple :: (Show a) => MisoString -> a -> [FieldPair DynamicField Identity]
97-
simple x =
100+
hex :: MisoString -> B11.Hex -> [FieldPair DynamicField Identity]
101+
hex x =
98102
pure
99103
. pair x
100-
. defShow
104+
. B11.inspectHex
101105

102106
preimageWidget :: MisoString -> ByteString -> [View Action]
103107
preimageWidget rawR r =
@@ -147,11 +151,6 @@ pairs raw =
147151
)
148152
raw
149153

150-
defShow :: (Show a) => a -> MisoString
151-
defShow =
152-
from @Prelude.String @MisoString
153-
. Prelude.show
154-
155154
success :: MisoString -> [View Action]
156155
success msg =
157156
css "app-success"

‎pub/functora/src/bolt11/Functora/Bolt11.hs‎

Lines changed: 76 additions & 64 deletions
Original file line numberDiff line numberDiff line change
@@ -2,15 +2,17 @@
22
{-# LANGUAGE CPP #-}
33

44
module Functora.Bolt11
5-
( Bolt11 (..),
6-
decodeBolt11,
7-
Hex (..),
8-
Multiplier (..),
9-
Network (..),
5+
( Hex (..),
6+
inspectHex,
107
Tag (..),
11-
Bolt11Hrp (..),
12-
Bolt11HrpAmt (..),
138
isPaymentHash,
9+
Network (..),
10+
Multiplier (..),
11+
Bolt11HrpAmt (..),
12+
inspectBolt11HrpAmt,
13+
Bolt11Hrp (..),
14+
Bolt11 (..),
15+
decodeBolt11,
1416
)
1517
where
1618

@@ -31,11 +33,15 @@ import Prelude (Show (..), error, splitAt, take)
3133
newtype Hex = Hex
3234
{ unHex :: ByteString
3335
}
34-
deriving newtype (Eq, Ord)
35-
deriving stock (Data, Generic)
36+
deriving stock (Eq, Ord, Show, Data, Generic)
3637

37-
instance Show Hex where
38-
show (Hex bs) = BL.unpack (BS.toLazyByteString (BS.byteStringHex bs))
38+
inspectHex :: forall a. (From String a) => Hex -> a
39+
inspectHex =
40+
from @String @a
41+
. BL.unpack
42+
. BS.toLazyByteString
43+
. BS.byteStringHex
44+
. unHex
3945

4046
instance IsString Hex where
4147
fromString =
@@ -73,37 +79,69 @@ isPaymentHash :: Tag -> Bool
7379
isPaymentHash PaymentHash {} = True
7480
isPaymentHash _ = False
7581

76-
data Multiplier = Milli | Micro | Nano | Pico
77-
deriving stock (Eq, Ord, Show, Data, Generic)
78-
7982
data Network
8083
= BitcoinMainnet
8184
| BitcoinTestnet
8285
| BitcoinRegtest
8386
| BitcoinSignet
8487
deriving stock (Eq, Ord, Show, Data, Generic)
8588

89+
data Multiplier = Milli | Micro | Nano | Pico
90+
deriving stock (Eq, Ord, Show, Data, Generic)
91+
8692
data Bolt11HrpAmt = Bolt11HrpAmt
8793
{ bolt11HrpAmtNum :: Integer,
8894
bolt11HrpAmtMul :: Multiplier
8995
}
90-
deriving stock (Eq, Ord, Data, Generic)
91-
92-
instance Show Bolt11HrpAmt where
93-
show (Bolt11HrpAmt amt mul) =
94-
if sat > 1_000_000
95-
then inspectBtcNum btc <> " BTC"
96-
else
97-
if (round sat) % 1 == sat
98-
then inspectBtcNum sat <> " Satoshi"
99-
else inspectBtcNum msat <> " Millisatoshi"
100-
where
101-
btc :: Rational
102-
btc = (amt % 1) * multiplierRatio mul
103-
sat :: Rational
104-
sat = btc * 1_0000_0000
105-
msat :: Rational
106-
msat = sat * 1000
96+
deriving stock (Eq, Ord, Show, Data, Generic)
97+
98+
inspectBolt11HrpAmt ::
99+
( From String a,
100+
Semigroup a,
101+
IsString a
102+
) =>
103+
Bolt11HrpAmt ->
104+
a
105+
inspectBolt11HrpAmt (Bolt11HrpAmt amt mul) =
106+
if sat > 1_000_000
107+
then inspectBolt11HrpAmt' btc <> " BTC"
108+
else
109+
if (round sat) % 1 == sat
110+
then inspectBolt11HrpAmt' sat <> " Satoshi"
111+
else inspectBolt11HrpAmt' msat <> " Millisatoshi"
112+
where
113+
btc :: Rational
114+
btc = (amt % 1) * multiplierRatio mul
115+
sat :: Rational
116+
sat = btc * 1_0000_0000
117+
msat :: Rational
118+
msat = sat * 1000
119+
120+
inspectBolt11HrpAmt' ::
121+
forall a b.
122+
( From String a,
123+
From b Integer,
124+
Integral b
125+
) =>
126+
Ratio b ->
127+
a
128+
inspectBolt11HrpAmt' =
129+
inspectRatio
130+
RatioFormat
131+
{ ratioFormatDoRounding = True,
132+
ratioFormatThousandsSeparator = mempty,
133+
ratioFormatDecimalPlacesAfterNonZero = Just 12, -- Pico
134+
ratioFormatDecimalPlacesTotalLimit = Just 12, -- Pico
135+
ratioFormatDecimalPlacesTotalLimitOverflow = DecimalPlacesOverflowExponent
136+
}
137+
138+
multiplierRatio :: Multiplier -> Rational
139+
multiplierRatio m =
140+
case m of
141+
Milli -> 1 % 1000
142+
Micro -> 1 % 1000000
143+
Nano -> 1 % 1000000000
144+
Pico -> 1 % 1000000000000
107145

108146
data Bolt11Hrp = Bolt11Hrp
109147
{ bolt11HrpNet :: Network,
@@ -142,8 +180,8 @@ parseHrpAmount = do
142180
mul <- parseMultiplier
143181
pure $ Bolt11HrpAmt amt mul
144182

145-
hrpParser :: Parser Bolt11Hrp
146-
hrpParser = do
183+
parseHrp :: Parser Bolt11Hrp
184+
parseHrp = do
147185
_ <- char 'l'
148186
_ <- char 'n'
149187
net <- parseNetwork
@@ -205,39 +243,13 @@ tagsParser ws
205243
mtag
206244

207245
decodeBolt11 :: Text -> Either String Bolt11
208-
decodeBolt11 txt = do
209-
(hrp, w5s) <- first show $ Bech32.decodeLenient txt
210-
let (timestampBits, rest) = splitAt 7 $ Bech32.dataPartToWords w5s
246+
decodeBolt11 raw = do
247+
(rawHrp, rawDp) <- first show $ Bech32.decodeLenient raw
248+
let (timestampBits, rest) = splitAt 7 $ Bech32.dataPartToWords rawDp
211249
timestamp = w5int timestampBits
212250
(tags, leftover) = tagsParser rest
213251
sig <- case leftover of
214252
Sig ws -> maybe (Left "corrupt") Right (Bech32.toBase256 ws)
215253
Unk left -> Left ("corrupt, leftover: " ++ show (Hex (w5bs left)))
216-
parsedHrp <- parseOnly hrpParser $ Bech32.humanReadablePartToText hrp
217-
Right (Bolt11 parsedHrp timestamp tags (Hex (BS.pack sig)))
218-
219-
multiplierRatio :: Multiplier -> Rational
220-
multiplierRatio m =
221-
case m of
222-
Milli -> 1 % 1000
223-
Micro -> 1 % 1000000
224-
Nano -> 1 % 1000000000
225-
Pico -> 1 % 1000000000000
226-
227-
inspectBtcNum ::
228-
forall a b.
229-
( From String a,
230-
From b Integer,
231-
Integral b
232-
) =>
233-
Ratio b ->
234-
a
235-
inspectBtcNum =
236-
inspectRatio
237-
RatioFormat
238-
{ ratioFormatDoRounding = True,
239-
ratioFormatThousandsSeparator = mempty,
240-
ratioFormatDecimalPlacesAfterNonZero = Just 12, -- Pico
241-
ratioFormatDecimalPlacesTotalLimit = Just 12, -- Pico
242-
ratioFormatDecimalPlacesTotalLimitOverflow = DecimalPlacesOverflowExponent
243-
}
254+
hrp <- parseOnly parseHrp $ Bech32.humanReadablePartToText rawHrp
255+
Right (Bolt11 hrp timestamp tags (Hex (BS.pack sig)))

0 commit comments

Comments
 (0)