Miscellaneous fixes. (#60)

IntersectMBO · Jul 27, 2023 · 796f1da · 796f1da
2 parents c938472 + 8c37068
commit 796f1da
Show file tree

Hide file tree

Showing 3 changed files with 54 additions and 23 deletions.
diff --git a/bech32/app/Main.hs b/bech32/app/Main.hs
@@ -49,7 +49,9 @@ import Options.Applicative
 import Paths_bech32
     ( version )
 import Prettyprinter
+    ( annotate, hsep, indent, pretty, vsep )
 import Prettyprinter.Render.Terminal
+    ( bold, underlined )
 import System.IO
     ( BufferMode (..), Handle, hSetBuffering, stderr, stdin, stdout )
 
@@ -91,23 +93,37 @@ parse = customExecParser (prefs showHelpOnEmpty) parser
         , footerDoc $ Just $ vsep
             [ hsep
                 [ pretty "Supported encoding formats:"
-                , indent 0 $ pretty  "Base16, Bech32 & Base58."
+                , indent 0 $ pretty "Base16, Bech32 & Base58."
                 ]
             , pretty ""
             , pretty "Examples:"
-            , indent 2 $ hsep [annotate underlined $ pretty "To", pretty "Bech32:"]
-            , indent 4 $ annotate bold $ pretty "$ bech32 base16_ <<< 706174617465"
-            , indent 4 $ pretty "base16_1wpshgct5v5r5mxh0"
+            , indent 2
+                $ hsep [annotate underlined $ pretty "To", pretty "Bech32:"]
+            , indent 4
+                $ annotate bold
+                $ pretty "$ bech32 base16_ <<< 706174617465"
+            , indent 4
+                $ pretty "base16_1wpshgct5v5r5mxh0"
             , pretty ""
-            , indent 4 $ annotate bold $ pretty "$ bech32 base58_ <<< Ae2tdPwUPEYy"
-            , indent 4 $ pretty "base58_1p58rejhd9592uusa8pzj2"
+            , indent 4
+                $ annotate bold
+                $ pretty "$ bech32 base58_ <<< Ae2tdPwUPEYy"
+            , indent 4
+                $ pretty "base58_1p58rejhd9592uusa8pzj2"
             , pretty ""
-            , indent 4 $ annotate bold $ pretty "$ bech32 new_prefix <<< old_prefix1wpshgcg2s33x3"
-            , indent 4 $ pretty "new_prefix1wpshgcgeak9mv"
+            , indent 4
+                $ annotate bold
+                $ pretty "$ bech32 new_prefix <<< old_prefix1wpshgcg2s33x3"
+            , indent 4
+                $ pretty "new_prefix1wpshgcgeak9mv"
             , pretty ""
-            , indent 2 $ hsep [annotate underlined $ pretty "From", pretty "Bech32:"]
-            , indent 4 $ annotate bold $ pretty "$ bech32 <<< base16_1wpshgct5v5r5mxh0"
-            , indent 4 $ pretty "706174617465"
+            , indent 2
+                $ hsep [annotate underlined $ pretty "From", pretty "Bech32:"]
+            , indent 4
+                $ annotate bold
+                $ pretty "$ bech32 <<< base16_1wpshgct5v5r5mxh0"
+            , indent 4
+                $ pretty "706174617465"
             ]
         ]
 
@@ -129,10 +145,10 @@ hrpArgument = argument (eitherReader reader) $ mconcat
     , helpDoc $ Just $ vsep
         [ pretty "An optional human-readable prefix (e.g. 'addr')."
         , indent 2 $ pretty
-            "- When provided, the input pretty is decoded from various encoding \
+            "- When provided, the input text is decoded from various encoding \
             \formats and re-encoded to bech32 using the given prefix."
         , indent 2 $ pretty
-            "- When omitted, the input pretty is decoded from bech32 to base16."
+            "- When omitted, the input text is decoded from bech32 to base16."
         ]
     ]
   where
@@ -196,8 +212,10 @@ detectEncoding str
         guard (Bech32.separatorChar `elem` str)
         pure Bech32
       where
-        datapart  = reverse . takeWhile (/= Bech32.separatorChar) . reverse $ str
-        humanpart = takeWhile (/= Bech32.separatorChar) str
+        datapart =
+            reverse . takeWhile (/= Bech32.separatorChar) . reverse $ str
+        humanpart =
+            takeWhile (/= Bech32.separatorChar) str
         alpha = filter isLetter str
 
     resembleBase58 = do

diff --git a/bech32/test/AppSpec.hs b/bech32/test/AppSpec.hs
@@ -66,8 +66,8 @@ base16 = fromUtf8 . convertToBase Base16 . utf8
 bech32 :: Text -> String -> String
 bech32 txt = T.unpack . Bech32.encodeLenient hrp . dataPartFromBytes . utf8
   where
-    hrp = either (error . ("Error while parsing Bech32: " <>) . show) id $ humanReadablePartFromText txt
-
+    hrp = either (error . ("Error while parsing Bech32: " <>) . show) id
+        $ humanReadablePartFromText txt
 
 base58 :: String -> String
 base58 = fromUtf8 . encodeBase58 bitcoinAlphabet . utf8

diff --git a/bech32/test/Codec/Binary/Bech32Spec.hs b/bech32/test/Codec/Binary/Bech32Spec.hs
@@ -103,7 +103,8 @@ spec = do
                 -- test that a corrupted checksum fails decoding.
                 let (hrp, rest) =
                         T.breakOnEnd (T.singleton separatorChar) checksum
-                let (first, rest') = fromMaybe (error "empty rest") $ T.uncons rest
+                let (first, rest') =
+                        fromMaybe (error "empty rest") $ T.uncons rest
                 let checksumCorrupted =
                         (hrp `T.snoc` chr (ord first `xor` 1))
                         `T.append` rest'
@@ -154,7 +155,6 @@ spec = do
                         humanReadablePartFromText hrp
                             `shouldBe` Left invalidError
 
-
         it "Lengths are checked correctly." $
             property $ \(HumanReadablePartWithSuspiciousLength hrp) ->
                 let lo  = humanReadablePartMinLength
@@ -188,7 +188,7 @@ spec = do
         it "length > maximum" $ do
             let hrpUnpacked = "ca"
             let hrpLength = length hrpUnpacked
-            let hrp = either (error . ("Error while parsing Bech32: " <>) . show) id $ humanReadablePartFromText (T.pack hrpUnpacked)
+            let hrp = unsafeHumanReadablePartFromText (T.pack hrpUnpacked)
             let maxDataLength =
                     Bech32.encodedStringMaxLength
                     - Bech32.checksumLength - Bech32.separatorLength - hrpLength
@@ -198,7 +198,7 @@ spec = do
                 `shouldBe` Left Bech32.EncodedStringTooLong
 
         it "hrp lowercased" $ do
-            let hrp = either (error . ("Error while parsing Bech32: " <>) . show) id $ humanReadablePartFromText "HRP"
+            let hrp = unsafeHumanReadablePartFromText "HRP"
             Bech32.encode hrp mempty `shouldBe` Right "hrp1vhqs52"
 
     describe "Arbitrary Bech32String" $
@@ -684,8 +684,7 @@ instance Arbitrary HumanReadablePart where
     arbitrary = do
         len <- choose (1, 10)
         chars <- replicateM len arbitrary
-        let hrp = either (error . ("Error while parsing Bech32: " <>) . show) id
-                $ humanReadablePartFromText
+        let hrp = unsafeHumanReadablePartFromText
                 $ T.pack
                 $ getHumanReadableChar <$> chars
         return hrp
@@ -783,3 +782,17 @@ isLeft' :: Show e => Either e a -> Bool
 isLeft' = \case
     Left e -> show e `deepseq` True
     Right _ -> False
+
+--------------------------------------------------------------------------------
+-- Utilities
+--------------------------------------------------------------------------------
+
+-- | Unsafely parses a human-readable prefix from text.
+--
+-- Throws a run-time error if the given text could not be parsed as a
+-- human-readable prefix.
+--
+unsafeHumanReadablePartFromText :: Text -> HumanReadablePart
+unsafeHumanReadablePartFromText
+    = either (error . ("Error while parsing Bech32: " <>) . show) id
+    . humanReadablePartFromText