diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,6 +1,12 @@ # Changelog +## [1.1.4] - 2023-07-28 + +### Fixed + +- Support for `optparse-applicative` versions >= 0.18.0.0. + ## [1.1.3] - 2023-06-06 ### Fixed diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -46,10 +46,12 @@ , showHelpOnEmpty , (<|>) ) -import Options.Applicative.Help.Pretty - ( bold, hsep, indent, text, underline, vsep ) 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 ) @@ -90,24 +92,38 @@ ] , footerDoc $ Just $ vsep [ hsep - [ text "Supported encoding formats:" - , indent 0 $ text "Base16, Bech32 & Base58." + [ pretty "Supported encoding formats:" + , indent 0 $ pretty "Base16, Bech32 & Base58." ] - , text "" - , text "Examples:" - , indent 2 $ hsep [underline $ text "To", text "Bech32:"] - , indent 4 $ bold $ text "$ bech32 base16_ <<< 706174617465" - , indent 4 $ text "base16_1wpshgct5v5r5mxh0" - , text "" - , indent 4 $ bold $ text "$ bech32 base58_ <<< Ae2tdPwUPEYy" - , indent 4 $ text "base58_1p58rejhd9592uusa8pzj2" - , text "" - , indent 4 $ bold $ text "$ bech32 new_prefix <<< old_prefix1wpshgcg2s33x3" - , indent 4 $ text "new_prefix1wpshgcgeak9mv" - , text "" - , indent 2 $ hsep [underline $ text "From", text "Bech32:"] - , indent 4 $ bold $ text "$ bech32 <<< base16_1wpshgct5v5r5mxh0" - , indent 4 $ text "706174617465" + , 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" + , pretty "" + , 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" + , pretty "" + , indent 2 + $ hsep [annotate underlined $ pretty "From", pretty "Bech32:"] + , indent 4 + $ annotate bold + $ pretty "$ bech32 <<< base16_1wpshgct5v5r5mxh0" + , indent 4 + $ pretty "706174617465" ] ] @@ -127,11 +143,11 @@ hrpArgument = argument (eitherReader reader) $ mconcat [ metavar "PREFIX" , helpDoc $ Just $ vsep - [ text "An optional human-readable prefix (e.g. 'addr')." - , indent 2 $ text + [ pretty "An optional human-readable prefix (e.g. 'addr')." + , indent 2 $ pretty "- When provided, the input text is decoded from various encoding \ \formats and re-encoded to bech32 using the given prefix." - , indent 2 $ text + , indent 2 $ pretty "- When omitted, the input text is decoded from bech32 to base16." ] ] @@ -183,7 +199,7 @@ | otherwise = resembleBase16 <|> resembleBech32 <|> resembleBase58 where resembleBase16 = do - guard (all isHexDigit (toLower <$> str)) + guard $ all (isHexDigit . toLower) str guard (even (length str)) pure Base16 @@ -196,8 +212,10 @@ 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.cabal b/bech32.cabal --- a/bech32.cabal +++ b/bech32.cabal @@ -1,5 +1,5 @@ name: bech32 -version: 1.1.3 +version: 1.1.4 synopsis: Implementation of the Bech32 cryptocurrency address format (BIP 0173). description: Implementation of the Bech32 cryptocurrency address format documented in the BIP (Bitcoin Improvement Proposal) 0173. @@ -65,7 +65,9 @@ , bytestring , extra , memory - , optparse-applicative >= 0.17.0.0 && < 0.18 + , optparse-applicative + , prettyprinter + , prettyprinter-ansi-terminal , text ghc-options: -Wall -Wcompat -fwarn-redundant-constraints diff --git a/test/AppSpec.hs b/test/AppSpec.hs --- a/test/AppSpec.hs +++ b/test/AppSpec.hs @@ -66,8 +66,8 @@ bech32 :: Text -> String -> String bech32 txt = T.unpack . Bech32.encodeLenient hrp . dataPartFromBytes . utf8 where - Right hrp = humanReadablePartFromText txt - + hrp = either (error . ("Error while parsing Bech32: " <>) . show) id + $ humanReadablePartFromText txt base58 :: String -> String base58 = fromUtf8 . encodeBase58 bitcoinAlphabet . utf8 diff --git a/test/Codec/Binary/Bech32Spec.hs b/test/Codec/Binary/Bech32Spec.hs --- a/test/Codec/Binary/Bech32Spec.hs +++ b/test/Codec/Binary/Bech32Spec.hs @@ -103,7 +103,8 @@ -- test that a corrupted checksum fails decoding. let (hrp, rest) = T.breakOnEnd (T.singleton separatorChar) checksum - let Just (first, 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 @@ humanReadablePartFromText hrp `shouldBe` Left invalidError - it "Lengths are checked correctly." $ property $ \(HumanReadablePartWithSuspiciousLength hrp) -> let lo = humanReadablePartMinLength @@ -188,7 +188,7 @@ it "length > maximum" $ do let hrpUnpacked = "ca" let hrpLength = length hrpUnpacked - let (Right hrp) = humanReadablePartFromText (T.pack hrpUnpacked) + let hrp = unsafeHumanReadablePartFromText (T.pack hrpUnpacked) let maxDataLength = Bech32.encodedStringMaxLength - Bech32.checksumLength - Bech32.separatorLength - hrpLength @@ -198,7 +198,7 @@ `shouldBe` Left Bech32.EncodedStringTooLong it "hrp lowercased" $ do - let (Right hrp) = humanReadablePartFromText "HRP" + let hrp = unsafeHumanReadablePartFromText "HRP" Bech32.encode hrp mempty `shouldBe` Right "hrp1vhqs52" describe "Arbitrary Bech32String" $ @@ -684,8 +684,9 @@ arbitrary = do len <- choose (1, 10) chars <- replicateM len arbitrary - let (Right hrp) = humanReadablePartFromText $ T.pack $ - getHumanReadableChar <$> chars + let hrp = unsafeHumanReadablePartFromText + $ T.pack + $ getHumanReadableChar <$> chars return hrp shrink hrp | T.null chars = [] @@ -781,3 +782,17 @@ 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