unicode refactoring wip

Author: functora

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

@@ -36,20 +36,18 @@ 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,
     modelMenu :: OpenedOrClosed,
     modelLinks :: OpenedOrClosed,
     modelLoading :: Bool,
     modelState :: St Unique,
-    modelFavMap :: Map MisoString Fav,
-    modelFavName :: Field MisoString Unique,
+    modelFavMap :: Map Unicode Fav,
+    modelFavName :: Field Unicode Unique,
     modelUriViewer :: [FieldPair DynamicField Unique],
     modelProducerQueue :: TChan (InstantOrDelayed (Model -> JSM Model)),
     modelConsumerQueue :: TChan (InstantOrDelayed (Model -> JSM Model))
@@ -65,7 +63,7 @@ data Action
 
 data St f = St
   { stKm :: Aes.Km,
-    stIkm :: Field MisoString f,
+    stIkm :: Field Unicode f,
     stDoc :: StDoc f,
     stPre :: Field DynamicField f,
     stScreen :: Screen,
@@ -91,9 +89,9 @@ data StDoc f = StDoc
   { stDocFieldPairs :: [FieldPair DynamicField f],
     stDocSuccessViewer :: [FieldPair DynamicField f],
     stDocFailureViewer :: [FieldPair DynamicField f],
-    stDocLnPreimage :: Field MisoString f,
+    stDocLnPreimage :: Field Unicode f,
     stDocLnPreimageViewer :: [FieldPair DynamicField f],
-    stDocLnInvoice :: Field MisoString f,
+    stDocLnInvoice :: Field Unicode f,
     stDocLnInvoiceViewer :: [FieldPair DynamicField f]
   }
   deriving stock (Generic)
@@ -230,7 +228,7 @@ stQuery st = do
 
 stUri :: (MonadThrow m) => Model -> m URI
 stUri st = do
-  uri <- mkURI $ fromMisoString @Prelude.Text baseUri
+  uri <- mkURI $ from @Unicode @Prelude.Text baseUri
   qxs <- stQuery . uniqueToIdentity $ st ^. #modelState
   pure
     $ uri
@@ -256,18 +254,18 @@ compressViewers st =
       pair
         & #fieldPairKey
         . #fieldInput
-        .~ Identity (mempty :: MisoString)
+        .~ Identity (mempty :: Unicode)
         & #fieldPairKey
         . #fieldOutput
-        .~ (mempty :: MisoString)
+        .~ (mempty :: Unicode)
         & #fieldPairValue
         . #fieldInput
-        .~ Identity (mempty :: MisoString)
+        .~ Identity (mempty :: Unicode)
         & #fieldPairValue
         . #fieldOutput
         .~ DynamicFieldText mempty
 
-baseUri :: MisoString
+baseUri :: Unicode
 #ifdef GHCID
 baseUri =
   "http://localhost:8080"
@@ -286,10 +284,10 @@ setScreenAction =
     . Instant
     . setScreenPure
 
-vsn :: MisoString
+vsn :: Unicode
 vsn =
-  MS.intercalate "."
-    . fmap (toMisoString @Prelude.String . Prelude.show)
+  intercalate "."
+    . fmap inspect
     $ Version.versionBranch Paths.version
 
 usd :: CurrencyInfo
@@ -318,7 +316,7 @@ apkLink :: URI
 apkLink =
   either impureThrow id
     . URI.mkURI
-    . fromMisoString @Prelude.Text
+    . from @Unicode @Prelude.Text
     $ "https://github.com/functora/functora.github.io/releases/download/lightning-verifier-v"
     <> vsn
     <> "/lightning-verifier-v"

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.Lazy as TL
 import qualified Functora.Bolt11 as B11
 import Functora.Miso.Prelude
 import qualified Functora.Miso.Widgets.FieldPairs as FieldPairs
@@ -65,7 +64,7 @@ pairs st header optic =
             FieldPairs.argsAction = PushUpdate . Instant
           }
 
-pair :: MisoString -> MisoString -> FieldPair DynamicField Identity
+pair :: Unicode -> Unicode -> FieldPair DynamicField Identity
 pair x =
   newFieldPairId x
     . DynamicFieldText
@@ -76,12 +75,12 @@ success = css "app-success"
 failure :: [View Action] -> [View Action]
 failure = css "app-failure"
 
-css :: MisoString -> [View action] -> [View action]
+css :: Unicode -> [View action] -> [View action]
 css x = fmap $ \case
   Node x0 x1 x2 x3 x4 -> Node x0 x1 x2 (class_ x : x3) x4
   html -> html
 
-inspectTimestamp :: Int -> MisoString
+inspectTimestamp :: Int -> Unicode
 inspectTimestamp =
   inspect
     . posixSecondsToUTCTime
@@ -99,7 +98,7 @@ makeBolt11Viewer st =
           then pure mempty
           else bimap plain (preimageFields rawR) r
       verifierFields =
-        if any @[MisoString] (== mempty) [rawLn, rawR]
+        if any @[Unicode] (== mempty) [rawLn, rawR]
           then pure mempty
           else case verifyPreimage <$> rh <*> r of
             Left {} -> pure mempty
@@ -117,18 +116,18 @@ makeBolt11Viewer st =
         & #stDocLnPreimageViewer
         .~ fromRight mempty preFields
   where
-    rawLn :: MisoString
+    rawLn :: Unicode
     rawLn = st ^. #stDocLnInvoice . #fieldOutput
-    rawR :: MisoString
+    rawR :: Unicode
     rawR = st ^. #stDocLnPreimage . #fieldOutput
-    ln :: Either MisoString B11.Bolt11
+    ln :: Either Unicode B11.Bolt11
     ln =
-      first (mappend "Bad invoice - " . toMisoString @Prelude.String)
+      first (mappend "Bad invoice - " . from @Prelude.String @Unicode)
         . B11.decodeBolt11
-        $ fromMisoString @Prelude.Text rawLn
-    rh :: Either MisoString ByteString
+        $ from @Unicode @Prelude.Text rawLn
+    rh :: Either Unicode ByteString
     rh = ln >>= parsePreimageHash
-    r :: Either MisoString ByteString
+    r :: Either Unicode ByteString
     r = parsePreimage rawR
 
 mergeBolt11Viewers :: (Foldable1 f) => StDoc f -> StDoc f -> StDoc f
@@ -143,21 +142,17 @@ mergeBolt11Viewers next prev =
     & #stDocLnPreimageViewer
     %~ mergeFieldPairs (stDocLnPreimageViewer next)
 
-plain :: MisoString -> [FieldPair DynamicField Identity]
+plain :: Unicode -> [FieldPair DynamicField Identity]
 plain =
   (: mempty) . newFieldPairId mempty . DynamicFieldText
 
-parsePreimage :: MisoString -> Either MisoString ByteString
+parsePreimage :: Unicode -> Either Unicode ByteString
 parsePreimage rawR =
-  case B16.decode $ fromMisoString @ByteString rawR of
+  case B16.decode $ encodeUtf8 rawR of
     (r, "") -> Right r
-    (_, e) ->
-      Left
-        . toMisoString @Prelude.String
-        $ "Bad preimage - non hex leftover "
-        <> Prelude.show e
+    (_, e) -> Left $ "Bad preimage - non hex leftover " <> inspect @Unicode e
 
-parsePreimageHash :: B11.Bolt11 -> Either MisoString ByteString
+parsePreimageHash :: B11.Bolt11 -> Either Unicode ByteString
 parsePreimageHash ln =
   case find B11.isPaymentHash $ B11.bolt11Tags ln of
     Just (B11.PaymentHash (B11.Hex rh)) -> Right rh
@@ -166,7 +161,7 @@ parsePreimageHash ln =
 verifyPreimage ::
   ByteString ->
   ByteString ->
-  Either MisoString MisoString
+  Either Unicode Unicode
 verifyPreimage rh r =
   if rh == sha256Hash r
     then Right "The preimage matches the invoice"
@@ -181,11 +176,7 @@ invoiceFields ln =
         B11.BitcoinRegtest -> "Bitcoin Regtest"
         B11.BitcoinSignet -> "Bitcoin Signet",
     pair "Amount"
-      . maybe
-        "0"
-        ( toMisoString @Prelude.String
-            . B11.inspectBolt11HrpAmt
-        )
+      . maybe "0" B11.inspectBolt11HrpAmt
       . B11.bolt11HrpAmt
       $ B11.bolt11Hrp ln,
     pair "Created At"
@@ -196,7 +187,6 @@ invoiceFields ln =
           >>= invoiceFieldsTag ln
        )
     <> [ pair "Signature"
-          . toMisoString @TL.Text
           . B11.inspectHex
           $ B11.bolt11SigVal sig,
          pair "Pubkey Recovery Flag"
@@ -221,36 +211,39 @@ invoiceFieldsTag ln = \case
   B11.OnchainFallback x ->
     pure
       . pair "Onchain Fallback"
-      . toMisoString @ByteString
+      . either impureThrow id
+      . decodeUtf8Strict @Unicode @ByteString
       $ Btc.renderAddress x
   B11.ExtraRouteInfo x ->
     pure
       . pair "Extra Routing Info"
-      . toMisoString @BL.ByteString
+      . either impureThrow id
+      . decodeUtf8Strict @Unicode @BL.ByteString
       $ A.encode x
   B11.Features x ->
     pure
       . pair "Feature Bits"
-      . toMisoString @Prelude.Text
       $ B11.inspectFeatures x
   B11.UnknownTag {} -> mempty
   B11.UnparsedTag {} -> mempty
   where
-    w5s :: MisoString -> [B11.Word5] -> [FieldPair DynamicField Identity]
+    w5s :: Unicode -> [B11.Word5] -> [FieldPair DynamicField Identity]
     w5s x =
       pure
         . pair x
         . inspect
         . fmap fromEnum
-    hex :: MisoString -> B11.Hex -> [FieldPair DynamicField Identity]
+    hex :: Unicode -> B11.Hex -> [FieldPair DynamicField Identity]
     hex x =
       pure
         . pair x
-        . toMisoString @TL.Text
         . B11.inspectHex
 
-preimageFields :: MisoString -> ByteString -> [FieldPair DynamicField Identity]
+preimageFields :: Unicode -> ByteString -> [FieldPair DynamicField Identity]
 preimageFields rawR r =
   [ pair "Preimage" rawR,
-    pair "Preimage Hash" . inspect @ByteString $ sha256Hash r
+    pair "Preimage Hash"
+      . either impureThrow id
+      . decodeUtf8Strict @Unicode @ByteString
+      $ sha256Hash r
   ]

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

@@ -50,7 +50,7 @@ decrypt st =
 
 decryptDoc :: Model -> JSM Model
 decryptDoc st@Model {modelState = St {stCpt = Nothing}} = do
-  Jsm.popupText @MisoString "Nothing to decrypt!"
+  Jsm.popupText @Unicode "Nothing to decrypt!"
   pure st
 decryptDoc st@Model {modelState = St {stCpt = Just cpt}} = do
   let ikm = st ^. #modelState . #stIkm . #fieldOutput

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

@@ -112,7 +112,7 @@ fav st =
         then saveAction
         else Jsm.enterOrEscapeBlur uid code
 
-makeFavName :: Model -> MisoString
+makeFavName :: Model -> Unicode
 makeFavName =
   MS.toUpper
     . MS.strip
@@ -127,7 +127,7 @@ favItems st =
     $ st
     ^. #modelFavMap
 
-favItem :: Model -> MisoString -> Fav -> View Action
+favItem :: Model -> Unicode -> Fav -> View Action
 favItem st label Fav {favUri = uri} =
   Grid.bigCell
     [ Button.raised

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

@@ -173,9 +173,9 @@ screenWidget st@Model {modelState = St {stScreen = Converter}} =
     <> Bolt11.bolt11Viewer st
 
 pasteWidget ::
-  MisoString ->
-  ((Maybe MisoString -> JSM ()) -> JSM ()) ->
-  ATraversal' Model (Field MisoString Unique) ->
+  Unicode ->
+  ((Maybe Unicode -> JSM ()) -> JSM ()) ->
+  ATraversal' Model (Field Unicode Unique) ->
   Maybe (Field.OptsWidget Model Action)
 pasteWidget icon selector optic =
   Just
@@ -185,14 +185,14 @@ pasteWidget icon selector optic =
     $ \prev -> do
       selector $ \case
         Nothing ->
-          Jsm.popupText @MisoString "Failure!"
+          Jsm.popupText @Unicode "Failure!"
         Just res -> do
           Misc.pushActionQueue prev
             . Instant
             $ pure
             . (& cloneTraversal optic . #fieldOutput .~ res)
             . (& cloneTraversal optic . #fieldInput . #uniqueValue .~ res)
-          Jsm.popupText @MisoString "Success!"
+          Jsm.popupText @Unicode "Success!"
       pure prev
 
 tosWidget :: View Action

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

@@ -93,8 +93,8 @@ menu st =
                               void
                                 $ JS.global
                                 ^. JS.js1
-                                  ("printCurrentPage" :: MisoString)
-                                  ("lightning-verifier" :: MisoString)
+                                  ("printCurrentPage" :: Unicode)
+                                  ("lightning-verifier" :: Unicode)
                               pure next
                           )
                         & IconButton.setAttributes
@@ -109,7 +109,7 @@ menu st =
                         ( PushUpdate
                             . Instant
                             . Jsm.shareText
-                            . toMisoString @Prelude.String
+                            . from @Prelude.String @Unicode
                             . either impureThrow URI.renderStr
                             $ stUri st
                         )
@@ -291,7 +291,7 @@ menu st =
         [ x
         ]
 
-defFavName :: Model -> MisoString
+defFavName :: Model -> Unicode
 defFavName st =
   if isJust (st ^. #modelState . #stCpt)
     || (st ^. #modelState . #stIkm . #fieldOutput /= mempty)

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

@@ -128,13 +128,13 @@ newDonateDoc = do
     qr :: FieldPair a b -> FieldPair a b
     qr = (& #fieldPairValue . #fieldType .~ FieldTypeQrCode)
 
-exampleBtcAddress :: MisoString
+exampleBtcAddress :: Unicode
 exampleBtcAddress = "bc1qa3qk8d4mxl6qkpvahl5xvg6c5k33kmuwvt9v8q"
 
-exampleXmrAddress :: MisoString
+exampleXmrAddress :: Unicode
 exampleXmrAddress =
   "48sTw2TvjuWKkaomi9J7gLExRUJLJCvUHLrbf8M8qmayQ9zkho1GYdCXVtpTPawNWH7mNS49N4E6HNDF95dtggMMCigrVyG"
 
-exampleDonationText :: MisoString
+exampleDonationText :: Unicode
 exampleDonationText =
   "I'm Functora, the creator of this software. If you're enjoying it, a donation would be greatly appreciated. Sincerely yours, Functora."