bech32-1.1.4: test/AppSpec.hs

{-# 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
    hrp = either (error . ("Error while parsing Bech32: " <>) . show) id
        $ 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)