ppad-base58 (empty) → 0.1.0
raw patch · 7 files changed
+378/−0 lines, 7 filesdep +aesondep +basedep +base16-bytestring
Dependencies added: aeson, base, base16-bytestring, bytestring, criterion, ppad-base58, ppad-sha256, tasty, tasty-hunit, text
Files
- CHANGELOG +5/−0
- LICENSE +20/−0
- bench/Main.hs +33/−0
- lib/Data/ByteString/Base58.hs +107/−0
- lib/Data/ByteString/Base58Check.hs +52/−0
- ppad-base58.cabal +66/−0
- test/Main.hs +95/−0
+ CHANGELOG view
@@ -0,0 +1,5 @@+# Changelog++- 0.1.0 (2024-12-18)+ * Initial release, supporting basic encoding/decoding.+
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2024 Jared Tobin++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ bench/Main.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Criterion.Main+import qualified Data.ByteString.Base58 as B58+import qualified Data.ByteString.Base58Check as B58C++main :: IO ()+main = defaultMain [+ base32+ ]++base32 :: Benchmark+base32 = bgroup "ppad-base32" [+ bgroup "base58" [+ bgroup "encode" [+ bench "hello world" $ nf B58.encode "hello world"+ ]+ , bgroup "decode" [+ bench "StV1DL6CwTryKyV" $ nf B58.decode "StV1DL6CwTryKyV"+ ]+ ]+ , bgroup "base58check" [+ bgroup "encode" [+ bench "0x00, hello world" $ nf (B58C.encode 0x00) "hello world"+ ]+ , bgroup "decode" [+ bench "13vQB7B6MrGQZaxCqW9KER" $+ nf B58C.decode "13vQB7B6MrGQZaxCqW9KER"+ ]+ ]+ ]
+ lib/Data/ByteString/Base58.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}++-- |+-- Module: Data.ByteString.Base58+-- Copyright: (c) 2024 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- base58 encoding and decoding of strict bytestrings.++module Data.ByteString.Base58 (+ encode+ , decode+ ) where++import Control.Monad (guard)+import qualified Data.Bits as B+import Data.Bits ((.|.))+import qualified Data.ByteString as BS++fi :: (Integral a, Num b) => a -> b+fi = fromIntegral+{-# INLINE fi #-}++-- | Encode a base256 'ByteString' as base58.+--+-- >>> encode "hello world"+-- "StV1DL6CwTryKyV"+encode :: BS.ByteString -> BS.ByteString+encode bs = ls <> unroll_base58 (roll_base256 bs) where+ ls = leading_ones bs++-- | Decode a base58 'ByteString' to base256.+--+-- Invalid inputs will produce 'Nothing'.+--+-- >>> decode "StV1DL6CwTryKyV"+-- Just "hello world"+-- >>> decode "StV1DL0CwTryKyV" -- s/6/0+-- Nothing+decode :: BS.ByteString -> Maybe BS.ByteString+decode bs = do+ guard (verify_base58 bs)+ let ls = leading_zeros bs+ pure $ ls <> unroll_base256 (roll_base58 bs)++verify_base58 :: BS.ByteString -> Bool+verify_base58 bs = case BS.uncons bs of+ Nothing -> True+ Just (h, t)+ | BS.elem h base58_charset -> verify_base58 t+ | otherwise -> False++base58_charset :: BS.ByteString+base58_charset = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"++-- produce leading ones from leading zeros+leading_ones :: BS.ByteString -> BS.ByteString+leading_ones = go mempty where+ go acc bs = case BS.uncons bs of+ Nothing -> acc+ Just (h, t)+ | h == 0 -> go (BS.cons 0x31 acc) t+ | otherwise -> acc++-- produce leading zeros from leading ones+leading_zeros :: BS.ByteString -> BS.ByteString+leading_zeros = go mempty where+ go acc bs = case BS.uncons bs of+ Nothing -> acc+ Just (h, t)+ | h == 0x31 -> go (BS.cons 0x00 acc) t+ | otherwise -> acc++-- from base256+roll_base256 :: BS.ByteString -> Integer+roll_base256 = BS.foldl' alg 0 where+ alg !a !b = a `B.shiftL` 8 .|. fi b++-- to base58+unroll_base58 :: Integer -> BS.ByteString+unroll_base58 = BS.reverse . BS.unfoldr coalg where+ coalg a+ | a == 0 = Nothing+ | otherwise = Just $+ let (b, c) = quotRem a 58+ in (BS.index base58_charset (fi c), b)++-- from base58+roll_base58 :: BS.ByteString -> Integer+roll_base58 bs = BS.foldl' alg 0 bs where+ alg !b !a = case BS.elemIndex a base58_charset of+ Just w -> b * 58 + fi w+ Nothing ->+ error "ppad-base58 (roll_base58): not a base58-encoded bytestring"++-- to base256+unroll_base256 :: Integer -> BS.ByteString+unroll_base256 = BS.reverse . BS.unfoldr coalg where+ coalg a+ | a == 0 = Nothing+ | otherwise = Just $+ let (b, c) = quotRem a 256+ in (fi c, b)+
+ lib/Data/ByteString/Base58Check.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE ViewPatterns #-}++-- |+-- Module: Data.ByteString.Base58Check+-- Copyright: (c) 2024 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- base58check encoding and decoding of strict bytestrings.+--+-- base58check is a versioned, checksummed base58 encoding. A payload is+-- constructed from a leading version byte and some base256 input, and+-- then a checksum is computed by SHA256d-ing the payload, appending its+-- first 4 bytes, and base58-encoding the result.++module Data.ByteString.Base58Check (+ encode+ , decode+ ) where++import Control.Monad (guard)+import qualified Crypto.Hash.SHA256 as SHA256+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base58 as B58+import Data.Word (Word8)++-- | Encode a version byte and base256 'ByteString' as base58check.+--+-- >>> encode 0x00 "hello world"+-- "13vQB7B6MrGQZaxCqW9KER"+encode :: Word8 -> BS.ByteString -> BS.ByteString+encode ver dat =+ let pay = BS.cons ver dat+ kek = BS.take 4 (SHA256.hash (SHA256.hash pay))+ in B58.encode (pay <> kek)++-- | Validate and decode a base58check-encoded string. Invalid+-- base58check inputs will produce 'Nothing'.+--+-- >>> decode "13vQB7B6MrGQZaxCqW9KER"+-- Just (0,"hello world")+-- >>> decode "13uQB7B6MrGQZaxCqW9KER" -- s/v/u+-- Nothing+decode :: BS.ByteString -> Maybe (Word8, BS.ByteString)+decode mb = do+ bs <- B58.decode mb+ let len = BS.length bs+ (pay, kek) = BS.splitAt (len - 4) bs+ man = BS.take 4 (SHA256.hash (SHA256.hash pay))+ guard (kek == man)+ BS.uncons pay+
+ ppad-base58.cabal view
@@ -0,0 +1,66 @@+cabal-version: 3.0+name: ppad-base58+version: 0.1.0+synopsis: base58 and base58check encoding/decoding.+license: MIT+license-file: LICENSE+author: Jared Tobin+maintainer: jared@ppad.tech+category: Cryptography+build-type: Simple+tested-with: GHC == 9.8.1+extra-doc-files: CHANGELOG+description:+ base58 and base58check encoding/decoding on strict bytestrings.++source-repository head+ type: git+ location: git.ppad.tech/base58.git++library+ default-language: Haskell2010+ hs-source-dirs: lib+ ghc-options:+ -Wall+ exposed-modules:+ Data.ByteString.Base58+ , Data.ByteString.Base58Check+ build-depends:+ base >= 4.9 && < 5+ , bytestring >= 0.9 && < 0.13+ , ppad-sha256 > 0.2 && < 0.3++test-suite base58-tests+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: test+ main-is: Main.hs++ ghc-options:+ -rtsopts -Wall -O2++ build-depends:+ aeson+ , base+ , base16-bytestring+ , bytestring+ , ppad-base58+ , tasty+ , tasty-hunit+ , text++benchmark base58-bench+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: bench+ main-is: Main.hs++ ghc-options:+ -rtsopts -O2 -Wall++ build-depends:+ base+ , bytestring+ , criterion+ , ppad-base58+
+ test/Main.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Main where++import Data.Aeson ((.:))+import qualified Data.Aeson as A+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base16 as B16+import qualified Data.ByteString.Base58 as B58+import qualified Data.ByteString.Base58Check as B58Check+import qualified Data.Text.Encoding as TE+import qualified Data.Text.IO as TIO+import Test.Tasty+import Test.Tasty.HUnit++data Valid_Base58Check = Valid_Base58Check {+ vc_string :: !BS.ByteString+ , vc_payload :: !BS.ByteString+ } deriving Show++instance A.FromJSON Valid_Base58Check where+ parseJSON = A.withObject "Valid_Base58Check" $ \m -> Valid_Base58Check+ <$> fmap TE.encodeUtf8 (m .: "string")+ <*> fmap (B16.decodeLenient . TE.encodeUtf8) (m .: "payload")++data Invalid_Base58Check = Invalid_Base58Check {+ ic_string :: !BS.ByteString+ } deriving Show++instance A.FromJSON Invalid_Base58Check where+ parseJSON = A.withObject "Invalid_Base58Check" $ \m -> Invalid_Base58Check+ <$> fmap TE.encodeUtf8 (m .: "string")++data Base58Check = Base58Check {+ b58c_valid :: ![Valid_Base58Check]+ , b58c_invalid :: ![Invalid_Base58Check]+ } deriving Show++instance A.FromJSON Base58Check where+ parseJSON = A.withObject "Base58Check" $ \m -> Base58Check+ <$> (m .: "valid")+ <*> (m .: "invalid")+++execute_base58check :: Base58Check -> TestTree+execute_base58check Base58Check {..} = testGroup "base58check" [+ testGroup "valid" (fmap execute_valid b58c_valid)+ , testGroup "invalid" (fmap execute_invalid b58c_invalid)+ ]+ where+ execute_valid Valid_Base58Check {..} = testCase "valid" $ do -- label+ let enc = case BS.uncons vc_payload of+ Nothing -> error "faulty"+ Just (h, t) -> B58Check.encode h t+ assertEqual mempty enc vc_string++ execute_invalid Invalid_Base58Check {..} = testCase "invalid" $ do -- label+ let dec = B58Check.decode ic_string+ is_just = \case+ Nothing -> False+ Just _ -> True+ assertBool mempty (not (is_just dec))++data Valid_Base58 = Valid_Base58 {+ vb_decodedHex :: !BS.ByteString+ , vb_encoded :: !BS.ByteString+ } deriving Show++instance A.FromJSON Valid_Base58 where+ parseJSON = A.withObject "Valid_Base58" $ \m -> Valid_Base58+ <$> fmap (B16.decodeLenient . TE.encodeUtf8) (m .: "decodedHex")+ <*> fmap TE.encodeUtf8 (m .: "encoded")++execute_base58 :: Valid_Base58 -> TestTree -- XX label+execute_base58 Valid_Base58 {..} = testCase "base58" $ do+ let enc = B58.encode vb_decodedHex+ assertEqual mempty enc vb_encoded++main :: IO ()+main = do+ scure_base58 <- TIO.readFile "etc/base58.json"+ scure_base58check <- TIO.readFile "etc/base58_check.json"+ let per = do+ b0 <- A.decodeStrictText scure_base58 :: Maybe [Valid_Base58]+ b1 <- A.decodeStrictText scure_base58check :: Maybe Base58Check+ pure (b0, b1)+ case per of+ Nothing -> error "couldn't parse vectors"+ Just (b58, b58c) -> defaultMain $ testGroup "ppad-base58" [+ testGroup "base58" (fmap execute_base58 b58)+ , execute_base58check b58c+ ]+