{-# 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 :: Word8 -> ByteString -> ByteString
encode Word8
ver ByteString
dat =
  let pay :: ByteString
pay = Word8 -> ByteString -> ByteString
BS.cons Word8
ver ByteString
dat
      kek :: ByteString
kek = Int -> ByteString -> ByteString
BS.take Int
4 (ByteString -> ByteString
SHA256.hash (ByteString -> ByteString
SHA256.hash ByteString
pay))
  in  ByteString -> ByteString
B58.encode (ByteString
pay ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
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 :: ByteString -> Maybe (Word8, ByteString)
decode ByteString
mb = do
  ByteString
bs <- ByteString -> Maybe ByteString
B58.decode ByteString
mb
  let len :: Int
len = ByteString -> Int
BS.length ByteString
bs
      (ByteString
pay, ByteString
kek) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) ByteString
bs
      man :: ByteString
man = Int -> ByteString -> ByteString
BS.take Int
4 (ByteString -> ByteString
SHA256.hash (ByteString -> ByteString
SHA256.hash ByteString
pay))
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString
kek ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
man)
  ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
pay