From fd6a1440246eb8ebf627669d582b921b9bfa16c1 Mon Sep 17 00:00:00 2001
From: Mikhail Kilianovski <mitutee@gmail.com>
Date: Thu, 15 Mar 2018 16:55:17 +0200
Subject: [PATCH 1/4] Refactor `Maybe` to `Either DecodeError`

---
 ref/haskell/src/Codec/Binary/Bech32.hs | 52 +++++++++++++++++---------
 ref/haskell/test/Spec.hs               | 20 ++++++----
 2 files changed, 47 insertions(+), 25 deletions(-)

diff --git a/ref/haskell/src/Codec/Binary/Bech32.hs b/ref/haskell/src/Codec/Binary/Bech32.hs
index 23e58a5..e2c6201 100644
--- a/ref/haskell/src/Codec/Binary/Bech32.hs
+++ b/ref/haskell/src/Codec/Binary/Bech32.hs
@@ -1,5 +1,7 @@
 module Codec.Binary.Bech32
-  ( bech32Encode
+  ( DecodeError(..)
+
+  , bech32Encode
   , bech32Decode
   , toBase32
   , toBase256
@@ -10,15 +12,15 @@ module Codec.Binary.Bech32
   , fromWord5
   ) where
 
-import Control.Monad (guard)
+import Control.Monad (guard, when)
 import qualified Data.Array as Arr
-import Data.Bits (Bits, unsafeShiftL, unsafeShiftR, (.&.), (.|.), xor, testBit)
+import Data.Bits (Bits, testBit, unsafeShiftL, unsafeShiftR, xor, (.&.), (.|.))
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as BSC
 import Data.Char (toLower, toUpper)
 import Data.Foldable (foldl')
 import Data.Functor.Identity (Identity, runIdentity)
-import Data.Ix (Ix(..))
+import Data.Ix (Ix (..))
 import Data.Word (Word8)
 
 type HRP = BS.ByteString
@@ -29,7 +31,7 @@ type Data = [Word8]
 (.<<.) = unsafeShiftL
 
 newtype Word5 = UnsafeWord5 Word8
-              deriving (Eq, Ord)
+              deriving (Eq, Ord, Show)
 
 instance Ix Word5 where
   range (UnsafeWord5 m, UnsafeWord5 n) = map UnsafeWord5 $ range (m, n)
@@ -79,32 +81,43 @@ bech32VerifyChecksum hrp dat = bech32Polymod (bech32HRPExpand hrp ++ dat) == 1
 
 bech32Encode :: HRP -> [Word5] -> Maybe BS.ByteString
 bech32Encode hrp dat = do
-    guard $ checkHRP hrp
+    guard $ validHRP hrp
     let dat' = dat ++ bech32CreateChecksum hrp dat
         rest = map (charset Arr.!) dat'
         result = BSC.concat [BSC.map toLower hrp, BSC.pack "1", BSC.pack rest]
     guard $ BS.length result <= 90
     return result
 
-checkHRP :: BS.ByteString -> Bool
-checkHRP hrp = not (BS.null hrp) && BS.all (\char -> char >= 33 && char <= 126) hrp
+validHRP :: BS.ByteString -> Bool
+validHRP hrp = not (BS.null hrp) && BS.all (\char -> char >= 33 && char <= 126) hrp
+
+data DecodeError =
+    Bech32StringLengthExceeded
+  | CaseInconsistency
+  | TooShortDataPart
+  | InvalidHRP
+  | ChecksumVerificationFail
+  | InvalidCharsetMap
+  deriving (Show, Eq)
 
-bech32Decode :: BS.ByteString -> Maybe (HRP, [Word5])
+bech32Decode :: BS.ByteString -> Either DecodeError (HRP, [Word5])
 bech32Decode bech32 = do
-    guard $ BS.length bech32 <= 90
-    guard $ BSC.map toUpper bech32 == bech32 || BSC.map toLower bech32 == bech32
+    when (BS.length bech32 > 90) (Left Bech32StringLengthExceeded)
+    when (not $ validCase bech32) (Left CaseInconsistency)
     let (hrp, dat) = BSC.breakEnd (== '1') $ BSC.map toLower bech32
-    guard $ BS.length dat >= 6
-    hrp' <- BSC.stripSuffix (BSC.pack "1") hrp
-    guard $ checkHRP hrp'
-    dat' <- mapM charsetMap $ BSC.unpack dat
-    guard $ bech32VerifyChecksum hrp' dat'
+    when (BS.length dat < 6) (Left TooShortDataPart)
+    hrp' <- maybe (Left InvalidHRP) Right $ BSC.stripSuffix (BSC.pack "1") hrp
+    when (not $ validHRP hrp') (Left InvalidHRP)
+    dat' <- maybe (Left InvalidCharsetMap) Right $ mapM charsetMap $ BSC.unpack dat
+    when (not $ bech32VerifyChecksum hrp' dat') (Left ChecksumVerificationFail)
     return (hrp', take (BS.length dat - 6) dat')
+      where
+        validCase b32 = BSC.map toUpper b32 == b32 || BSC.map toLower b32 == b32
 
 type Pad f = Int -> Int -> Word -> [[Word]] -> f [[Word]]
 
 yesPadding :: Pad Identity
-yesPadding _ 0 _ result = return result
+yesPadding _ 0 _ result        = return result
 yesPadding _ _ padValue result = return $ [padValue] : result
 {-# INLINE yesPadding #-}
 
@@ -146,7 +159,7 @@ segwitCheck witver witprog =
 
 segwitDecode :: HRP -> BS.ByteString -> Maybe (Word8, Data)
 segwitDecode hrp addr = do
-    (hrp', dat) <- bech32Decode addr
+    (hrp', dat) <- rightToMaybe $ bech32Decode addr
     guard $ (hrp == hrp') && not (null dat)
     let (UnsafeWord5 witver : datBase32) = dat
     decoded <- toBase256 datBase32
@@ -157,3 +170,6 @@ segwitEncode :: HRP -> Word8 -> Data -> Maybe BS.ByteString
 segwitEncode hrp witver witprog = do
     guard $ segwitCheck witver witprog
     bech32Encode hrp $ UnsafeWord5 witver : toBase32 witprog
+
+rightToMaybe :: Either l r -> Maybe r
+rightToMaybe = either (const Nothing) Just
diff --git a/ref/haskell/test/Spec.hs b/ref/haskell/test/Spec.hs
index 4b54695..e0a264f 100644
--- a/ref/haskell/test/Spec.hs
+++ b/ref/haskell/test/Spec.hs
@@ -1,12 +1,14 @@
+import Codec.Binary.Bech32 (DecodeError (..), bech32Decode, bech32Encode, segwitDecode,
+                            segwitEncode, word5)
 import Control.Monad (forM_)
 import Data.Bits (xor)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Base16 as B16
 import qualified Data.ByteString.Char8 as BSC
 import Data.Char (toLower)
-import Data.Maybe (isNothing, isJust)
+import Data.Either (isLeft)
+import Data.Maybe (isJust, isNothing)
 import Data.Word (Word8)
-import Codec.Binary.Bech32 (bech32Encode, bech32Decode, segwitEncode, segwitDecode, word5)
 import Test.Tasty
 import Test.Tasty.HUnit
 
@@ -75,19 +77,19 @@ tests :: TestTree
 tests = testGroup "Tests"
     [ testCase "Checksums" $ forM_ validChecksums $ \checksum -> do
           case bech32Decode checksum of
-            Nothing -> assertFailure (show checksum)
-            Just (resultHRP, resultData) -> do
+            Left err -> assertFailure (show checksum ++ show err)
+            Right (resultHRP, resultData) -> do
                 -- test that a corrupted checksum fails decoding.
                 let (hrp, rest) = BSC.breakEnd (== '1') checksum
                     Just (first, rest') = BS.uncons rest
                     checksumCorrupted = (hrp `BS.snoc` (first `xor` 1)) `BS.append` rest'
-                assertBool (show checksum ++ " corrupted") $ isNothing (bech32Decode checksumCorrupted)
+                assertBool (show checksum ++ " corrupted") $ isLeft (bech32Decode checksumCorrupted)
                 -- test that re-encoding the decoded checksum results in the same checksum.
                 let checksumEncoded = bech32Encode resultHRP resultData
                     expectedChecksum = Just $ BSC.map toLower checksum
                 assertEqual (show checksum ++ " re-encode") expectedChecksum checksumEncoded
     , testCase "Invalid checksums" $ forM_ invalidChecksums $
-          \checksum -> assertBool (show checksum) (isNothing $ bech32Decode checksum)
+          \checksum -> assertBool (show checksum) (isLeft $ bech32Decode checksum)
     , testCase "Addresses" $ forM_ validAddresses $ \(address, hexscript) -> do
           let address' = BSC.map toLower address
               hrp = BSC.take 2 address'
@@ -111,8 +113,12 @@ tests = testGroup "Tests"
           assertBool "segwit prog len version != 0" $ isNothing $
               segwitEncode (BSC.pack "bc") 1 (replicate 41 1)
           assertBool "empty HRP encode" $ isNothing $ bech32Encode (BSC.pack "") []
-          assertBool "empty HRP decode" $ isNothing $ bech32Decode (BSC.pack "10a06t8")
+          assertBool "empty HRP decode" $ isError InvalidHRP $ bech32Decode (BSC.pack "10a06t8")
           assertEqual "hrp lowercased"
               (Just $ BSC.pack "hrp1g9xj8m")
               (bech32Encode (BSC.pack "HRP") [])
     ]
+
+isError :: DecodeError -> Either DecodeError a -> Bool
+isError e' (Left e) = e == e'
+isError _ _         = False

From 1327235996584a138fcffa3108e042cb70113c6f Mon Sep 17 00:00:00 2001
From: Mikhail Kilianovski <mitutee@gmail.com>
Date: Thu, 15 Mar 2018 16:55:28 +0200
Subject: [PATCH 2/4] Add .gitignore

---
 .gitignore | 2 ++
 1 file changed, 2 insertions(+)
 create mode 100644 .gitignore

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..ecaf390
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+# Haskell stack build artifacts
+.stack-work/

From 9861966e52c09a4c161e4ab58247e4fe79282f9c Mon Sep 17 00:00:00 2001
From: Mikhail Kilianovski <mitutee@gmail.com>
Date: Mon, 19 Mar 2018 18:38:23 +0200
Subject: [PATCH 3/4] [LTB-7] Refactor

---
 ref/haskell/src/Codec/Binary/Bech32.hs | 23 +++++++++++++++--------
 1 file changed, 15 insertions(+), 8 deletions(-)

diff --git a/ref/haskell/src/Codec/Binary/Bech32.hs b/ref/haskell/src/Codec/Binary/Bech32.hs
index e2c6201..215ce51 100644
--- a/ref/haskell/src/Codec/Binary/Bech32.hs
+++ b/ref/haskell/src/Codec/Binary/Bech32.hs
@@ -12,7 +12,7 @@ module Codec.Binary.Bech32
   , fromWord5
   ) where
 
-import Control.Monad (guard, when)
+import Control.Monad (guard)
 import qualified Data.Array as Arr
 import Data.Bits (Bits, testBit, unsafeShiftL, unsafeShiftR, xor, (.&.), (.|.))
 import qualified Data.ByteString as BS
@@ -102,16 +102,20 @@ data DecodeError =
 
 bech32Decode :: BS.ByteString -> Either DecodeError (HRP, [Word5])
 bech32Decode bech32 = do
-    when (BS.length bech32 > 90) (Left Bech32StringLengthExceeded)
-    when (not $ validCase bech32) (Left CaseInconsistency)
+    verify (BS.length bech32 <= 90) Bech32StringLengthExceeded
+    verify (validCase bech32) CaseInconsistency
     let (hrp, dat) = BSC.breakEnd (== '1') $ BSC.map toLower bech32
-    when (BS.length dat < 6) (Left TooShortDataPart)
-    hrp' <- maybe (Left InvalidHRP) Right $ BSC.stripSuffix (BSC.pack "1") hrp
-    when (not $ validHRP hrp') (Left InvalidHRP)
-    dat' <- maybe (Left InvalidCharsetMap) Right $ mapM charsetMap $ BSC.unpack dat
-    when (not $ bech32VerifyChecksum hrp' dat') (Left ChecksumVerificationFail)
+    verify (BS.length dat >= 6) TooShortDataPart
+    hrp' <- maybeToRight InvalidHRP $ BSC.stripSuffix (BSC.pack "1") hrp
+    verify (validHRP hrp') InvalidHRP
+    dat' <- maybeToRight InvalidCharsetMap $ mapM charsetMap $ BSC.unpack dat
+    verify (bech32VerifyChecksum hrp' dat') ChecksumVerificationFail
     return (hrp', take (BS.length dat - 6) dat')
       where
+        verify :: Bool -> a -> Either a ()
+        verify True _  = Right ()
+        verify False v = Left v
+        validCase :: BS.ByteString -> Bool
         validCase b32 = BSC.map toUpper b32 == b32 || BSC.map toLower b32 == b32
 
 type Pad f = Int -> Int -> Word -> [[Word]] -> f [[Word]]
@@ -173,3 +177,6 @@ segwitEncode hrp witver witprog = do
 
 rightToMaybe :: Either l r -> Maybe r
 rightToMaybe = either (const Nothing) Just
+
+maybeToRight :: l -> Maybe r -> Either l r
+maybeToRight l = maybe (Left l) Right

From ef375b8252dad4a08092fa1a508dcf0a284b31fa Mon Sep 17 00:00:00 2001
From: Mikhail Kilianovski <mitutee@gmail.com>
Date: Tue, 20 Mar 2018 17:55:05 +0200
Subject: [PATCH 4/4] [LTB-7] Refactor `Maybe` to `Either EncodeError`

---
 ref/haskell/src/Codec/Binary/Bech32.hs | 24 ++++++++++++++++--------
 ref/haskell/test/Spec.hs               | 14 +++++++-------
 2 files changed, 23 insertions(+), 15 deletions(-)

diff --git a/ref/haskell/src/Codec/Binary/Bech32.hs b/ref/haskell/src/Codec/Binary/Bech32.hs
index 215ce51..02bd80b 100644
--- a/ref/haskell/src/Codec/Binary/Bech32.hs
+++ b/ref/haskell/src/Codec/Binary/Bech32.hs
@@ -1,5 +1,7 @@
 module Codec.Binary.Bech32
-  ( DecodeError(..)
+  (
+    DecodeError(..)
+  , EncodeError(..)
 
   , bech32Encode
   , bech32Decode
@@ -79,13 +81,18 @@ bech32CreateChecksum hrp dat = [word5 (polymod .>>. i) | i <- [25,20..0]]
 bech32VerifyChecksum :: HRP -> [Word5] -> Bool
 bech32VerifyChecksum hrp dat = bech32Polymod (bech32HRPExpand hrp ++ dat) == 1
 
-bech32Encode :: HRP -> [Word5] -> Maybe BS.ByteString
+data EncodeError =
+      ResultStringLengthExceeded
+    | InvalidHumanReadablePart
+    deriving (Show, Eq)
+
+bech32Encode :: HRP -> [Word5] -> Either EncodeError BS.ByteString
 bech32Encode hrp dat = do
-    guard $ validHRP hrp
+    verify (validHRP hrp) InvalidHumanReadablePart
     let dat' = dat ++ bech32CreateChecksum hrp dat
         rest = map (charset Arr.!) dat'
         result = BSC.concat [BSC.map toLower hrp, BSC.pack "1", BSC.pack rest]
-    guard $ BS.length result <= 90
+    verify (BS.length result <= 90) ResultStringLengthExceeded
     return result
 
 validHRP :: BS.ByteString -> Bool
@@ -112,9 +119,6 @@ bech32Decode bech32 = do
     verify (bech32VerifyChecksum hrp' dat') ChecksumVerificationFail
     return (hrp', take (BS.length dat - 6) dat')
       where
-        verify :: Bool -> a -> Either a ()
-        verify True _  = Right ()
-        verify False v = Left v
         validCase :: BS.ByteString -> Bool
         validCase b32 = BSC.map toUpper b32 == b32 || BSC.map toLower b32 == b32
 
@@ -173,10 +177,14 @@ segwitDecode hrp addr = do
 segwitEncode :: HRP -> Word8 -> Data -> Maybe BS.ByteString
 segwitEncode hrp witver witprog = do
     guard $ segwitCheck witver witprog
-    bech32Encode hrp $ UnsafeWord5 witver : toBase32 witprog
+    rightToMaybe $ bech32Encode hrp $ UnsafeWord5 witver : toBase32 witprog
 
 rightToMaybe :: Either l r -> Maybe r
 rightToMaybe = either (const Nothing) Just
 
 maybeToRight :: l -> Maybe r -> Either l r
 maybeToRight l = maybe (Left l) Right
+
+verify :: Bool -> a -> Either a ()
+verify True _  = Right ()
+verify False v = Left v
diff --git a/ref/haskell/test/Spec.hs b/ref/haskell/test/Spec.hs
index e0a264f..ecf3b67 100644
--- a/ref/haskell/test/Spec.hs
+++ b/ref/haskell/test/Spec.hs
@@ -1,5 +1,5 @@
-import Codec.Binary.Bech32 (DecodeError (..), bech32Decode, bech32Encode, segwitDecode,
-                            segwitEncode, word5)
+import Codec.Binary.Bech32 (DecodeError (..), EncodeError (..), bech32Decode, bech32Encode,
+                            segwitDecode, segwitEncode, word5)
 import Control.Monad (forM_)
 import Data.Bits (xor)
 import qualified Data.ByteString as BS
@@ -86,7 +86,7 @@ tests = testGroup "Tests"
                 assertBool (show checksum ++ " corrupted") $ isLeft (bech32Decode checksumCorrupted)
                 -- test that re-encoding the decoded checksum results in the same checksum.
                 let checksumEncoded = bech32Encode resultHRP resultData
-                    expectedChecksum = Just $ BSC.map toLower checksum
+                    expectedChecksum = Right $ BSC.map toLower checksum
                 assertEqual (show checksum ++ " re-encode") expectedChecksum checksumEncoded
     , testCase "Invalid checksums" $ forM_ invalidChecksums $
           \checksum -> assertBool (show checksum) (isLeft $ bech32Decode checksum)
@@ -102,7 +102,7 @@ tests = testGroup "Tests"
           assertBool (show address) (isNothing $ segwitDecode (BSC.pack "bc") address)
           assertBool (show address) (isNothing $ segwitDecode (BSC.pack "tb") address)
     , testCase "More Encoding/Decoding Cases" $ do
-          assertBool "length > 90" $ isNothing $
+          assertBool "length > 90" $ isError ResultStringLengthExceeded $
               bech32Encode (BSC.pack "bc") (replicate 82 (word5 (1::Word8)))
           assertBool "segwit version bounds" $ isNothing $
               segwitEncode (BSC.pack "bc") 17 []
@@ -112,13 +112,13 @@ tests = testGroup "Tests"
               segwitEncode (BSC.pack "bc") 1 (replicate 30 1)
           assertBool "segwit prog len version != 0" $ isNothing $
               segwitEncode (BSC.pack "bc") 1 (replicate 41 1)
-          assertBool "empty HRP encode" $ isNothing $ bech32Encode (BSC.pack "") []
+          assertBool "empty HRP encode" $ isError InvalidHumanReadablePart $ bech32Encode (BSC.pack "") []
           assertBool "empty HRP decode" $ isError InvalidHRP $ bech32Decode (BSC.pack "10a06t8")
           assertEqual "hrp lowercased"
-              (Just $ BSC.pack "hrp1g9xj8m")
+              (Right $ BSC.pack "hrp1g9xj8m")
               (bech32Encode (BSC.pack "HRP") [])
     ]
 
-isError :: DecodeError -> Either DecodeError a -> Bool
+isError :: Eq a => a -> Either a b -> Bool
 isError e' (Left e) = e == e'
 isError _ _         = False