commit cda2601e279d16aa78fdf3b21104ea8e468341f2
Author: Jared Tobin <jared@jtobin.io>
Date: Wed, 18 Dec 2024 08:14:23 -0330
lib: initial commit
Diffstat:
9 files changed, 408 insertions(+), 0 deletions(-)
diff --git a/.ghci b/.ghci
@@ -0,0 +1,2 @@
+:set -XOverloadedStrings
+:set prompt "> "
diff --git a/.gitignore b/.gitignore
@@ -0,0 +1 @@
+dist-newstyle/
diff --git a/CHANGELOG b/CHANGELOG
diff --git a/LICENSE b/LICENSE
@@ -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.
diff --git a/flake.lock b/flake.lock
@@ -0,0 +1,131 @@
+{
+ "nodes": {
+ "flake-utils": {
+ "inputs": {
+ "systems": "systems"
+ },
+ "locked": {
+ "lastModified": 1710146030,
+ "narHash": "sha256-SZ5L6eA7HJ/nmkzGG7/ISclqe6oZdOZTNoesiInkXPQ=",
+ "owner": "numtide",
+ "repo": "flake-utils",
+ "rev": "b1d9ab70662946ef0850d488da1c9019f3a9752a",
+ "type": "github"
+ },
+ "original": {
+ "owner": "numtide",
+ "repo": "flake-utils",
+ "type": "github"
+ }
+ },
+ "flake-utils_2": {
+ "inputs": {
+ "systems": "systems_2"
+ },
+ "locked": {
+ "lastModified": 1710146030,
+ "narHash": "sha256-SZ5L6eA7HJ/nmkzGG7/ISclqe6oZdOZTNoesiInkXPQ=",
+ "owner": "numtide",
+ "repo": "flake-utils",
+ "rev": "b1d9ab70662946ef0850d488da1c9019f3a9752a",
+ "type": "github"
+ },
+ "original": {
+ "owner": "numtide",
+ "repo": "flake-utils",
+ "type": "github"
+ }
+ },
+ "nixpkgs": {
+ "locked": {
+ "lastModified": 1725910328,
+ "narHash": "sha256-n9pCtzGZ0httmTwMuEbi5E78UQ4ZbQMr1pzi5N0LAG8=",
+ "owner": "NixOS",
+ "repo": "nixpkgs",
+ "rev": "5775c2583f1801df7b790bf7f7d710a19bac66f4",
+ "type": "github"
+ },
+ "original": {
+ "owner": "NixOS",
+ "ref": "nixpkgs-unstable",
+ "repo": "nixpkgs",
+ "type": "github"
+ }
+ },
+ "nixpkgs_2": {
+ "locked": {
+ "lastModified": 1725910328,
+ "narHash": "sha256-n9pCtzGZ0httmTwMuEbi5E78UQ4ZbQMr1pzi5N0LAG8=",
+ "owner": "NixOS",
+ "repo": "nixpkgs",
+ "rev": "5775c2583f1801df7b790bf7f7d710a19bac66f4",
+ "type": "github"
+ },
+ "original": {
+ "owner": "NixOS",
+ "ref": "nixpkgs-unstable",
+ "repo": "nixpkgs",
+ "type": "github"
+ }
+ },
+ "ppad-sha256": {
+ "inputs": {
+ "flake-utils": "flake-utils_2",
+ "nixpkgs": "nixpkgs_2"
+ },
+ "locked": {
+ "lastModified": 1728824578,
+ "narHash": "sha256-sMZLvmbl3fBUHpBePzGuLdUyUALba/P5DCgKVgqEH1k=",
+ "ref": "master",
+ "rev": "3cc6c146ae36f67d73c6c207486a199dbc77658e",
+ "revCount": 82,
+ "type": "git",
+ "url": "git://git.ppad.tech/sha256.git"
+ },
+ "original": {
+ "ref": "master",
+ "type": "git",
+ "url": "git://git.ppad.tech/sha256.git"
+ }
+ },
+ "root": {
+ "inputs": {
+ "flake-utils": "flake-utils",
+ "nixpkgs": "nixpkgs",
+ "ppad-sha256": "ppad-sha256"
+ }
+ },
+ "systems": {
+ "locked": {
+ "lastModified": 1681028828,
+ "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
+ "owner": "nix-systems",
+ "repo": "default",
+ "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
+ "type": "github"
+ },
+ "original": {
+ "owner": "nix-systems",
+ "repo": "default",
+ "type": "github"
+ }
+ },
+ "systems_2": {
+ "locked": {
+ "lastModified": 1681028828,
+ "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
+ "owner": "nix-systems",
+ "repo": "default",
+ "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
+ "type": "github"
+ },
+ "original": {
+ "owner": "nix-systems",
+ "repo": "default",
+ "type": "github"
+ }
+ }
+ },
+ "root": "root",
+ "version": 7
+}
diff --git a/flake.nix b/flake.nix
@@ -0,0 +1,63 @@
+{
+ description = "Pure Haskell base58 and base58check encodings.";
+
+ inputs = {
+ ppad-sha256 = {
+ type = "git";
+ url = "git://git.ppad.tech/sha256.git";
+ ref = "master";
+ };
+ nixpkgs.url = "github:NixOS/nixpkgs/nixpkgs-unstable";
+ flake-utils.url = "github:numtide/flake-utils";
+ };
+
+ outputs = { self, nixpkgs, flake-utils, ppad-sha256 }:
+ flake-utils.lib.eachDefaultSystem (system:
+ let
+ lib = "ppad-base58";
+
+ pkgs = import nixpkgs { inherit system; };
+ hlib = pkgs.haskell.lib;
+
+ sha256 = ppad-sha256.packages.${system}.default;
+
+ hpkgs = pkgs.haskell.packages.ghc981.extend (new: old: {
+ ppad-sha256 = sha256;
+ ${lib} = new.callCabal2nixWithOptions lib ./. "--enable-profiling" {
+ ppad-sha256 = new.ppad-sha256;
+ };
+ });
+
+ cc = pkgs.stdenv.cc;
+ ghc = hpkgs.ghc;
+ cabal = hpkgs.cabal-install;
+ in
+ {
+ packages.default = hpkgs.${lib};
+
+ devShells.default = hpkgs.shellFor {
+ packages = p: [
+ (hlib.doBenchmark p.${lib})
+ ];
+
+ buildInputs = [
+ cabal
+ cc
+ ];
+
+ inputsFrom = builtins.attrValues self.packages.${system};
+
+ doBenchmark = true;
+
+ shellHook = ''
+ PS1="[${lib}] \w$ "
+ echo "entering ${system} shell, using"
+ echo "cc: $(${cc}/bin/cc --version)"
+ echo "ghc: $(${ghc}/bin/ghc --version)"
+ echo "cabal: $(${cabal}/bin/cabal --version)"
+ '';
+ };
+ }
+ );
+}
+
diff --git a/lib/Data/ByteString/Base58.hs b/lib/Data/ByteString/Base58.hs
@@ -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)
+
diff --git a/lib/Data/ByteString/Base58Check.hs b/lib/Data/ByteString/Base58Check.hs
@@ -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
+
diff --git a/ppad-base58.cabal b/ppad-base58.cabal
@@ -0,0 +1,32 @@
+cabal-version: 3.0
+name: ppad-base58
+version: 0.1.2
+synopsis: base58 and base58check encodings.
+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:
+ The base58 and base58check encodings.
+
+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
+ , primitive >= 0.8 && < 0.10
