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

      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 
     24 fi :: (Integral a, Num b) => a -> b
     25 fi = fromIntegral
     26 {-# INLINE fi #-}
     27 
     28 -- | Encode a base256 'ByteString' as base58.
     29 --
     30 --   >>> encode "hello world"
     31 --   "StV1DL6CwTryKyV"
     32 encode :: BS.ByteString -> BS.ByteString
     33 encode bs = ls <> unroll_base58 (roll_base256 bs) where
     34   ls = leading_ones bs
     35 
     36 -- | Decode a base58 'ByteString' to base256.
     37 --
     38 --   Invalid inputs will produce 'Nothing'.
     39 --
     40 --   >>> decode "StV1DL6CwTryKyV"
     41 --   Just "hello world"
     42 --   >>> decode "StV1DL0CwTryKyV" -- s/6/0
     43 --   Nothing
     44 decode :: BS.ByteString -> Maybe BS.ByteString
     45 decode bs = do
     46   guard (verify_base58 bs)
     47   let ls = leading_zeros bs
     48   pure $ ls <> unroll_base256 (roll_base58 bs)
     49 
     50 verify_base58 :: BS.ByteString -> Bool
     51 verify_base58 bs = case BS.uncons bs of
     52   Nothing -> True
     53   Just (h, t)
     54     | BS.elem h base58_charset -> verify_base58 t
     55     | otherwise -> False
     56 
     57 base58_charset :: BS.ByteString
     58 base58_charset = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"
     59 
     60 -- produce leading ones from leading zeros
     61 leading_ones :: BS.ByteString -> BS.ByteString
     62 leading_ones = go mempty where
     63   go acc bs = case BS.uncons bs of
     64     Nothing -> acc
     65     Just (h, t)
     66       | h == 0 -> go (BS.cons 0x31 acc) t
     67       | otherwise -> acc
     68 
     69 -- produce leading zeros from leading ones
     70 leading_zeros :: BS.ByteString -> BS.ByteString
     71 leading_zeros = go mempty where
     72   go acc bs = case BS.uncons bs of
     73     Nothing -> acc
     74     Just (h, t)
     75       | h == 0x31 -> go (BS.cons 0x00 acc) t
     76       | otherwise -> acc
     77 
     78 -- to base256
     79 unroll_base256 :: Integer -> BS.ByteString
     80 unroll_base256 = BS.reverse . BS.unfoldr coalg where
     81   coalg a
     82     | a == 0 = Nothing
     83     | otherwise = Just $
     84         let (b, c) = quotRem a 256
     85         in  (fi c, b)
     86 
     87 -- from base256
     88 roll_base256 :: BS.ByteString -> Integer
     89 roll_base256 = BS.foldl' alg 0 where
     90   alg !a !b = a `B.shiftL` 8 .|. fi b
     91 
     92 -- to base58
     93 unroll_base58 :: Integer -> BS.ByteString
     94 unroll_base58 = BS.reverse . BS.unfoldr coalg where
     95   coalg a
     96     | a == 0 = Nothing
     97     | otherwise = Just $
     98         let (b, c) = quotRem a 58
     99         in  (BU.unsafeIndex base58_charset (fi c), b)
    100 
    101 -- from base58
    102 roll_base58 :: BS.ByteString -> Integer
    103 roll_base58 bs = BS.foldl' alg 0 bs where
    104   alg !b !a = case BS.elemIndex a base58_charset of
    105     Just w -> b * 58 + fi w
    106     Nothing ->
    107       error "ppad-base58 (roll_base58): not a base58-encoded bytestring"
    108