commit a4a4fedcb71666da9d0d141efe34a4f2d56bee67
Author: Jared Tobin <jared@jtobin.io>
Date: Fri, 17 Jan 2025 14:57:28 +0400
lib: initial commit
Diffstat:
10 files changed, 360 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) 2025 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/bench/Main.hs b/bench/Main.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE PackageImports #-}
+
+module Main where
+
+import Criterion.Main
+import qualified "ppad-base16" Data.ByteString.Base16 as B16
+import qualified "base16-bytestring" Data.ByteString.Base16 as R0
+import qualified "base16" Data.ByteString.Base16 as R1
+
+main :: IO ()
+main = defaultMain [ suite ]
+
+base16_encode :: Benchmark
+base16_encode = bgroup "base16 encode" [
+ bench "120b" $ nf B16.encode "jtobin was here"
+ , bench "240b" $ nf B16.encode "jtobin was herebenching stuff."
+ ]
+
+base16_encode' :: Benchmark
+base16_encode' = bgroup "base16 encode" [
+ bench "120b" $ nf B16.encode' "jtobin was here"
+ , bench "240b" $ nf B16.encode' "jtobin was herebenching stuff."
+ ]
+
+base16_decode :: Benchmark
+base16_decode = bgroup "base16 decode" [
+ bench "120b" $ nf B16.decode "6a746f62696e207761732068657265"
+ , bench "240b" $ nf B16.decode
+ "6a746f62696e20776173206865726562656e6368696e672073747566662e"
+ ]
+
+r0_encode :: Benchmark
+r0_encode = bgroup "base16 encode" [
+ bench "120b" $ nf R0.encode "jtobin was here"
+ , bench "240b" $ nf R0.encode "jtobin was herebenching stuff."
+ ]
+
+r0_decode :: Benchmark
+r0_decode = bgroup "base16 decode" [
+ bench "120b" $ nf R0.decode "6a746f62696e207761732068657265"
+ , bench "240b" $ nf R0.decode
+ "6a746f62696e20776173206865726562656e6368696e672073747566662e"
+ ]
+
+r1_encode :: Benchmark
+r1_encode = bgroup "base16 encode" [
+ bench "120b" $ nf R1.encodeBase16' "jtobin was here"
+ , bench "240b" $ nf R1.encodeBase16' "jtobin was herebenching stuff."
+ ]
+
+r1_decode :: Benchmark
+r1_decode = bgroup "base16 decode" [
+ bench "120b" $ nf R1.decodeBase16Untyped "6a746f62696e207761732068657265"
+ , bench "240b" $ nf R1.decodeBase16Untyped
+ "6a746f62696e20776173206865726562656e6368696e672073747566662e"
+ ]
+
+suite :: Benchmark
+suite = bgroup "benchmarks" [
+ bgroup "ppad-base16" [
+ base16_encode
+ , base16_encode'
+ , base16_decode
+ -- ]
+ --, bgroup "base16-bytestring" [
+ -- r0_encode
+ -- , r0_decode
+ -- ]
+ --, bgroup "base16" [
+ -- r1_encode
+ -- , r1_decode
+ ]
+ ]
+
diff --git a/flake.lock b/flake.lock
@@ -0,0 +1,61 @@
+{
+ "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"
+ }
+ },
+ "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"
+ }
+ },
+ "root": {
+ "inputs": {
+ "flake-utils": "flake-utils",
+ "nixpkgs": "nixpkgs"
+ }
+ },
+ "systems": {
+ "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,53 @@
+{
+ description = "Pure Haskell base16 encoding and decoding on bytestrings.";
+
+ inputs = {
+ nixpkgs.url = "github:NixOS/nixpkgs/nixpkgs-unstable";
+ flake-utils.url = "github:numtide/flake-utils";
+ };
+
+ outputs = { self, nixpkgs, flake-utils }:
+ flake-utils.lib.eachDefaultSystem (system:
+ let
+ lib = "ppad-base16";
+
+ pkgs = import nixpkgs { inherit system; };
+ hlib = pkgs.haskell.lib;
+
+ hpkgs = pkgs.haskell.packages.ghc981.extend (new: old: {
+ ${lib} = old.callCabal2nixWithOptions lib ./. "--enable-profiling" {};
+ });
+
+ 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/Base16.hs b/lib/Data/ByteString/Base16.hs
@@ -0,0 +1,80 @@
+{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BinaryLiterals #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Data.ByteString.Base16 (
+ encode
+ , decode
+ ) where
+
+import qualified Data.Bits as B
+import Data.Bits ((.&.), (.|.))
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Builder as BSB
+import qualified Data.ByteString.Builder.Extra as BE
+import qualified Data.ByteString.Internal as BI
+import qualified Data.ByteString.Unsafe as BU
+import Data.Word (Word8)
+
+to_strict :: BSB.Builder -> BS.ByteString
+to_strict = BS.toStrict . BSB.toLazyByteString
+{-# INLINE to_strict #-}
+
+to_strict_small :: BSB.Builder -> BS.ByteString
+to_strict_small = BS.toStrict
+ . BE.toLazyByteStringWith (BE.safeStrategy 128 BE.smallChunkSize) mempty
+{-# INLINE to_strict_small #-}
+
+fi :: (Num a, Integral b) => b -> a
+fi = fromIntegral
+{-# INLINE fi #-}
+
+hex_charset :: BS.ByteString
+hex_charset = "0123456789abcdef"
+
+data W8Pair = Pair
+ {-# UNPACK #-} !Word8
+ {-# UNPACK #-} !Word8
+
+hilo :: Word8 -> W8Pair
+hilo b =
+ let !hi = BU.unsafeIndex hex_charset (fromIntegral b `B.shiftR` 4)
+ !lo = BU.unsafeIndex hex_charset (fromIntegral b .&. 0b00001111)
+ in Pair hi lo
+
+encode :: BS.ByteString -> BS.ByteString
+encode bs@(BI.PS _ _ l)
+ | l < 128 = to_strict_small (go 0)
+ | otherwise = to_strict (go 0)
+ where
+ go j
+ | j == l = mempty
+ | otherwise =
+ let !(Pair hi lo) = hilo (BU.unsafeIndex bs j)
+ w16 = fromIntegral hi `B.shiftL` 8
+ .|. fromIntegral lo
+ in BSB.word16BE w16 <> go (succ j)
+
+word4 :: Word8 -> Maybe Word8
+word4 w8 = fmap fi (BS.elemIndex w8 hex_charset)
+
+decode :: BS.ByteString -> Maybe BS.ByteString
+decode b16@(BI.PS _ _ b16_l)
+ | B.testBit b16_l 0 = Nothing
+ | b16_l `quot` 2 < 128 = fmap to_strict_small (go mempty b16)
+ | otherwise = fmap to_strict (go mempty b16)
+ where
+ go acc !bs@(BI.PS _ _ l)
+ | l == 0 = pure $! acc
+ | otherwise = case BS.splitAt 2 bs of
+ (chunk, etc) -> do
+ !(Pair hi lo) <- Pair
+ <$> word4 (BU.unsafeIndex chunk 0)
+ <*> word4 (BU.unsafeIndex chunk 1)
+
+ let !b = hi `B.shiftL` 4
+ .|. lo
+
+ go (acc <> BSB.word8 b) etc
+
diff --git a/ppad-base16.cabal b/ppad-base16.cabal
@@ -0,0 +1,64 @@
+cabal-version: 3.0
+name: ppad-base16
+version: 0.1.0
+synopsis: Simple base16 encoding and decoding on bytestrings.
+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:
+ Simple base16 (hexadecimal) encoding and decoding on bytestrings.
+
+source-repository head
+ type: git
+ location: git.ppad.tech/base16.git
+
+library
+ default-language: Haskell2010
+ hs-source-dirs: lib
+ ghc-options:
+ -Wall
+ exposed-modules:
+ Data.ByteString.Base16
+ build-depends:
+ base >= 4.9 && < 5
+ , bytestring >= 0.9 && < 0.13
+
+test-suite base16-tests
+ type: exitcode-stdio-1.0
+ default-language: Haskell2010
+ hs-source-dirs: test
+ main-is: Main.hs
+
+ ghc-options:
+ -rtsopts -Wall -O2
+
+ build-depends:
+ base
+ , base16-bytestring
+ , bytestring
+ , ppad-base16
+ , tasty
+ , tasty-quickcheck
+
+benchmark base16-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
+ , base16
+ , base16-bytestring
+ , bytestring
+ , criterion
+ , ppad-base16
+
diff --git a/test/Main.hs b/test/Main.hs
@@ -0,0 +1,5 @@
+
+module Main where
+
+main :: IO ()
+main = pure ()
