{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- Module: Data.ByteString.Bech32m
-- Copyright: (c) 2024 Jared Tobin
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
-- The
-- [BIP350](https://github.com/bitcoin/bips/blob/master/bip-0350.mediawiki)
-- bech32m checksummed base32 encoding, with decoding and checksum
-- verification.

module Data.ByteString.Bech32m (
    -- * Encoding and Decoding
    encode
  , decode

    -- * Checksum
  , verify
  ) where

import Control.Monad (guard)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Base32 as B32
import qualified Data.ByteString.Bech32.Internal as BI
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Builder.Extra as BE
import qualified Data.ByteString.Internal as BSI
import qualified Data.Char as C (toLower)

-- realization for small builders
toStrict :: BSB.Builder -> BS.ByteString
toStrict :: Builder -> ByteString
toStrict = LazyByteString -> ByteString
BS.toStrict
  (LazyByteString -> ByteString)
-> (Builder -> LazyByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllocationStrategy -> LazyByteString -> Builder -> LazyByteString
BE.toLazyByteStringWith (Int -> Int -> AllocationStrategy
BE.safeStrategy Int
128 Int
BE.smallChunkSize) LazyByteString
forall a. Monoid a => a
mempty
{-# INLINE toStrict #-}

create_checksum :: BS.ByteString -> BS.ByteString -> BS.ByteString
create_checksum :: ByteString -> ByteString -> ByteString
create_checksum = Encoding -> ByteString -> ByteString -> ByteString
BI.create_checksum Encoding
BI.Bech32m

-- | Encode a base256 human-readable part and input as bech32m.
--
--   >>> let Just bech32m = encode "bc" "my string"
--   >>> bech32m
--   "bc1d4ujqum5wf5kuecwqlxtg"
encode
  :: BS.ByteString        -- ^ base256-encoded human-readable part
  -> BS.ByteString        -- ^ base256-encoded data part
  -> Maybe BS.ByteString  -- ^ bech32m-encoded bytestring
encode :: ByteString -> ByteString -> Maybe ByteString
encode ((Char -> Char) -> ByteString -> ByteString
B8.map Char -> Char
C.toLower -> ByteString
hrp) (ByteString -> ByteString
B32.encode -> ByteString
dat) = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Bool
BI.valid_hrp ByteString
hrp)
  ws <- ByteString -> Maybe ByteString
BI.as_word5 ByteString
dat
  let check = ByteString -> ByteString -> ByteString
create_checksum ByteString
hrp ByteString
ws
      res = Builder -> ByteString
toStrict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
           ByteString -> Builder
BSB.byteString ByteString
hrp
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
49 -- 1
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BSB.byteString ByteString
dat
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BSB.byteString (ByteString -> ByteString
BI.as_base32 ByteString
check)
  guard (BS.length res < 91)
  pure res

-- | Decode a bech32m-encoded 'ByteString' into its human-readable and data
--   parts.
--
--   >>> decode "hi1df6x7cnfdcs8wctnyp5x2un9m9ac4f"
--   Just ("hi","jtobin was here")
--   >>> decode "hey1df6x7cnfdcs8wctnyp5x2un9m9ac4f" -- s/hi/hey
--   Nothing
decode
  :: BS.ByteString                        -- ^ bech23-encoded bytestring
  -> Maybe (BS.ByteString, BS.ByteString) -- ^ (hrp, data less checksum)
decode :: ByteString -> Maybe (ByteString, ByteString)
decode bs :: ByteString
bs@(BSI.PS ForeignPtr Word8
_ Int
_ Int
l) = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
90)
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Bool
verify ByteString
bs)
  sep <- Word8 -> ByteString -> Maybe Int
BS.elemIndexEnd Word8
0x31 ByteString
bs
  case BS.splitAt sep bs of
    (ByteString
hrp, ByteString
raw) -> do
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Bool
BI.valid_hrp ByteString
hrp)
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Int
BS.length ByteString
raw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
6)
      (_, BS.dropEnd 6 -> bech32dat) <- ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
raw
      dat <- B32.decode bech32dat
      pure (hrp, dat)

-- | Verify that a bech32m string has a valid checksum.
--
--   >>> verify "bc1d4ujqum5wf5kuecwqlxtg"
--   True
--   >>> verify "bc1d4ujquw5wf5kuecwqlxtg" -- s/m/w
--   False
verify
  :: BS.ByteString -- ^ bech32m-encoded bytestring
  -> Bool
verify :: ByteString -> Bool
verify = Encoding -> ByteString -> Bool
BI.verify Encoding
BI.Bech32m