GHCJS MisoString optimizations

Author: functora

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

@@ -14,7 +14,6 @@ module App.Types
     stUri,
     setScreenPure,
     setScreenAction,
-    shareLink,
     vsn,
     usd,
     btc,
@@ -30,16 +29,18 @@ where
 import qualified Data.ByteString.Base64.URL as B64URL
 import qualified Data.ByteString.Lazy as BL
 import Data.Functor.Barbie
-import qualified Data.Text as T
 import qualified Data.Version as Version
 import qualified Functora.Aes as Aes
 import Functora.Cfg
 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 Miso.String as MS
 import qualified Paths_lightning_verifier as Paths
 import qualified Text.URI as URI
+import qualified Text.URI.QQ as URI
+import qualified Prelude
 
 data Model = Model
   { modelFav :: OpenedOrClosed,
@@ -229,7 +230,7 @@ stQuery st = do
 
 stUri :: (MonadThrow m) => Model -> m URI
 stUri st = do
-  uri <- mkURI $ fromMisoString baseUri
+  uri <- mkURI $ fromMisoString @Prelude.Text baseUri
   qxs <- stQuery . uniqueToIdentity $ st ^. #modelState
   pure
     $ uri
@@ -285,17 +286,10 @@ setScreenAction =
     . Instant
     . setScreenPure
 
-shareLink :: forall a. (From Prelude.Text a) => Model -> a
-shareLink =
-  from @Prelude.Text @a
-    . either impureThrow URI.render
-    . stUri
-
 vsn :: MisoString
 vsn =
-  from @Prelude.Text @MisoString
-    . T.intercalate "."
-    . fmap Prelude.inspect
+  MS.intercalate "."
+    . fmap (toMisoString @Prelude.String . Prelude.show)
     $ Version.versionBranch Paths.version
 
 usd :: CurrencyInfo
@@ -304,23 +298,29 @@ usd = CurrencyInfo (CurrencyCode "usd") mempty
 btc :: CurrencyInfo
 btc = CurrencyInfo (CurrencyCode "btc") mempty
 
-googlePlayLink :: Prelude.Text
-googlePlayLink = "https://play.google.com/apps/testing/com.functora.lightning_verifier"
+googlePlayLink :: URI
+googlePlayLink =
+  [URI.uri|https://play.google.com/apps/testing/com.functora.lightning_verifier|]
 
-testGroupLink :: Prelude.Text
-testGroupLink = "https://groups.google.com/g/currency-converter"
+testGroupLink :: URI
+testGroupLink =
+  [URI.uri|https://groups.google.com/g/currency-converter|]
 
-functoraLink :: Prelude.Text
-functoraLink = "https://functora.github.io/"
+functoraLink :: URI
+functoraLink =
+  [URI.uri|https://functora.github.io/|]
 
-sourceLink :: Prelude.Text
+sourceLink :: URI
 sourceLink =
-  "https://github.com/functora/functora.github.io/tree/master/ghcjs/lightning-verifier"
+  [URI.uri|https://github.com/functora/functora.github.io/tree/master/ghcjs/lightning-verifier|]
 
-apkLink :: Prelude.Text
+apkLink :: URI
 apkLink =
-  "https://github.com/functora/functora.github.io/releases/download/lightning-verifier-v"
-    <> fromMisoString vsn
+  either impureThrow id
+    . URI.mkURI
+    . fromMisoString @Prelude.Text
+    $ "https://github.com/functora/functora.github.io/releases/download/lightning-verifier-v"
+    <> vsn
     <> "/lightning-verifier-v"
-    <> fromMisoString vsn
+    <> vsn
     <> ".apk"

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

@@ -10,7 +10,6 @@ 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
 import qualified Functora.Miso.Widgets.FieldPairs as FieldPairs
@@ -123,9 +122,9 @@ makeBolt11Viewer st =
     rawR = st ^. #stDocLnPreimage . #fieldOutput
     ln :: Either MisoString B11.Bolt11
     ln =
-      first (mappend "Bad invoice - " . from @Prelude.String @MisoString)
+      first (mappend "Bad invoice - " . toMisoString @Prelude.String)
         . B11.decodeBolt11
-        $ from @MisoString @Prelude.Text rawLn
+        $ fromMisoString @Prelude.Text rawLn
     rh :: Either MisoString ByteString
     rh = ln >>= parsePreimageHash
     r :: Either MisoString ByteString
@@ -149,12 +148,13 @@ plain =
 
 parsePreimage :: MisoString -> Either MisoString ByteString
 parsePreimage rawR =
-  case B16.decode . T.encodeUtf8 $ from @MisoString @Prelude.Text rawR of
+  case B16.decode $ fromMisoString @ByteString rawR of
     (r, "") -> Right r
     (_, e) ->
       Left
+        . toMisoString @Prelude.String
         $ "Bad preimage - non hex leftover "
-        <> from @Prelude.String @MisoString (Prelude.show e)
+        <> Prelude.show e
 
 parsePreimageHash :: B11.Bolt11 -> Either MisoString ByteString
 parsePreimageHash ln =
@@ -180,7 +180,11 @@ invoiceFields ln =
         B11.BitcoinRegtest -> "Bitcoin Regtest"
         B11.BitcoinSignet -> "Bitcoin Signet",
     pair "Amount"
-      . maybe "0" B11.inspectBolt11HrpAmt
+      . maybe
+        "0"
+        ( toMisoString @Prelude.String
+            . B11.inspectBolt11HrpAmt
+        )
       . B11.bolt11HrpAmt
       $ B11.bolt11Hrp ln,
     pair "Created At"
@@ -191,6 +195,7 @@ invoiceFields ln =
           >>= invoiceFieldsTag ln
        )
     <> [ pair "Signature"
+          . toMisoString @Prelude.String
           . B11.inspectHex
           $ B11.bolt11SigVal sig,
          pair "Pubkey Recovery Flag"
@@ -212,20 +217,21 @@ invoiceFieldsTag ln = \case
     pure . pair "Expires At" . inspectTimestamp $ x + B11.bolt11Timestamp ln
   B11.MinFinalCltvExpiry x ->
     pure . pair "Min Final CLTV Expiry" $ inspect x <> " Blocks"
-  B11.OnchainFallback x -> do
-    --
-    -- TODO : do not ignore failure?
-    --
-    txt <- either (const mempty) pure . decodeUtf8' $ Btc.renderAddress x
-    pure $ pair "Onchain Fallback" $ from @Prelude.Text @MisoString txt
+  B11.OnchainFallback x ->
+    pure
+      . pair "Onchain Fallback"
+      . toMisoString @ByteString
+      $ Btc.renderAddress x
   B11.ExtraRouteInfo x ->
     pure
       . pair "Extra Routing Info"
-      . either (const mempty) (from @Prelude.Text @MisoString)
-      . decodeUtf8'
-      . from @BL.ByteString @ByteString
+      . toMisoString @BL.ByteString
       $ A.encode x
-  B11.Features x -> pure . pair "Feature Bits" $ B11.inspectFeatures x
+  B11.Features x ->
+    pure
+      . pair "Feature Bits"
+      . toMisoString @Prelude.Text
+      $ B11.inspectFeatures x
   B11.UnknownTag {} -> mempty
   B11.UnparsedTag {} -> mempty
   where
@@ -239,6 +245,7 @@ invoiceFieldsTag ln = \case
     hex x =
       pure
         . pair x
+        . toMisoString @Prelude.String
         . B11.inspectHex
 
 preimageFields :: MisoString -> ByteString -> [FieldPair DynamicField Identity]

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

@@ -6,15 +6,14 @@ where
 import App.Types
 import App.Widgets.Templates
 import qualified Data.Map as Map
-import qualified Data.Text as T
 import qualified Functora.Miso.Css as Css
 import qualified Functora.Miso.Jsm as Jsm
 import Functora.Miso.Prelude
 import qualified Functora.Miso.Widgets.Field as Field
 import qualified Functora.Miso.Widgets.Grid as Grid
 import qualified Material.Button as Button
 import qualified Material.Dialog as Dialog
-import qualified Text.URI as URI
+import qualified Miso.String as MS
 
 fav :: Model -> [View Action]
 fav st =
@@ -75,8 +74,8 @@ fav st =
     closeAction = PushUpdate . Instant $ pure . (& #modelFav .~ Closed)
     saveAction nextSt = do
       ct <- getCurrentTime
+      uri <- stUri nextSt
       let txt = makeFavName st
-      let uri = either impureThrow id . URI.mkURI $ shareLink nextSt
       let nextFav = Fav {favUri = uri, favCreatedAt = ct}
       let nextFavName = makeFavName nextSt
       Jsm.popupText
@@ -114,14 +113,10 @@ fav st =
         else Jsm.enterOrEscapeBlur uid code
 
 makeFavName :: Model -> MisoString
-makeFavName st =
-  toMisoString
-    . T.toUpper
-    . T.strip
-    $ fromMisoString preFavName
-  where
-    preFavName =
-      st ^. #modelFavName . #fieldInput . #uniqueValue
+makeFavName =
+  MS.toUpper
+    . MS.strip
+    . (^. #modelFavName . #fieldInput . #uniqueValue)
 
 favItems :: Model -> [View Action]
 favItems st =

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

@@ -209,7 +209,7 @@ tosWidget =
     [ Miso.text "\169 2024 ",
       BrowserLink.browserLink
         BrowserLink.Args
-          { BrowserLink.argsLink = "https://functora.github.io/",
+          { BrowserLink.argsLink = functoraLink,
             BrowserLink.argsLabel = "Functora",
             BrowserLink.argsAction = PushUpdate . Instant
           },

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

@@ -20,6 +20,7 @@ import qualified Material.IconButton as IconButton
 import qualified Material.Theme as Theme
 import qualified Material.TopAppBar as TopAppBar
 import qualified Text.URI as URI
+import qualified Prelude
 
 menu :: Model -> [View Action]
 menu st =
@@ -108,7 +109,9 @@ menu st =
                         ( PushUpdate
                             . Instant
                             . Jsm.shareText
-                            $ shareLink @MisoString st
+                            . toMisoString @Prelude.String
+                            . either impureThrow URI.renderStr
+                            $ stUri st
                         )
                       & IconButton.setAttributes
                         [ TopAppBar.actionItem,
@@ -458,5 +461,3 @@ linksWidget st =
       PushUpdate
         . Instant
         . Jsm.openBrowserPage
-        . either impureThrow id
-        . URI.mkURI

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

@@ -9,6 +9,7 @@ import qualified App.Widgets.Bolt11 as B11
 import qualified Functora.Aes as Aes
 import Functora.Cfg
 import Functora.Miso.Prelude
+import qualified Prelude
 
 newModel :: (MonadThrow m, MonadUnliftIO m) => Maybe Model -> URI -> m Model
 newModel mSt uri = do
@@ -63,7 +64,7 @@ newModel mSt uri = do
                 bDoc :: ByteString <-
                   maybe
                     ( throwString
-                        @MisoString
+                        @Prelude.String
                         "Failed to decrypt the document!"
                     )
                     pure

ghcjs/lightning-verifier/src/Main.hs

@@ -9,7 +9,7 @@ import Network.Wai.Application.Static
 import qualified Network.Wai.Handler.Warp as Warp
 import qualified Network.WebSockets as Ws
 import qualified Data.ByteString.Lazy as BL
-import qualified Data.Text as T
+import qualified Miso.String as MS
 #endif
 
 #ifdef wasi_HOST_OS
@@ -84,7 +84,7 @@ runApp app = do
           staticApp (defaultWebAppSettings "static") req
         ("site.webmanifest" : _) ->
           staticApp (defaultWebAppSettings "static") req
-        (file : _) | (T.isSuffixOf ".js" file) && (file /= "jsaddle.js") ->
+        (file : _) | (MS.isSuffixOf ".js" file) && (file /= "jsaddle.js") ->
           staticApp (defaultWebAppSettings "static") req
         _ ->
           JS.jsaddleAppWithJs (JS.jsaddleJs False <> js) req
@@ -177,16 +177,16 @@ updateModel (ChanUpdate prevSt) _ = do
             )
             $ evalModel
             =<< foldlM (&) prevSt actions
-        uri <- URI.mkURI $ shareLink nextSt
+        uri <- stUri nextSt
         Jsm.insertStorage ("favorite-" <> vsn) (nextSt ^. #modelFavMap)
         Jsm.insertStorage ("current-" <> vsn) uri
         syncUri uri
         nextUri <- stUri $ nextSt & #modelState . #stScreen %~ unQrCode
         uriViewer <-
           newFieldPair mempty
             . DynamicFieldText
-            . toMisoString
-            $ URI.render nextUri
+            . toMisoString @Prelude.String
+            $ URI.renderStr nextUri
         let finSt =
               nextSt
                 & #modelUriViewer
@@ -269,7 +269,12 @@ syncInputs st = do
   where
     fun :: Unique MisoString -> JSM (Unique MisoString)
     fun txt = do
-      el <- getElementById . htmlUid @MisoString $ txt ^. #uniqueUid
+      el <-
+        getElementById
+          . toMisoString @(UTF_8 ByteString)
+          . htmlUid
+          $ txt
+          ^. #uniqueUid
       elExist <- ghcjsPure $ JS.isTruthy el
       when elExist $ do
         inps <-