Skip to content
Permalink
Browse files

Use a richer error return type for `decode`.

  • Loading branch information...
jonathanknowles committed May 16, 2019
1 parent ace34cc commit 53f6a9b11ea2d1b51120515da2287a8e86bd625a
@@ -31,6 +31,7 @@ library
build-depends:
array
, base
, bifunctors
, bytestring
, extra
hs-source-dirs:
@@ -1,4 +1,5 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
@@ -58,20 +59,24 @@ import Control.Monad
( guard )
import Data.Array
( Array )
import Data.Bifunctor
( first )
import Data.Bits
( Bits, testBit, unsafeShiftL, unsafeShiftR, xor, (.&.), (.|.) )
import Data.ByteString
( ByteString )
import Data.Char
( toLower, toUpper )
( ord, toLower, toUpper )
import Data.Either.Extra
( eitherToMaybe )
( maybeToEither )
import Data.Foldable
( foldl' )
import Data.Functor.Identity
( Identity, runIdentity )
import Data.Ix
( Ix (..) )
import Data.Maybe
( isJust )
import Data.Word
( Word8 )

@@ -141,18 +146,59 @@ encode hrp@(HumanReadablePart hrpBytes) payload = do
data EncodingError = EncodedStringTooLong
deriving (Eq, Show)

decode :: ByteString -> Maybe (HumanReadablePart, ByteString)
decode :: ByteString -> Either DecodingError (HumanReadablePart, ByteString)
decode bech32 = do
guard $ BS.length bech32 <= encodedStringMaxLength
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 >>= eitherToMaybe . mkHumanReadablePart
dat' <- mapM charsetMap $ B8.unpack dat
guard $ bech32VerifyChecksum hrp' dat'
result <- toBase256 (take (BS.length dat - checksumLength) dat')
return (hrp', BS.pack result)
(hrpUnparsed , dcpUnparsed) <-
maybeToEither StringToDecodeMissingSeparatorChar $
splitAtLastOccurrence separatorChar $ B8.map toLower bech32
hrp <- first hrpError $ mkHumanReadablePart hrpUnparsed
dcp <- first
(\(CharPosition p) -> StringToDecodeContainsInvalidChar $
CharPosition $ p + BS.length hrpUnparsed + separatorLength)
(parseDataPart $ B8.unpack dcpUnparsed)
guardE (BS.length bech32 <= encodedStringMaxLength)
StringToDecodeTooLong
guardE (BS.length bech32 >= encodedStringMinLength)
StringToDecodeTooShort
guardE (B8.map toUpper bech32 == bech32 || B8.map toLower bech32 == bech32)
StringToDecodeHasMixedCase
guardE (length dcp >= checksumLength)
StringToDecodeTooShort
guardE (bech32VerifyChecksum hrp dcp)
StringToDecodeContainsInvalidChars
dp <- maybeToEither StringToDecodeContainsInvalidChars $
toBase256 (take (length dcp - checksumLength) dcp)
return (hrp, BS.pack dp)
where
parseDataPart :: String -> Either CharPosition [Word5]
parseDataPart dpUnparsed =
case mapM charsetMap dpUnparsed of
Just dp -> pure dp
Nothing -> Left $ CharPosition $ length $
takeWhile isJust (charsetMap <$> dpUnparsed)
hrpError = \case
HumanReadablePartTooLong ->
StringToDecodeContainsInvalidChar $ CharPosition
humanReadablePartMaxLength
HumanReadablePartTooShort ->
StringToDecodeContainsInvalidChar $ CharPosition $
humanReadablePartMinLength - 1
HumanReadablePartContainsInvalidChar p ->
StringToDecodeContainsInvalidChar p

data DecodingError
= StringToDecodeTooLong
| StringToDecodeTooShort
| StringToDecodeHasMixedCase
| StringToDecodeMissingSeparatorChar
| StringToDecodeContainsInvalidChar CharPosition
| StringToDecodeContainsInvalidChars
deriving (Eq, Show)

-- | The separator character. This character appears immediately after the
-- human-readable part and before the data part.
separatorChar :: Word8
separatorChar = fromIntegral $ ord '1'

-- | The length of the checksum portion of an encoded string, in bytes.
checksumLength :: Int
@@ -305,3 +351,11 @@ toBase256 dat =

guardE :: Bool -> e -> Either e ()
guardE b e = if b then Right () else Left e

-- | Splits the given 'ByteString' into a prefix and a suffix using the last
-- occurrence of the specified separator character as a splitting point.
-- Evaluates to 'Nothing' if the 'ByteString` does not contain the separator
-- character.
splitAtLastOccurrence :: Word8 -> ByteString -> Maybe (ByteString, ByteString)
splitAtLastOccurrence w s =
(\i -> (BS.take i s, BS.drop (i + 1) s)) <$> BS.elemIndexEnd w s
@@ -19,12 +19,14 @@ import Data.ByteString
( ByteString )
import Data.Char
( toLower, toUpper )
import Data.Either
( isLeft )
import Data.Either.Extra
( eitherToMaybe )
import Data.Functor.Identity
( runIdentity )
import Data.Maybe
( catMaybes, isJust, isNothing )
( catMaybes, isJust )
import Data.Word
( Word8 )
import Test.Hspec
@@ -50,15 +52,15 @@ spec :: Spec
spec = do
describe "Valid Checksums" $ forM_ validChecksums $ \checksum ->
it (B8.unpack checksum) $ case Bech32.decode checksum of
Nothing ->
Left _ ->
expectationFailure (show checksum)
Just (resultHRP, resultData) -> do
Right (resultHRP, resultData) -> do
-- test that a corrupted checksum fails decoding.
let (hrp, rest) = B8.breakEnd (== '1') checksum
let Just (first, rest') = BS.uncons rest
let checksumCorrupted =
(hrp `BS.snoc` (first `xor` 1)) `BS.append` rest'
(Bech32.decode checksumCorrupted) `shouldSatisfy` isNothing
(Bech32.decode checksumCorrupted) `shouldSatisfy` isLeft
-- test that re-encoding the decoded checksum results in
-- the same checksum.
let checksumEncoded = Bech32.encode resultHRP resultData
@@ -67,7 +69,7 @@ spec = do

describe "Invalid Checksums" $ forM_ invalidChecksums $ \checksum ->
it (B8.unpack checksum) $
Bech32.decode checksum `shouldSatisfy` isNothing
Bech32.decode checksum `shouldSatisfy` isLeft

describe "More Encoding/Decoding Cases" $ do
it "length > maximum" $ do
@@ -88,7 +90,7 @@ spec = do
describe "Roundtrip (encode . decode)" $ do
it "Can perform roundtrip for valid data" $ property $ \(hrp, bytes) ->
(eitherToMaybe (Bech32.encode hrp bytes)
>>= Bech32.decode) === Just (hrp, bytes)
>>= eitherToMaybe . Bech32.decode) === Just (hrp, bytes)

describe "Roundtrip (toBase256 . toBase32)" $ do
it "Can perform roundtrip base conversion" $ property $ \ws ->

0 comments on commit 53f6a9b

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