diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,18 +1,65 @@ -# ChangeLog for `bech32` +# Changelog -## 1.0.2 -- 2020-02-19 + -+ Added support for the `bech32-th` extension library. +## [1.1.0] - 2020-07-08 -## 1.0.1 -- 2020-02-13 +### Added -+ Improved module documentation, adding basic examples to help beginner users - quickly get up to speed. -+ Exposed functions `dataPartFromWords` and `dataPartToWords` within public +- Added `bech32` command-line for easy conversions in the console. + + ```console + Usage: bech32 [PREFIX] + Convert to and from bech32 strings. Data are read from standard input. + + Available options: + -h,--help Show this help text + PREFIX An optional human-readable prefix (e.g. 'addr'). + - When provided, the input text is decoded from various encoding formats and re-encoded to bech32 using the given prefix. + - When omitted, the input text is decoded from bech32 to base16. + + Supported encoding formats: Base16, Bech32 & Base58. + + Examples: + To Bech32: + $ bech32 base16_ <<< 706174617465 + base16_1wpshgct5v5r5mxh0 + + $ bech32 base58_ <<< Ae2tdPwUPEYy + base58_1p58rejhd9592uusa8pzj2 + + $ bech32 new_prefix <<< old_prefix1wpshgcg2s33x3 + new_prefix1wpshgcgeak9mv + + From Bech32: + $ bech32 <<< base16_1wpshgct5v5r5mxh0 + 706174617465 + ``` + +## [1.0.2] - 2020-02-19 + +### Added + +- Added support for the `bech32-th` extension library. + +## [1.0.1] - 2020-02-13 + +### Added + +- Exposed functions `dataPartFromWords` and `dataPartToWords` within public interface. -+ Exposed the `Word5` type within the public interface. -+ Exposed the `CharPosition` type within the public interface. -## 1.0.0 -- 2019-09-27 +- Exposed the `Word5` type within the public interface. -+ Initial release pulled from https://github.com/input-output-hk/cardano-wallet +- Exposed the `CharPosition` type within the public interface. + +### Changed + +- Improved module documentation, adding basic examples to help beginner users + quickly get up to speed. + +## [1.0.0] - 2019-09-27 + +### Added + +- Initial release pulled from https://github.com/input-output-hk/cardano-wallet diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,209 @@ +{-# LANGUAGE NamedFieldPuns #-} + +import Prelude + +import Codec.Binary.Bech32 + ( HumanReadablePart + , dataPartFromBytes + , dataPartToBytes + , humanReadablePartFromText + ) +import Control.Arrow + ( left, right ) +import Control.Monad + ( guard ) +import Data.ByteArray.Encoding + ( convertFromBase, convertToBase ) +import Data.ByteString.Base58 + ( bitcoinAlphabet, decodeBase58, unAlphabet ) +import Data.Char + ( isHexDigit, isLetter, isLower, isUpper, toLower ) +import Data.Either.Extra + ( maybeToEither ) +import Data.Maybe + ( fromJust ) +import Options.Applicative + ( Parser + , ParserInfo + , argument + , customExecParser + , eitherReader + , footerDoc + , helpDoc + , helper + , info + , metavar + , optional + , prefs + , progDesc + , showHelpOnEmpty + , (<|>) + ) +import Options.Applicative.Help.Pretty + ( bold, hsep, indent, text, underline, vsep ) +import System.IO + ( BufferMode (..), Handle, hSetBuffering, stderr, stdin, stdout ) + +import qualified Codec.Binary.Bech32 as Bech32 +import qualified Codec.Binary.Bech32.Internal as Bech32 +import qualified Data.ByteArray.Encoding as BA +import qualified Data.ByteString.Char8 as B8 +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + +main :: IO () +main = setup >> parse >>= run + +newtype Cmd = Cmd + { prefix :: Maybe HumanReadablePart + } deriving (Show) + +-- | Enable ANSI colors on Windows and correct output buffering +setup :: IO () +setup = + mapM_ hSetup [stderr, stdout] + where + hSetup :: Handle -> IO () + hSetup h = hSetBuffering h NoBuffering + +-- | Parse command line options and arguments +parse :: IO Cmd +parse = customExecParser (prefs showHelpOnEmpty) parser + where + parser :: ParserInfo Cmd + parser = info (helper <*> cmd) $ mconcat + [ progDesc $ unwords + [ "Convert to and from bech32 strings." + , "Data are read from standard input." + ] + , footerDoc $ Just $ vsep + [ hsep + [ text "Supported encoding formats:" + , indent 0 $ text "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" + ] + ] + + cmd :: Parser Cmd + cmd = Cmd <$> optional hrpArgument + +-- | Parse a 'HumanReadablePart' as an argument. +hrpArgument :: Parser HumanReadablePart +hrpArgument = argument (eitherReader reader) $ mconcat + [ metavar "PREFIX" + , helpDoc $ Just $ vsep + [ text "An optional human-readable prefix (e.g. 'addr')." + , indent 2 $ text + "- When provided, the input text is decoded from various encoding \ + \formats and re-encoded to bech32 using the given prefix." + , indent 2 $ text + "- When omitted, the input text is decoded from bech32 to base16." + ] + ] + where + reader :: String -> Either String HumanReadablePart + reader = left show . humanReadablePartFromText . T.pack + +-- | Run a Command in IO +run :: Cmd -> IO () +run Cmd{prefix} = do + source <- T.decodeUtf8 . B8.filter (/= '\n') <$> B8.hGetContents stdin + case prefix of + Nothing -> runDecode source + Just hrp -> runEncode hrp source + where + runDecode source = + case Bech32.decodeLenient source of + Left err -> + fail (show err) + Right (_, dataPart) -> do + let base16 = convertToBase BA.Base16 + B8.putStrLn $ base16 $ fromJust $ dataPartToBytes dataPart + + runEncode hrp source = do + datapart <- either fail pure $ + case detectEncoding (T.unpack source) of + Just Base16 -> do + let fromBase16 = convertFromBase BA.Base16 . T.encodeUtf8 + dataPartFromBytes <$> fromBase16 source + Just Bech32 -> + right snd $ left show $ Bech32.decodeLenient source + Just Base58 -> do + let err = "Invalid Base58-encoded string." + let fromBase58 = decodeBase58 bitcoinAlphabet . T.encodeUtf8 + dataPartFromBytes <$> maybeToEither err (fromBase58 source) + Nothing -> + Left "Unable to detect input encoding. Neither Base16, \ + \Bech32 nor Base58." + B8.putStrLn $ T.encodeUtf8 $ Bech32.encodeLenient hrp datapart + +data Encoding = Base16 | Bech32 | Base58 deriving (Show, Eq) + +-- | Try detecting the encoding of a given 'String' +detectEncoding :: String -> Maybe Encoding +detectEncoding str + | length str < minimalSizeForDetection = Nothing + | otherwise = resembleBase16 <|> resembleBech32 <|> resembleBase58 + where + resembleBase16 = do + guard (all isHexDigit (toLower <$> str)) + guard (even (length str)) + pure Base16 + + resembleBech32 = do + guard (not (null humanpart)) + guard (all Bech32.humanReadableCharIsValid humanpart) + guard (length datapart >= Bech32.checksumLength) + guard (all (`elem` Bech32.dataCharList) datapart) + guard (all isUpper alpha || all isLower alpha) + guard (Bech32.separatorChar `elem` str) + pure Bech32 + where + datapart = reverse . takeWhile (/= Bech32.separatorChar) . reverse $ str + humanpart = takeWhile (/= Bech32.separatorChar) str + alpha = filter isLetter str + + resembleBase58 = do + guard (all isBase58Digit str) + pure Base58 + where + isBase58Digit :: Char -> Bool + isBase58Digit = + (`elem` T.unpack (T.decodeUtf8 $ unAlphabet bitcoinAlphabet)) + +-- NOTE For small string, it can be tricky to tell whether a string is hex +-- or bech32 encoded. Both could potentially be valid. As the length +-- increases, the probability for a string to satisfy all three encoding +-- rules gets smaller and smaller. +-- +-- For example, let's consider the probability for the alphabet to match +-- between base16 and base58 (which will be bigger than the actual probability +-- of both encoding to be valid, since there are additional rules on top of +-- the alphabet): +-- +-- P_1 = 16/58 +-- +-- Now, the probability that a base58 string of 8 characters will contain +-- only hexadecimal characters is +-- +-- P_8 = P_1 ^ 8 ~ 0.00003 +-- +-- Which can be considered small enough to not happened too frequently. The +-- probability gets worse with Bech32 which has quite a lot of rules. +minimalSizeForDetection :: Int +minimalSizeForDetection = 8 diff --git a/bech32.cabal b/bech32.cabal --- a/bech32.cabal +++ b/bech32.cabal @@ -1,5 +1,5 @@ name: bech32 -version: 1.0.2 +version: 1.1.0 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. @@ -24,6 +24,11 @@ default: False manual: True +flag release + description: Compile executables for a release. + manual: True + default: False + library default-language: Haskell2010 @@ -39,7 +44,7 @@ -Werror build-depends: array - , base < 4.14 + , base >= 4.11.1.0 && < 4.15 , bytestring , containers , extra @@ -50,6 +55,28 @@ Codec.Binary.Bech32 Codec.Binary.Bech32.Internal +executable bech32 + main-is: Main.hs + other-modules: + Paths_bech32 + hs-source-dirs: + app + ghc-options: -Wall -Wcompat -fwarn-redundant-constraints -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.7 && <5 + , base58-bytestring + , bech32 + , bytestring + , extra + , memory + , optparse-applicative + , text + if flag(release) + ghc-options: -Werror -static -O2 + cc-options: -static + ld-options: -static -pthread + default-language: Haskell2010 + test-suite bech32-test default-language: Haskell2010 @@ -65,18 +92,23 @@ -Werror build-depends: base + , base58-bytestring , bech32 , bytestring , containers , deepseq , extra , hspec - , QuickCheck + , memory + , process + , QuickCheck >= 2.12 , text , vector build-tools: hspec-discover + , bech32 main-is: Main.hs other-modules: + AppSpec Codec.Binary.Bech32Spec diff --git a/src/Codec/Binary/Bech32/Internal.hs b/src/Codec/Binary/Bech32/Internal.hs --- a/src/Codec/Binary/Bech32/Internal.hs +++ b/src/Codec/Binary/Bech32/Internal.hs @@ -3,7 +3,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -- | diff --git a/test/AppSpec.hs b/test/AppSpec.hs new file mode 100644 --- /dev/null +++ b/test/AppSpec.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module AppSpec + ( spec + ) where + +import Prelude + +import Codec.Binary.Bech32 + ( dataPartFromBytes, humanReadablePartFromText ) +import Data.ByteArray.Encoding + ( Base (..), convertToBase ) +import Data.ByteString + ( ByteString ) +import Data.ByteString.Base58 + ( bitcoinAlphabet, encodeBase58 ) +import Data.Text + ( Text ) +import System.Process + ( readProcess ) +import Test.Hspec + ( Spec, describe ) +import Test.Hspec.QuickCheck + ( prop ) +import Test.QuickCheck + ( Arbitrary (..), choose, vector, withMaxSuccess ) +import Test.QuickCheck.Monadic + ( assert, monadicIO, run ) + +import qualified Codec.Binary.Bech32 as Bech32 +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + +spec :: Spec +spec = + describe "bech32 command-line" $ do + specDecode + specEncode base16 + specEncode (bech32 "bech32") + specEncode base58 + +-- | Check that, for a given encoder, any encoded string can be decoded and +-- re-encoded to bech32 using the given prefix. +specEncode + :: (String -> String) + -> Spec +specEncode encode = prop ("can re-encode encoded strings " <> encode "...") $ + \(MinString str) -> + withMaxSuccess 1000 $ monadicIO $ do + out <- run $ readProcess "bech32" ["prefix"] (encode str) + assert (init out == bech32 "prefix" str) + +-- | Check that any bech32-encoded string can be decoded successfully. +specDecode :: Spec +specDecode = prop "any bech32 string can be decoded to hex" $ + \(MinString str) -> + withMaxSuccess 1000 $ monadicIO $ do + out <- run $ readProcess "bech32" [] (bech32 "bech32" str) + assert (init out == base16 str) + +base16 :: String -> String +base16 = fromUtf8 . convertToBase Base16 . utf8 + +bech32 :: Text -> String -> String +bech32 txt = T.unpack . Bech32.encodeLenient hrp . dataPartFromBytes . utf8 + where + Right hrp = humanReadablePartFromText txt + + +base58 :: String -> String +base58 = fromUtf8 . encodeBase58 bitcoinAlphabet . utf8 + +utf8 :: String -> ByteString +utf8 = T.encodeUtf8 . T.pack + +fromUtf8 :: ByteString -> String +fromUtf8 = T.unpack . T.decodeUtf8 + +-- Generate strings of a minimal length. +newtype MinString = MinString String deriving (Eq, Show) + +instance Arbitrary MinString where + arbitrary = + MinString <$> (choose (8, 100) >>= vector) + shrink (MinString str) = + MinString <$> filter ((> 8) . length) (shrink str) 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 @@ -146,14 +146,14 @@ "no invalid characters" $ cover 10 (not isValid) "one or more invalid characters" - $ if - | isValid -> + $ if isValid then fmap humanReadablePartToText (humanReadablePartFromText hrp) `shouldBe` Right (T.toLower hrp) - | otherwise -> + else humanReadablePartFromText hrp `shouldBe` Left invalidError + it "Lengths are checked correctly." $ property $ \(HumanReadablePartWithSuspiciousLength hrp) ->