bolt11 wip

Author: functora

ghcjs/lightning-verifier/default.nix

@@ -1,8 +1,8 @@
 let
   # functora = ../..;
   functora = fetchTarball {
-    url = "https://github.com/functora/functora.github.io/archive/03df5e6d39d0fdc31a53cc350e1125118b4a12ca.tar.gz";
-    sha256 = "0pad1981bpnl1szvlhgl00ai9ikz9nsl4yv6mxxv0q46j10bdchz";
+    url = "https://github.com/functora/functora.github.io/archive/27d58e2f02ed0d17c94e3346f7d45731f8f6b06c.tar.gz";
+    sha256 = "0mh2fygiclggyl31jhjbgzxpbl933nx10xmz3xl1798bpc0wl2j2";
   };
   legacy = fetchTarball {
     url = "https://github.com/functora/functora.github.io/archive/7a06c850a579058f495ca2d7e5e2f8682ea0998f.tar.gz";

ghcjs/lightning-verifier/lightning-verifier.cabal

@@ -27,6 +27,7 @@ common pkg
   other-modules:
     App.Misc
     App.Types
+    App.Widgets.Bolt11
     App.Widgets.Decrypt
     App.Widgets.Fav
     App.Widgets.Main

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

@@ -0,0 +1,44 @@
+module App.Widgets.Bolt11
+  ( bolt11,
+  )
+where
+
+import App.Types
+import qualified Functora.Bolt11 as Bolt11
+import Functora.Miso.Prelude
+import qualified Functora.Miso.Widgets.FieldPairs as FieldPairs
+import qualified Prelude
+
+bolt11 :: Model -> [View Action]
+bolt11 st =
+  if ln == mempty
+    then mempty
+    else case Bolt11.decodeBolt11 ln of
+      Left e ->
+        widget
+          [ newFieldPairId mempty
+              . DynamicFieldText
+              $ from @Prelude.String @MisoString e
+          ]
+      Right b11 ->
+        widget
+          $ [ simple "Network" . Bolt11.bolt11Currency $ Bolt11.bolt11HRP b11,
+              simple "Amount" . Bolt11.bolt11Amount $ Bolt11.bolt11HRP b11,
+              simple "Timestamp" $ Bolt11.bolt11Timestamp b11
+            ]
+          <> fmap (simple "Tag") (Bolt11.bolt11Tags b11)
+          <> [simple "Signature" $ Bolt11.bolt11Signature b11]
+  where
+    -- r = st ^. #modelState . #stDoc . #stDocLnPreimage . #fieldOutput
+    ln = st ^. #modelState . #stDoc . #stDocLnInvoice . #fieldOutput
+    simple x = newFieldPairId x . DynamicFieldText . inspect
+    widget xs =
+      FieldPairs.fieldPairsViewer
+        FieldPairs.Args
+          { FieldPairs.argsModel = xs,
+            FieldPairs.argsOptic = id,
+            FieldPairs.argsAction =
+              \fun -> PushUpdate . Instant $ \next -> do
+                void $ fun xs
+                pure next
+          }

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

@@ -1,6 +1,7 @@
 module App.Widgets.Main (mainWidget) where
 
 import App.Types
+import qualified App.Widgets.Bolt11 as Bolt11
 import qualified App.Widgets.Decrypt as Decrypt
 import qualified App.Widgets.Menu as Menu
 import qualified Functora.Miso.Css as Css
@@ -141,6 +142,7 @@ screenWidget st@Model {modelState = St {stScreen = Converter}} =
               .~ "Preimage"
           )
        ]
+    <> Bolt11.bolt11 st
 
 tosWidget :: View Action
 tosWidget =

ghcjs/miso-widgets/src/Functora/Miso/Types.hs

@@ -8,6 +8,7 @@ module Functora.Miso.Types
     newUniqueDuplicator,
     Field (..),
     newField,
+    newFieldId,
     newRatioField,
     newTextField,
     newPasswordField,
@@ -21,6 +22,7 @@ module Functora.Miso.Types
     userFieldType,
     FieldPair (..),
     newFieldPair,
+    newFieldPairId,
     Currency (..),
     newCurrency,
     Money (..),
@@ -139,6 +141,16 @@ newField typ output newInput = do
         fieldModalState = Closed
       }
 
+newFieldId :: FieldType -> a -> Field a Identity
+newFieldId typ output =
+  Field
+    { fieldType = typ,
+      fieldInput = mempty,
+      fieldOutput = output,
+      fieldAllowCopy = True,
+      fieldModalState = Closed
+    }
+
 newRatioField :: (MonadIO m) => Rational -> m (Field Rational Unique)
 newRatioField output =
   newField FieldTypeNumber output inspectRatioDef
@@ -251,6 +263,18 @@ newFieldPair key val =
     <$> newTextField key
     <*> newDynamicField val
 
+newFieldPairId :: MisoString -> DynamicField -> FieldPair DynamicField Identity
+newFieldPairId key val =
+  FieldPair
+    (newFieldId FieldTypeText key)
+    ( newFieldId
+        ( case val of
+            DynamicFieldNumber {} -> FieldTypeNumber
+            DynamicFieldText {} -> FieldTypeText
+        )
+        val
+    )
+
 data Currency f = Currency
   { currencyInput :: Field MisoString f,
     currencyOutput :: CurrencyInfo,

ghcjs/miso-widgets/src/Functora/Miso/Widgets/Field.hs

@@ -702,9 +702,9 @@ constTextField txt opts action =
 -- TODO : support optional copying widgets
 --
 dynamicFieldViewer ::
-  forall model action.
+  forall model action f.
   ((model -> JSM model) -> action) ->
-  Field DynamicField Unique ->
+  Field DynamicField f ->
   [View action]
 dynamicFieldViewer action value =
   case value ^. #fieldType of

ghcjs/miso-widgets/src/Functora/Miso/Widgets/FieldPairs.hs

@@ -12,21 +12,21 @@ import qualified Functora.Miso.Widgets.Field as Field
 import qualified Functora.Miso.Widgets.Grid as Grid
 import qualified Material.Typography as Typography
 
-data Args model action = Args
+data Args model action f = Args
   { argsModel :: model,
-    argsOptic :: ATraversal' model [FieldPair DynamicField Unique],
+    argsOptic :: ATraversal' model [FieldPair DynamicField f],
     argsAction :: (model -> JSM model) -> action
   }
   deriving stock (Generic)
 
-fieldPairsViewer :: Args model action -> [View action]
+fieldPairsViewer :: Args model action f -> [View action]
 fieldPairsViewer args@Args {argsOptic = optic} = do
   item <- fromMaybe mempty $ args ^? #argsModel . cloneTraversal optic
   fieldPairViewer args item
 
 fieldPairViewer ::
-  Args model action ->
-  FieldPair DynamicField Unique ->
+  Args model action f ->
+  FieldPair DynamicField f ->
   [View action]
 fieldPairViewer args pair =
   ( if k == mempty
@@ -71,14 +71,14 @@ fieldPairViewer args pair =
         then Grid.bigCell
         else Grid.mediumCell
 
-fieldPairsEditor :: Args model action -> [View action]
+fieldPairsEditor :: Args model action Unique -> [View action]
 fieldPairsEditor args@Args {argsModel = st, argsOptic = optic} = do
   idx <- fst <$> zip [0 ..] (fromMaybe mempty $ st ^? cloneTraversal optic)
   fieldPairEditor args idx
 
 fieldPairEditor ::
   forall model action.
-  Args model action ->
+  Args model action Unique ->
   Int ->
   [View action]
 fieldPairEditor Args {argsModel = st, argsOptic = optic, argsAction = action} idx =

ghcjs/overlays.nix

@@ -171,7 +171,13 @@
                   {};
                 functora-ghcjs =
                   self.callCabal2nix
-                  "functora-ghcjs" "${functora}/pub/functora/src" {};
+                  "functora-ghcjs"
+                  (
+                    pkgs.nix-gitignore.gitignoreSourcePure
+                    ./../.gitignore
+                    ./../pub/functora/src
+                  )
+                  {};
               }
             );
         });

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

@@ -40,13 +40,15 @@ import Data.Bits
   )
 import qualified Data.ByteString as B
 import Data.Char (toUpper)
+import qualified Data.Data as D
 import Data.Foldable (foldl')
 import Data.Functor.Identity (Identity, runIdentity)
 import Data.Ix (Ix (..))
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
 import Data.Word (Word8)
+import GHC.Generics (Generic)
 import Prelude
 
 -- | Bech32 human-readable string.
@@ -66,6 +68,7 @@ type Data = [Word8]
 newtype Word5
   = UnsafeWord5 Word8
   deriving newtype (Eq, Ord, Num)
+  deriving stock (D.Data, Generic)
 
 instance Show Word5 where
   show (UnsafeWord5 w8) = show w8

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

@@ -23,6 +23,7 @@ import qualified Data.ByteString as BS
 import qualified Data.ByteString.Base16 as B16
 import qualified Data.ByteString.Builder as BS
 import qualified Data.ByteString.Lazy.Char8 as BL
+import Data.Data (Data)
 import Data.Foldable (foldl')
 import Data.Maybe (fromMaybe)
 import Data.String (IsString (..))
@@ -32,10 +33,12 @@ import Data.Text.Encoding (decodeUtf8)
 import qualified Data.Text.Encoding as T
 import Functora.Bech32 (Word5 (..), bech32Decode, toBase256)
 import Functora.Denomination (Denomination (toMsats), MSats, btc)
+import GHC.Generics (Generic)
 import Prelude
 
 newtype Hex = Hex {getHex :: ByteString}
   deriving newtype (Eq, Ord)
+  deriving stock (Data, Generic)
 
 instance Show Hex where
   show (Hex bs) = BL.unpack (BS.toLazyByteString (BS.byteStringHex bs))
@@ -70,7 +73,7 @@ data Tag
   | OnchainFallback Hex -- TODO: address type
   | ExtraRouteInfo
   | FeatureBits [Word5]
-  deriving stock (Eq, Ord, Show)
+  deriving stock (Eq, Ord, Show, Data, Generic)
 
 isPaymentHash :: Tag -> Bool
 isPaymentHash PaymentHash {} = True
@@ -81,16 +84,17 @@ isDescription Description {} = True
 isDescription _ = False
 
 data Multiplier = Milli | Micro | Nano | Pico
-  deriving stock (Eq, Ord, Show)
+  deriving stock (Eq, Ord, Show, Data, Generic)
 
 data Currency
   = Bitcoin
   | BitcoinTestnet
   | BitcoinRegtest
-  deriving stock (Eq, Ord, Show)
+  deriving stock (Eq, Ord, Show, Data, Generic)
 
 newtype Bolt11Amount = Bolt11Amount {_getBolt11Amount :: (Int, Multiplier)}
   deriving newtype (Eq, Ord)
+  deriving stock (Data, Generic)
 
 instance Show Bolt11Amount where
   show amt = show (bolt11Msats amt)
@@ -99,15 +103,15 @@ data Bolt11HRP = Bolt11HRP
   { bolt11Currency :: Currency,
     bolt11Amount :: Maybe Bolt11Amount
   }
-  deriving stock (Eq, Ord, Show)
+  deriving stock (Eq, Ord, Show, Data, Generic)
 
 data Bolt11 = Bolt11
   { bolt11HRP :: Bolt11HRP,
     bolt11Timestamp :: Int, -- posix
     bolt11Tags :: [Tag], -- posix
     bolt11Signature :: Hex
   }
-  deriving stock (Eq, Ord, Show)
+  deriving stock (Eq, Ord, Show, Data, Generic)
 
 parseCurrency :: Parser Currency
 parseCurrency =
@@ -185,7 +189,7 @@ tagParser ws@(UnsafeWord5 typ : d1 : d2 : rest)
 data MSig
   = Sig [Word5]
   | Unk [Word5]
-  deriving stock (Eq, Ord, Show)
+  deriving stock (Eq, Ord, Show, Data, Generic)
 
 tagsParser :: [Word5] -> ([Tag], MSig)
 tagsParser ws