Skip to content
Permalink
Browse files

Use a richer error return type for `mkHumanReadablePart`.

  • Loading branch information...
jonathanknowles committed May 16, 2019
1 parent 95bc4e2 commit b7b73315be87dee8646eb4cf00321c7c645129c1
@@ -32,6 +32,7 @@ library
array
, base
, bytestring
, extra
hs-source-dirs:
src
exposed-modules:
@@ -56,6 +57,7 @@ test-suite bech32-test
array
, base
, bech32
, extra
, hspec
, bytestring
, QuickCheck
@@ -29,6 +29,8 @@ module Codec.Binary.Bech32.Internal
, humanReadablePartToBytes
, humanReadableCharsetMinBound
, humanReadableCharsetMaxBound
, humanReadablePartMinLength
, humanReadablePartMaxLength

-- * Bit Manipulation
, convertBits
@@ -58,6 +60,8 @@ import Data.ByteString
( ByteString )
import Data.Char
( toLower, toUpper )
import Data.Either.Extra
( eitherToMaybe )
import Data.Foldable
( foldl' )
import Data.Functor.Identity
@@ -78,15 +82,30 @@ import qualified Data.ByteString.Char8 as B8
newtype HumanReadablePart = HumanReadablePart ByteString
deriving (Show, Eq)

mkHumanReadablePart :: ByteString -> Maybe HumanReadablePart
mkHumanReadablePart hrp = do
guard $ not (BS.null hrp) && BS.all valid hrp
return (HumanReadablePart hrp)
mkHumanReadablePart
:: ByteString -> Either HumanReadablePartError HumanReadablePart
mkHumanReadablePart hrp
| BS.length hrp < humanReadablePartMinLength =
Left HumanReadablePartTooShort
| BS.length hrp > humanReadablePartMaxLength =
Left HumanReadablePartTooLong
| BS.length invalidPortion > 0 =
Left $ HumanReadablePartContainsInvalidChar $ CharPosition $
BS.length validPortion
| otherwise =
Right $ HumanReadablePart hrp
where
(validPortion, invalidPortion) = BS.break (not . valid) hrp
valid c =
c >= humanReadableCharsetMinBound &&
c <= humanReadableCharsetMaxBound

data HumanReadablePartError
= HumanReadablePartTooShort
| HumanReadablePartTooLong
| HumanReadablePartContainsInvalidChar CharPosition
deriving (Eq, Show)

humanReadableCharsetMinBound :: Word8
humanReadableCharsetMinBound = 33

@@ -96,6 +115,12 @@ humanReadableCharsetMaxBound = 126
humanReadablePartToBytes :: HumanReadablePart -> ByteString
humanReadablePartToBytes (HumanReadablePart bytes) = bytes

humanReadablePartMinLength :: Int
humanReadablePartMinLength = 1

humanReadablePartMaxLength :: Int
humanReadablePartMaxLength = 83

{-------------------------------------------------------------------------------
Encoding & Decoding
-------------------------------------------------------------------------------}
@@ -115,7 +140,8 @@ decode bech32 = do
guard $ B8.map toUpper bech32 == bech32 || B8.map toLower bech32 == bech32
let (hrp, dat) = B8.breakEnd (== '1') $ B8.map toLower bech32
guard $ BS.length dat >= checksumLength
hrp' <- B8.stripSuffix (B8.pack "1") hrp >>= mkHumanReadablePart
hrp' <-
B8.stripSuffix (B8.pack "1") hrp >>= eitherToMaybe . mkHumanReadablePart
dat' <- mapM charsetMap $ B8.unpack dat
guard $ bech32VerifyChecksum hrp' dat'
result <- toBase256 (take (BS.length dat - checksumLength) dat')
@@ -132,7 +158,7 @@ maxEncodedStringLength :: Int
maxEncodedStringLength = 90

{-------------------------------------------------------------------------------
Character Set Manipulation
Character Manipulation
-------------------------------------------------------------------------------}

charset :: Array Word5 Char
@@ -153,6 +179,10 @@ charsetMap c
Arr.//
(map swap (Arr.assocs charset))

-- | The zero-based position of a character in a string, counting from the left.
newtype CharPosition = CharPosition Int
deriving (Eq, Show)

{-------------------------------------------------------------------------------
Bit Manipulation
-------------------------------------------------------------------------------}
@@ -19,6 +19,8 @@ import Data.ByteString
( ByteString )
import Data.Char
( toLower, toUpper )
import Data.Either.Extra
( eitherToMaybe )
import Data.Functor.Identity
( runIdentity )
import Data.Maybe
@@ -71,7 +73,7 @@ spec = do
it "length > maximum" $ do
let hrpUnpacked = "ca"
let hrpLength = length hrpUnpacked
let (Just hrp) = mkHumanReadablePart (B8.pack hrpUnpacked)
let (Right hrp) = mkHumanReadablePart (B8.pack hrpUnpacked)
let separatorLength = 1
let maxDataLength =
Bech32.maxEncodedStringLength
@@ -80,7 +82,7 @@ spec = do
`shouldSatisfy` isNothing

it "hrp lowercased" $ do
let (Just hrp) = mkHumanReadablePart (B8.pack "HRP")
let (Right hrp) = mkHumanReadablePart (B8.pack "HRP")
Bech32.encode hrp mempty
`shouldBe` Just (B8.pack "hrp1g9xj8m")

@@ -164,15 +166,15 @@ invalidChecksums = map B8.pack
]

instance Arbitrary HumanReadablePart where
shrink hrp = catMaybes
(mkHumanReadablePart <$> shrink (humanReadablePartToBytes hrp))
shrink hrp = catMaybes $ eitherToMaybe .
mkHumanReadablePart <$> shrink (humanReadablePartToBytes hrp)
arbitrary = do
let range =
( Bech32.humanReadableCharsetMinBound
, Bech32.humanReadableCharsetMaxBound )
bytes <-
choose (1, 10) >>= \n -> vectorOf n (choose range)
let (Just hrp) = mkHumanReadablePart (B8.map toLower $ BS.pack bytes)
let (Right hrp) = mkHumanReadablePart (B8.map toLower $ BS.pack bytes)
return hrp

instance Arbitrary ByteString where

0 comments on commit b7b7331

Please sign in to comment.
You can’t perform that action at this time.