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 (4110B)

      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 import qualified Test.Tasty.QuickCheck as Q
     18 
     19 data Valid_Base58Check = Valid_Base58Check {
     20     vc_string  :: !BS.ByteString
     21   , vc_payload :: !BS.ByteString
     22   } deriving Show
     23 
     24 instance A.FromJSON Valid_Base58Check where
     25   parseJSON = A.withObject "Valid_Base58Check" $ \m -> Valid_Base58Check
     26     <$> fmap TE.encodeUtf8 (m .: "string")
     27     <*> fmap (B16.decodeLenient . TE.encodeUtf8) (m .: "payload")
     28 
     29 data Invalid_Base58Check = Invalid_Base58Check {
     30     ic_string  :: !BS.ByteString
     31   } deriving Show
     32 
     33 instance A.FromJSON Invalid_Base58Check where
     34   parseJSON = A.withObject "Invalid_Base58Check" $ \m -> Invalid_Base58Check
     35     <$> fmap TE.encodeUtf8 (m .: "string")
     36 
     37 data Base58Check = Base58Check {
     38     b58c_valid   :: ![Valid_Base58Check]
     39   , b58c_invalid :: ![Invalid_Base58Check]
     40   } deriving Show
     41 
     42 instance A.FromJSON Base58Check where
     43   parseJSON = A.withObject "Base58Check" $ \m -> Base58Check
     44     <$> (m .: "valid")
     45     <*> (m .: "invalid")
     46 
     47 
     48 execute_base58check :: Base58Check -> TestTree
     49 execute_base58check Base58Check {..} = testGroup "base58check" [
     50       testGroup "valid" (fmap execute_valid b58c_valid)
     51     , testGroup "invalid" (fmap execute_invalid b58c_invalid)
     52     ]
     53   where
     54     execute_valid Valid_Base58Check {..} = testCase "valid" $ do -- label
     55       let enc = B58Check.encode vc_payload
     56       assertEqual mempty enc vc_string
     57 
     58     execute_invalid Invalid_Base58Check {..} = testCase "invalid" $ do -- label
     59       let dec = B58Check.decode ic_string
     60           is_just = \case
     61             Nothing -> False
     62             Just _ -> True
     63       assertBool mempty (not (is_just dec))
     64 
     65 data Valid_Base58 = Valid_Base58 {
     66     vb_decodedHex  :: !BS.ByteString
     67   , vb_encoded     :: !BS.ByteString
     68   } deriving Show
     69 
     70 instance A.FromJSON Valid_Base58 where
     71   parseJSON = A.withObject "Valid_Base58" $ \m -> Valid_Base58
     72     <$> fmap (B16.decodeLenient . TE.encodeUtf8) (m .: "decodedHex")
     73     <*> fmap TE.encodeUtf8 (m .: "encoded")
     74 
     75 execute_base58 :: Valid_Base58 -> TestTree -- XX label
     76 execute_base58 Valid_Base58 {..} = testCase "base58" $ do
     77   let enc = B58.encode vb_decodedHex
     78   assertEqual mempty enc vb_encoded
     79 
     80 newtype BS = BS BS.ByteString
     81   deriving (Eq, Show)
     82 
     83 bytes :: Int -> Q.Gen BS.ByteString
     84 bytes k = do
     85   l <- Q.chooseInt (0, k)
     86   v <- Q.vectorOf l Q.arbitrary
     87   pure (BS.pack v)
     88 
     89 instance Q.Arbitrary BS where
     90   arbitrary = do
     91     b <- bytes 1024
     92     pure (BS b)
     93 
     94 base58_decode_inverts_encode :: BS -> Bool
     95 base58_decode_inverts_encode (BS bs) = case B58.decode (B58.encode bs) of
     96   Nothing -> False
     97   Just b  -> b == bs
     98 
     99 base58check_decode_inverts_encode :: BS -> Bool
    100 base58check_decode_inverts_encode (BS bs) =
    101   case B58Check.decode (B58Check.encode bs) of
    102     Nothing -> False
    103     Just b  -> b == bs
    104 
    105 main :: IO ()
    106 main = do
    107   scure_base58 <- TIO.readFile "etc/base58.json"
    108   scure_base58check <- TIO.readFile "etc/base58_check.json"
    109   let per = do
    110         b0 <- A.decodeStrictText scure_base58 :: Maybe [Valid_Base58]
    111         b1 <- A.decodeStrictText scure_base58check :: Maybe Base58Check
    112         pure (b0, b1)
    113   case per of
    114     Nothing -> error "couldn't parse vectors"
    115     Just (b58, b58c) -> defaultMain $ testGroup "ppad-base58" [
    116         testGroup "unit tests" [
    117             testGroup "base58" (fmap execute_base58 b58)
    118           , execute_base58check b58c
    119           ]
    120       , testGroup "property tests" [
    121           Q.testProperty "(base58) decode . encode ~ id" $
    122             Q.withMaxSuccess 250 base58_decode_inverts_encode
    123         , Q.testProperty "(base58check) decode . encode ~ id" $
    124             Q.withMaxSuccess 250 base58check_decode_inverts_encode
    125         ]
    126       ]
    127