base58

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

Base58.hs (3315B)


      1 {-# LANGUAGE BangPatterns #-}
      2 {-# LANGUAGE OverloadedStrings #-}
      3 {-# LANGUAGE ViewPatterns #-}
      4 
      5 -- |
      6 -- Module: Data.ByteString.Base58
      7 -- Copyright: (c) 2024 Jared Tobin
      8 -- License: MIT
      9 -- Maintainer: Jared Tobin <jared@ppad.tech>
     10 --
     11 -- base58 encoding and decoding of strict bytestrings.
     12 
     13 module Data.ByteString.Base58 (
     14     encode
     15   , decode
     16   ) where
     17 
     18 import Control.Monad (guard)
     19 import qualified Data.Bits as B
     20 import Data.Bits ((.|.))
     21 import qualified Data.ByteString as BS
     22 import qualified Data.ByteString.Unsafe as BU
     23 import Data.Word (Word8)
     24 
     25 fi :: (Integral a, Num b) => a -> b
     26 fi = fromIntegral
     27 {-# INLINE fi #-}
     28 
     29 -- word8 base58 character to word6 (ish)
     30 word6 :: Word8 -> Maybe Word8
     31 word6 c
     32   | c >= 49  && c <= 57  = pure $! c - 49 -- 1–9
     33   | c >= 65  && c <= 72  = pure $! c - 56 -- A–H
     34   | c >= 74  && c <= 78  = pure $! c - 57 -- J–N
     35   | c >= 80  && c <= 90  = pure $! c - 58 -- P–Z
     36   | c >= 97  && c <= 107 = pure $! c - 64 -- a–k
     37   | c >= 109 && c <= 122 = pure $! c - 65 -- m–z
     38   | otherwise = Nothing
     39 {-# INLINE word6 #-}
     40 
     41 -- | Encode a base256 'ByteString' as base58.
     42 --
     43 --   >>> encode "hello world"
     44 --   "StV1DL6CwTryKyV"
     45 encode :: BS.ByteString -> BS.ByteString
     46 encode bs = ls <> unroll_base58 (roll_base256 bs) where
     47   ls = leading_ones bs
     48 
     49 -- | Decode a base58 'ByteString' to base256.
     50 --
     51 --   Invalid inputs will produce 'Nothing'.
     52 --
     53 --   >>> decode "StV1DL6CwTryKyV"
     54 --   Just "hello world"
     55 --   >>> decode "StV1DL0CwTryKyV" -- s/6/0
     56 --   Nothing
     57 decode :: BS.ByteString -> Maybe BS.ByteString
     58 decode bs = do
     59   guard (verify_base58 bs)
     60   let ls = leading_zeros bs
     61   pure $ ls <> unroll_base256 (roll_base58 bs)
     62 
     63 verify_base58 :: BS.ByteString -> Bool
     64 verify_base58 bs = case BS.uncons bs of
     65   Nothing -> True
     66   Just (h, t)
     67     | BS.elem h base58_charset -> verify_base58 t
     68     | otherwise -> False
     69 
     70 base58_charset :: BS.ByteString
     71 base58_charset = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
     72 
     73 -- produce leading ones from leading zeros
     74 leading_ones :: BS.ByteString -> BS.ByteString
     75 leading_ones = go mempty where
     76   go acc bs = case BS.uncons bs of
     77     Nothing -> acc
     78     Just (h, t)
     79       | h == 0 -> go (BS.cons 0x31 acc) t
     80       | otherwise -> acc
     81 
     82 -- produce leading zeros from leading ones
     83 leading_zeros :: BS.ByteString -> BS.ByteString
     84 leading_zeros = go mempty where
     85   go acc bs = case BS.uncons bs of
     86     Nothing -> acc
     87     Just (h, t)
     88       | h == 0x31 -> go (BS.cons 0x00 acc) t
     89       | otherwise -> acc
     90 
     91 -- to base256
     92 unroll_base256 :: Integer -> BS.ByteString
     93 unroll_base256 = BS.reverse . BS.unfoldr coalg where
     94   coalg a
     95     | a == 0 = Nothing
     96     | otherwise = Just $
     97         let (b, c) = quotRem a 256
     98         in  (fi c, b)
     99 
    100 -- from base256
    101 roll_base256 :: BS.ByteString -> Integer
    102 roll_base256 = BS.foldl' alg 0 where
    103   alg !a !b = a `B.shiftL` 8 .|. fi b
    104 
    105 -- to base58
    106 unroll_base58 :: Integer -> BS.ByteString
    107 unroll_base58 = BS.reverse . BS.unfoldr coalg where
    108   coalg a
    109     | a == 0 = Nothing
    110     | otherwise = Just $
    111         let (b, c) = quotRem a 58
    112         in  (BU.unsafeIndex base58_charset (fi c), b)
    113 
    114 -- from base58
    115 roll_base58 :: BS.ByteString -> Integer
    116 roll_base58 bs = BS.foldl' alg 0 bs where
    117   alg !b !a = case word6 a of
    118     Just w -> b * 58 + fi w
    119     Nothing ->
    120       error "ppad-base58 (roll_base58): internal error"
    121