wip

Author: functora

ghcjs/lightning-verifier/src/App/Types.hs

@@ -38,8 +38,6 @@ import Functora.Miso.Prelude
 import Functora.Miso.Types as X
 import Functora.Money hiding (Currency, Money, Text)
 import qualified Functora.Prelude as Prelude
-import qualified Functora.Rates as Rates
-import qualified Functora.Web as Web
 import qualified Paths_lightning_verifier as Paths
 import qualified Text.URI as URI
 
@@ -49,21 +47,16 @@ data Model = Model
     modelLinks :: OpenedOrClosed,
     modelLoading :: Bool,
     modelState :: St Unique,
-    modelMarket :: MVar Rates.Market,
     modelFavMap :: Map MisoString Fav,
     modelFavName :: Field MisoString Unique,
-    modelCurrencies :: NonEmpty CurrencyInfo,
     modelProducerQueue :: TChan (InstantOrDelayed (Model -> JSM Model)),
-    modelConsumerQueue :: TChan (InstantOrDelayed (Model -> JSM Model)),
-    modelOnlineAt :: UTCTime,
-    modelWebOpts :: Web.Opts
+    modelConsumerQueue :: TChan (InstantOrDelayed (Model -> JSM Model))
   }
   deriving stock (Eq, Generic)
 
 data Action
   = Noop
   | InitUpdate (Maybe Aes.Crypto)
-  | TimeUpdate
   | SyncInputs
   | ChanUpdate Model
   | PushUpdate (InstantOrDelayed (Model -> JSM Model))
@@ -94,8 +87,8 @@ deriving via GenericType (St Identity) instance Binary (St Identity)
 
 data StDoc f = StDoc
   { stDocFieldPairs :: [FieldPair DynamicField f],
-    stDocLnInvoice :: Field MisoString f,
-    stDocCreatedAt :: UTCTime
+    stDocLnPreimage :: Field MisoString f,
+    stDocLnInvoice :: Field MisoString f
   }
   deriving stock (Generic)
 
@@ -115,13 +108,13 @@ deriving via GenericType (StDoc Identity) instance Binary (StDoc Identity)
 
 newStDoc :: (MonadIO m) => m (StDoc Unique)
 newStDoc = do
-  ct <- getCurrentTime
+  r <- newTextField mempty
   ln <- newTextField mempty
   pure
     StDoc
       { stDocFieldPairs = mempty,
-        stDocLnInvoice = ln,
-        stDocCreatedAt = ct
+        stDocLnPreimage = r,
+        stDocLnInvoice = ln
       }
 
 data Screen

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

@@ -156,7 +156,7 @@ favItem st label Fav {favUri = uri} =
       --
       -- TODO : Implement here pure, less costly equivalent of newModel.
       --
-      next <- newModel (st ^. #modelWebOpts) (Just st) uri
+      next <- newModel (Just st) uri
       pure
         $ nextSt
         & #modelFav

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

@@ -127,10 +127,18 @@ screenWidget st@Model {modelState = St {stScreen = Converter}} =
               Field.argsAction = PushUpdate . Delayed 300
             }
           ( Field.defOpts @Model @Action
-              & #optsFullWidth
-              .~ True
               & #optsPlaceholder
-              .~ "Lightning Invoice"
+              .~ "Invoice"
+          ),
+         Field.textField
+          Field.Args
+            { Field.argsModel = st,
+              Field.argsOptic = #modelState . #stDoc . #stDocLnPreimage,
+              Field.argsAction = PushUpdate . Delayed 300
+            }
+          ( Field.defOpts @Model @Action
+              & #optsPlaceholder
+              .~ "Preimage"
           )
        ]
 

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

@@ -8,26 +8,11 @@ import App.Types
 import qualified Functora.Aes as Aes
 import Functora.Cfg
 import Functora.Miso.Prelude
-import qualified Functora.Rates as Rates
-import qualified Functora.Web as Web
 
-newModel ::
-  ( MonadThrow m,
-    MonadUnliftIO m
-  ) =>
-  Web.Opts ->
-  Maybe Model ->
-  URI ->
-  m Model
-newModel webOpts mSt uri = do
-  ct <- getCurrentTime
+newModel :: (MonadThrow m, MonadUnliftIO m) => Maybe Model -> URI -> m Model
+newModel mSt uri = do
   prod <- liftIO newBroadcastTChanIO
   cons <- liftIO . atomically $ dupTChan prod
-  market <-
-    maybe
-      Rates.newMarket
-      pure
-      (mSt ^? _Just . #modelMarket)
   defKm <-
     maybe
       (Aes.randomKm 32)
@@ -103,17 +88,10 @@ newModel webOpts mSt uri = do
         modelLinks = Closed,
         modelLoading = True,
         modelState = st,
-        modelMarket = market,
         modelFavMap = mempty,
         modelFavName = favName,
-        modelCurrencies =
-          fromMaybe
-            [btc, usd]
-            (mSt ^? _Just . #modelCurrencies),
         modelProducerQueue = prod,
-        modelConsumerQueue = cons,
-        modelOnlineAt = fromMaybe ct (mSt ^? _Just . #modelOnlineAt),
-        modelWebOpts = webOpts
+        modelConsumerQueue = cons
       }
 
 newDonateDoc :: IO (StDoc Unique)

ghcjs/lightning-verifier/src/Main.hs

@@ -26,7 +26,6 @@ import qualified Functora.Aes as Aes
 import qualified Functora.Miso.Jsm as Jsm
 import Functora.Miso.Prelude
 import qualified Functora.Prelude as Prelude
-import qualified Functora.Web as Web
 import Language.Javascript.JSaddle ((!), (!!))
 import qualified Language.Javascript.JSaddle as JS
 import qualified Miso
@@ -46,8 +45,7 @@ main =
     $ do
       uri <- URI.mkURI . Prelude.inspect =<< getCurrentURI
       mSt <- unShareUri uri
-      web <- getWebOpts
-      st <- newModel web Nothing uri
+      st <- newModel Nothing uri
       startApp
         App
           { model = st,
@@ -60,15 +58,6 @@ main =
             logLevel = Off
           }
 
-getWebOpts :: JSM Web.Opts
-getWebOpts = do
-#ifdef wasi_HOST_OS
-  ctx <- JS.askJSM
-  pure $ Web.defOpts ctx
-#else
-  pure Web.defOpts
-#endif
-
 #if !defined(__GHCJS__) && !defined(ghcjs_HOST_OS) && !defined(wasi_HOST_OS)
 runApp :: JSM () -> IO ()
 runApp app = do
@@ -116,9 +105,6 @@ updateModel (InitUpdate ext) prevSt = do
   batchEff
     prevSt
     [ do
-        sleepSeconds 60
-        pure TimeUpdate,
-      do
         --
         -- NOTE : making a new pair of TChans to avoid deadlocks
         -- when running in ghcid mode and reloading page without
@@ -149,7 +135,7 @@ updateModel (InitUpdate ext) prevSt = do
                   . (& #modelFavMap %~ fav)
                   . (& #modelLoading .~ False)
               Just uri -> do
-                finSt <- newModel (nextSt ^. #modelWebOpts) (Just nextSt) uri
+                finSt <- newModel (Just nextSt) uri
                 Misc.pushActionQueue nextSt
                   $ Instant
                     ( const
@@ -163,21 +149,6 @@ updateModel (InitUpdate ext) prevSt = do
         pure
           $ ChanUpdate nextSt
     ]
-updateModel TimeUpdate st = do
-  batchEff
-    st
-    [ do
-        sleepSeconds 60
-        pure TimeUpdate,
-      do
-        ct <- getCurrentTime
-        unless (upToDate ct $ st ^. #modelOnlineAt)
-          . Misc.pushActionQueue st
-          . Instant
-          $ pure
-          . id
-        pure Noop
-    ]
 updateModel SyncInputs st = do
   batchEff
     st
@@ -324,9 +295,3 @@ syncUri uri = do
             . from @Prelude.Text @Prelude.String
             $ URI.render nextUri
         )
-
-upToDate :: UTCTime -> UTCTime -> Bool
-upToDate lhs rhs =
-  diff < 3600
-  where
-    diff = abs . toRational $ diffUTCTime lhs rhs

ghcjs/lightning-verifier/test/App/TypesSpec.hs

@@ -5,7 +5,6 @@ import App.Widgets.Templates
 import qualified Data.Aeson as A
 import qualified Data.Generics as Syb
 import Functora.Miso.Prelude hiding (prop)
-import qualified Functora.Web as Web
 import qualified Optics.Generic as Ops
 import qualified Optics.Setter as Ops
 import Test.Hspec
@@ -56,8 +55,8 @@ spec = do
   --   $ over soplate fun expr
   --   `shouldBe` Mul (Sub (Lit 2) (Lit 3)) (Lit 4)
   it "serialization" $ do
-    st0 <- newModel Web.defOpts Nothing =<< URI.mkURI "http://localhost"
+    st0 <- newModel Nothing =<< URI.mkURI "http://localhost"
     uri <- stUri st0
-    st1 <- newModel Web.defOpts Nothing uri
+    st1 <- newModel Nothing uri
     (st0 ^. #modelState . #stDoc . to uniqueToIdentity)
       `shouldBe` (st1 ^. #modelState . #stDoc . to uniqueToIdentity)