base58

Pure Haskell base58, base58check encoding/decoding (docs.ppad.tech/base58).
git clone git://git.ppad.tech/base58.git
Log | Files | Refs | README | LICENSE

Main.hs (3195B)

      1 {-# LANGUAGE LambdaCase #-}
      2 {-# LANGUAGE OverloadedStrings #-}
      3 {-# LANGUAGE RecordWildCards #-}
      4 
      5 module Main where
      6 
      7 import Data.Aeson ((.:))
      8 import qualified Data.Aeson as A
      9 import qualified Data.ByteString as BS
     10 import qualified Data.ByteString.Base16 as B16
     11 import qualified Data.ByteString.Base58 as B58
     12 import qualified Data.ByteString.Base58Check as B58Check
     13 import qualified Data.Text.Encoding as TE
     14 import qualified Data.Text.IO as TIO
     15 import Test.Tasty
     16 import Test.Tasty.HUnit
     17 
     18 data Valid_Base58Check = Valid_Base58Check {
     19     vc_string  :: !BS.ByteString
     20   , vc_payload :: !BS.ByteString
     21   } deriving Show
     22 
     23 instance A.FromJSON Valid_Base58Check where
     24   parseJSON = A.withObject "Valid_Base58Check" $ \m -> Valid_Base58Check
     25     <$> fmap TE.encodeUtf8 (m .: "string")
     26     <*> fmap (B16.decodeLenient . TE.encodeUtf8) (m .: "payload")
     27 
     28 data Invalid_Base58Check = Invalid_Base58Check {
     29     ic_string  :: !BS.ByteString
     30   } deriving Show
     31 
     32 instance A.FromJSON Invalid_Base58Check where
     33   parseJSON = A.withObject "Invalid_Base58Check" $ \m -> Invalid_Base58Check
     34     <$> fmap TE.encodeUtf8 (m .: "string")
     35 
     36 data Base58Check = Base58Check {
     37     b58c_valid   :: ![Valid_Base58Check]
     38   , b58c_invalid :: ![Invalid_Base58Check]
     39   } deriving Show
     40 
     41 instance A.FromJSON Base58Check where
     42   parseJSON = A.withObject "Base58Check" $ \m -> Base58Check
     43     <$> (m .: "valid")
     44     <*> (m .: "invalid")
     45 
     46 
     47 execute_base58check :: Base58Check -> TestTree
     48 execute_base58check Base58Check {..} = testGroup "base58check" [
     49       testGroup "valid" (fmap execute_valid b58c_valid)
     50     , testGroup "invalid" (fmap execute_invalid b58c_invalid)
     51     ]
     52   where
     53     execute_valid Valid_Base58Check {..} = testCase "valid" $ do -- label
     54       let enc = case BS.uncons vc_payload of
     55             Nothing -> error "faulty"
     56             Just (h, t) -> B58Check.encode h t
     57       assertEqual mempty enc vc_string
     58 
     59     execute_invalid Invalid_Base58Check {..} = testCase "invalid" $ do -- label
     60       let dec = B58Check.decode ic_string
     61           is_just = \case
     62             Nothing -> False
     63             Just _ -> True
     64       assertBool mempty (not (is_just dec))
     65 
     66 data Valid_Base58 = Valid_Base58 {
     67     vb_decodedHex  :: !BS.ByteString
     68   , vb_encoded     :: !BS.ByteString
     69   } deriving Show
     70 
     71 instance A.FromJSON Valid_Base58 where
     72   parseJSON = A.withObject "Valid_Base58" $ \m -> Valid_Base58
     73     <$> fmap (B16.decodeLenient . TE.encodeUtf8) (m .: "decodedHex")
     74     <*> fmap TE.encodeUtf8 (m .: "encoded")
     75 
     76 execute_base58 :: Valid_Base58 -> TestTree -- XX label
     77 execute_base58 Valid_Base58 {..} = testCase "base58" $ do
     78   let enc = B58.encode vb_decodedHex
     79   assertEqual mempty enc vb_encoded
     80 
     81 main :: IO ()
     82 main = do
     83   scure_base58 <- TIO.readFile "etc/base58.json"
     84   scure_base58check <- TIO.readFile "etc/base58_check.json"
     85   let per = do
     86         b0 <- A.decodeStrictText scure_base58 :: Maybe [Valid_Base58]
     87         b1 <- A.decodeStrictText scure_base58check :: Maybe Base58Check
     88         pure (b0, b1)
     89   case per of
     90     Nothing -> error "couldn't parse vectors"
     91     Just (b58, b58c) -> defaultMain $ testGroup "ppad-base58" [
     92         testGroup "base58" (fmap execute_base58 b58)
     93       , execute_base58check b58c
     94       ]
     95