Use a richer error return type for mkHumanReadablePart.

cardano-foundation · May 16, 2019 · 5d49758 · 5d49758
1 parent 95bc4e2
commit 5d49758
Show file tree

Hide file tree

Showing 3 changed files with 46 additions and 11 deletions.
diff --git a/lib/bech32/bech32.cabal b/lib/bech32/bech32.cabal
@@ -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

diff --git a/lib/bech32/src/Codec/Binary/Bech32/Internal.hs b/lib/bech32/src/Codec/Binary/Bech32/Internal.hs
@@ -25,10 +25,13 @@ module Codec.Binary.Bech32.Internal
 
       -- * Human-Readable Parts
     , HumanReadablePart
+    , HumanReadablePartError (..)
     , mkHumanReadablePart
     , humanReadablePartToBytes
     , humanReadableCharsetMinBound
     , humanReadableCharsetMaxBound
+    , humanReadablePartMinLength
+    , humanReadablePartMaxLength
 
       -- * Bit Manipulation
     , convertBits
@@ -58,6 +61,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 +83,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 +116,12 @@ humanReadableCharsetMaxBound = 126
 humanReadablePartToBytes :: HumanReadablePart -> ByteString
 humanReadablePartToBytes (HumanReadablePart bytes) = bytes
 
+humanReadablePartMinLength :: Int
+humanReadablePartMinLength = 1
+
+humanReadablePartMaxLength :: Int
+humanReadablePartMaxLength = 83
+
 {-------------------------------------------------------------------------------
                             Encoding & Decoding
 -------------------------------------------------------------------------------}
@@ -115,7 +141,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 +159,7 @@ maxEncodedStringLength :: Int
 maxEncodedStringLength = 90
 
 {-------------------------------------------------------------------------------
-                          Character Set Manipulation
+                            Character Manipulation
 -------------------------------------------------------------------------------}
 
 charset :: Array Word5 Char
@@ -153,6 +180,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
 -------------------------------------------------------------------------------}

diff --git a/lib/bech32/test/Codec/Binary/Bech32Spec.hs b/lib/bech32/test/Codec/Binary/Bech32Spec.hs
@@ -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