bolt11 extra routing info parser

Author: functora

ghcjs/lightning-verifier/lightning-verifier.cabal

@@ -93,6 +93,7 @@ common pkg
     TypeOperators
 
   build-depends:
+    , aeson
     , async
     , barbies
     , base

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

@@ -5,7 +5,9 @@ where
 
 import App.Types
 import qualified Bitcoin.Address as Btc
+import qualified Data.Aeson as A
 import qualified Data.ByteString.Base16 as B16
+import qualified Data.ByteString.Lazy as BL
 import qualified Data.Text.Encoding as T
 import qualified Functora.Bolt11 as B11
 import Functora.Miso.Prelude
@@ -104,7 +106,13 @@ invoiceTagWidget ln = \case
     --
     txt <- either (const mempty) pure . decodeUtf8' $ Btc.renderAddress x
     pure $ pair "Onchain Fallback" $ from @Prelude.Text @MisoString txt
-  B11.ExtraRouteInfo -> mempty
+  B11.ExtraRouteInfo x ->
+    pure
+      . pair "Extra Routing Info"
+      . either (const mempty) (from @Prelude.Text @MisoString)
+      . decodeUtf8'
+      . from @BL.ByteString @ByteString
+      $ A.encode x
   B11.Features x -> pure . pair "Feature Bits" $ B11.inspectFeatures x
   B11.UnknownTag {} -> mempty
   B11.UnparsedTag {} -> mempty

pub/functora/functora.cabal

@@ -246,10 +246,12 @@ common pkg-bolt11
   import:         pkg
   hs-source-dirs: src/bolt11
   build-depends:
+    , aeson
     , attoparsec
     , base
     , base16-bytestring
     , bech32
+    , binary
     , bitcoin-address
     , bytestring
     , text

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

@@ -11,6 +11,7 @@ module Functora.Bolt11
     inspectFeature,
     inspectFeatures,
     RequiredOrSupported (..),
+    Route (..),
     isPaymentHash,
     Network (..),
     Multiplier (..),
@@ -19,6 +20,7 @@ module Functora.Bolt11
     Bolt11Hrp (..),
     Bolt11Sig (..),
     Bolt11 (..),
+    inspectW5,
     decodeBolt11,
   )
 where
@@ -30,7 +32,9 @@ import qualified Bitcoin.Address.Settings as Btc
 import Codec.Binary.Bech32 (Word5)
 import qualified Codec.Binary.Bech32.Internal as Bech32
 import Control.Applicative
+import qualified Data.Aeson as A
 import qualified Data.Attoparsec.Text as Atto
+import qualified Data.Binary.Get as BG
 import Data.Bits (shiftL, (.&.), (.|.))
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Base16 as B16
@@ -86,7 +90,7 @@ data Tag
   | Expiry Int
   | MinFinalCltvExpiry Int
   | OnchainFallback Btc.Address
-  | ExtraRouteInfo
+  | ExtraRouteInfo [Route]
   | Features [Feature]
   | UnknownTag Int [Word5]
   | UnparsedTag Int [Word5] String
@@ -195,6 +199,59 @@ data RequiredOrSupported
   | Supported
   deriving stock (Eq, Ord, Show, Data, Generic)
 
+data Route = Route
+  { routePubKey :: Hex,
+    routeShortChanId :: Hex,
+    routeFeeBaseMsat :: Word32,
+    routeFeePropMillionth :: Word32,
+    routeCltvExpiryDelta :: Word16
+  }
+  deriving stock (Eq, Ord, Show, Data, Generic)
+
+instance A.ToJSON Route where
+  toJSON x =
+    A.object
+      [ "pubkey" A..= inspectHex @Text (routePubKey x),
+        "short_channel_id" A..= inspectHex @Text (routeShortChanId x),
+        "fee_base_msat" A..= routeFeeBaseMsat x,
+        "fee_proportional_millionths" A..= routeFeePropMillionth x,
+        "cltv_expiry_delta" A..= routeCltvExpiryDelta x
+      ]
+  toEncoding x =
+    A.pairs
+      $ "pubkey"
+      A..= inspectHex @Text (routePubKey x)
+        <> "short_channel_id"
+      A..= inspectHex @Text (routeShortChanId x)
+        <> "fee_base_msat"
+      A..= routeFeeBaseMsat x
+        <> "fee_proportional_millionths"
+      A..= routeFeePropMillionth x
+        <> "cltv_expiry_delta"
+      A..= routeCltvExpiryDelta x
+
+parseRoutes :: ByteString -> Either String [Route]
+parseRoutes =
+  bimap thd3 thd3
+    . BG.runGetOrFail
+      ( many
+          $ do
+            pub <- BG.getByteString 33
+            chan <- BG.getByteString 8
+            base <- BG.getWord32be
+            prop <- BG.getWord32be
+            cltv <- BG.getWord16be
+            pure
+              Route
+                { routePubKey = Hex pub,
+                  routeShortChanId = Hex chan,
+                  routeFeeBaseMsat = base,
+                  routeFeePropMillionth = prop,
+                  routeCltvExpiryDelta = cltv
+                }
+      )
+    . BL.fromStrict
+
 isPaymentHash :: Tag -> Bool
 isPaymentHash PaymentHash {} = True
 isPaymentHash _ = False
@@ -382,6 +439,13 @@ w5addr net (v0 : rest) =
   where
     cfg = networkSettings net
 
+inspectW5 :: forall a. (From Text a) => [Word5] -> a
+inspectW5 ws =
+  from @Text @a
+    . either (const . inspect $ fmap fromEnum ws) id
+    $ w5txt ws
+    <|> fmap inspect (w5bs ws)
+
 parseTag :: Network -> [Word5] -> (Maybe Tag, [Word5])
 parseTag _ [] = (Nothing, [])
 parseTag _ ws@[_] = (Nothing, ws)
@@ -410,7 +474,7 @@ parseTag net ws@(t0 : d1 : d2 : rest)
         6 -> Expiry $ w5int dat
         24 -> MinFinalCltvExpiry $ w5int dat
         9 -> mkt OnchainFallback $ w5addr net dat
-        3 -> ExtraRouteInfo
+        3 -> mkt ExtraRouteInfo $ parseRoutes =<< w5bs dat
         5 -> Features $ parseFeatures dat
         n -> UnknownTag n dat
 

pub/functora/src/test/Functora/Bolt11Spec.hs

@@ -57,6 +57,23 @@ goodSamples =
                 . Btc.parsePubHash160
                 $ unHex "04b61f7dc1ea0dc99424464cc4064dc564d91e89",
               ExtraRouteInfo
+                [ Route
+                    { routePubKey =
+                        "029e03a901b85534ff1e92c43c74431f7ce72046060fcf7a95c37e148f78c77255",
+                      routeShortChanId = "0102030405060708",
+                      routeFeeBaseMsat = 1,
+                      routeFeePropMillionth = 20,
+                      routeCltvExpiryDelta = 3
+                    },
+                  Route
+                    { routePubKey =
+                        "039e03a901b85534ff1e92c43c74431f7ce72046060fcf7a95c37e148f78c77255",
+                      routeShortChanId = "030405060708090a",
+                      routeFeeBaseMsat = 2,
+                      routeFeePropMillionth = 30,
+                      routeCltvExpiryDelta = 4
+                    }
+                ]
             ],
           bolt11Signature =
             Bolt11Sig