[LTB-7] Extract bech32 encoding

code/crypto/README.md

@@ -0,0 +1,5 @@
+lootbox-crypto
+=============
+
+Package with cryptography tools:
+ - `Bech32` encoding/decoding _(see [Bitcoin Improvement Proposal #173](https://github.com/bitcoin/bips/blob/master/bip-0173.mediawiki) for more information)_

code/crypto/lib/Loot/Crypto/Bech32.hs

@@ -0,0 +1,26 @@
+module Loot.Crypto.Bech32
+    (     DecodeError (..)
+        , EncodeError (..)
+        , HumanReadablePart
+        , encode
+        , decode
+    )
+    where
+
+import Universum
+
+import Codec.Binary.Bech32 (DecodeError (..), EncodeError (..), bech32Decode, bech32Encode,
+                            fromWord5, word5)
+
+import qualified Data.ByteString as BS
+
+type HumanReadablePart = ByteString
+
+encode :: ConvertUtf8 t ByteString =>
+    HumanReadablePart
+    -> ByteString
+    -> Either EncodeError t
+encode hrp = fmap decodeUtf8 . bech32Encode hrp . fmap word5 . BS.unpack
+
+decode :: ConvertUtf8 t ByteString => t -> Either DecodeError (HumanReadablePart, ByteString)
+decode =  fmap (fmap (BS.pack . (fmap fromWord5))). bech32Decode . encodeUtf8

code/crypto/package.yaml

@@ -0,0 +1,21 @@
+<<: !include "../base/hpack/lib.yaml"
+
+name: loot-crypto
+
+library:
+  <<: *lib-common
+
+  dependencies:
+  - bech32-haskell       == 0.1.*
+  - bytestring
+
+tests:
+  loot-base-test:
+    <<: *test-common
+
+    dependencies:
+      - tasty
+      - tasty-discover
+      - tasty-hunit
+
+      - loot-crypto

code/crypto/test/Test.hs

@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --tree-display #-}

code/crypto/test/Test/Loot/Crypto/Bech32.hs

@@ -0,0 +1,139 @@
+module Test.Loot.Crypto.Bech32 where
+
+import Universum
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import qualified Loot.Crypto.Bech32 as B32
+
+--------------------------------------------
+---- Test data
+--------------------------------------------
+
+validB32Strings :: [String]
+validB32Strings =
+    [
+            "A12UEL5L"
+          , "a12uel5l"
+          , "an83characterlonghumanreadablepartthatcontainsthenumber1andtheexcludedcharactersbio1tt5tgs"
+          , "abcdef1qpzry9x8gf2tvdw0s3jn54khce6mua7lmqqqxw"
+          , "11qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqc8247j"
+          , "split1checkupstagehandshakeupstreamerranterredcaperred2y9e3w"
+    ]
+
+b32WithInvalidHRP :: [String]
+b32WithInvalidHRP =
+    [
+          "1qzzfhee"
+        , "10a06t8"
+        , "1pzry9x0s0muk"
+        , "pzry9x0s0muk"
+    ]
+
+b32WithExceededLength :: [String]
+b32WithExceededLength =
+    [
+        "an84characterslonghumanreadablepartthatcontainsthenumber1andtheexcludedcharactersbio1569pvx"
+    ]
+
+b32WithInvalidChecksum :: [String]
+b32WithInvalidChecksum =
+    [
+          "A1G7SGD8"
+        , "a1fuel5l"
+        , "an83characterlonghumanreadablepartthatcontainsthenumber1fndtheexcludedcharactersbio1tt5tgs"
+        , "abcdef1fpzry9x8gf2tvdw0s3jn54khce6mua7lmqqqxw"
+        , "11fqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqc8247j"
+        , "split1fheckupstagehandshakeupstreamerranterredcaperred2y9e3w"
+    ]
+
+b32WithInvalidCharsetMap :: [String]
+b32WithInvalidCharsetMap =
+    [
+          "a1bbel5l"
+        , "a1ibel5l"
+        , "a1obel5l"
+    ]
+
+b32WithCaseInconsistency :: [String]
+b32WithCaseInconsistency =
+    [
+          "A12UeL5L"
+        , "a12uFl5l"
+        , "An83characterlonghumanreadablepartthatcontainsthenumber1andtheexcludedcharactersbio1tt5tgs"
+        , "Abcdef1qpzry9x8gf2tvdw0s3jn54khce6mua7lmqqqxw"
+        , "11Qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqc8247j"
+        , "Split1checkupstagehandshakeupstreamerranterredcaperred2y9e3w"
+    ]
+
+b32WithTooShortDataPart :: [String]
+b32WithTooShortDataPart =
+    [
+
+          "a1f"
+        , "a1ff"
+        , "a1fff"
+        , "a1ffff"
+        , "a1fffff"
+    ]
+
+--------------------------------------------
+--------------------------------------------
+--------------------------------------------
+
+-----------------------
+-- Decoding
+-----------------------
+
+
+unit_validB32Strings :: Assertion
+unit_validB32Strings = assertDecodeSuccess validB32Strings
+
+unit_invalidHRP :: Assertion
+unit_invalidHRP = assertDecodeError B32.InvalidHRP comment b32WithInvalidHRP
+  where comment = "has invlaid human readable part."
+
+unit_exceededLength :: Assertion
+unit_exceededLength = assertDecodeError B32.Bech32StringLengthExceeded comment b32WithExceededLength
+  where comment = "has exceeded length"
+
+unit_invalidChecksums :: Assertion
+unit_invalidChecksums = assertDecodeError B32.ChecksumVerificationFail comment b32WithInvalidChecksum
+  where comment = "has invalid checksum"
+
+unit_invalidCharsetMap :: Assertion
+unit_invalidCharsetMap = assertDecodeError B32.InvalidCharsetMap comment b32WithInvalidCharsetMap
+  where comment = "has invalid charset map"
+
+unit_caseInconsistency :: Assertion
+unit_caseInconsistency = assertDecodeError B32.CaseInconsistency comment b32WithCaseInconsistency
+  where comment = "has case inconsitency"
+
+unit_tooShortDataPart :: Assertion
+unit_tooShortDataPart = assertDecodeError B32.TooShortDataPart comment b32WithTooShortDataPart
+  where comment = "has too short data part"
+-----------------------
+-- Helpers
+-----------------------
+
+assertDecodeSuccess :: [String] -> Assertion
+assertDecodeSuccess = assertDecode isRight
+    "Is valid and should be decoded successfully."
+
+assertDecodeError :: B32.DecodeError -> String -> [String] -> Assertion
+assertDecodeError err comment = assertDecode (isError err) (comment ++ " and therefore is invalid.")
+
+assertDecode :: (Either B32.DecodeError (B32.HumanReadablePart, ByteString) -> Bool)
+    -> String
+    -> [String]
+    -> Assertion
+assertDecode pred comment inp = forM_ inp validadteDecoding
+  where
+    validadteDecoding b32str = assert' . pred . B32.decode $ b32str
+      where
+        assert' = assertBool $ (show b32str)++" "++comment
+
+isError :: Eq a => a -> Either a b -> Bool
+isError e' (Left e) = e == e'
+isError _ _         = False

snapshot.yaml

@@ -10,6 +10,11 @@ packages:
 
   - git: https://github.com/int-index/caps
     commit: 858e76d8d92d683ff75f298ff39ca6b24daafaac
+
+  - git: https://github.com/serokell/bech32
+    commit: ef375b8252dad4a08092fa1a508dcf0a284b31fa
+    subdirs:
+    - ref/haskell
 
   # for log-warper
   - o-clock-0.1.0

stack.yaml

@@ -3,6 +3,7 @@ resolver: snapshot.yaml
 packages:
   - code/base
   - code/config
+  - code/crypto
   - code/network
 
   - code/demo