{-# 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 checksum verification.

module Data.ByteString.Bech32m (
    -- * Encoding
    encode

    -- * 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 Data.ByteString.Base32 (Encoding(..))
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Builder.Extra as BE
import qualified Data.Char as C (toLower)

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

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

-- | Encode a base255 human-readable part and input as bech32m.
--
--   >>> let Just bech32m = encode "bc" "my string"
--   >>> bech32m
--   "bc1d4ujqum5wf5kuecwqlxtg"
encode
  :: BS.ByteString        -- ^ base255-encoded human-readable part
  -> BS.ByteString        -- ^ base255-encoded data part
  -> Maybe BS.ByteString  -- ^ bech32-encoded bytestring
encode :: ByteString -> ByteString -> Maybe ByteString
encode ByteString
hrp (ByteString -> ByteString
B32.encode -> ByteString
dat) = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Bool
B32.valid_hrp ByteString
hrp)
  let check :: ByteString
check = ByteString -> ByteString -> ByteString
create_checksum ByteString
hrp (ByteString -> ByteString
B32.as_word5 ByteString
dat)
      res :: ByteString
res = Builder -> ByteString
toStrict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
           ByteString -> Builder
BSB.byteString ((Char -> Char) -> ByteString -> ByteString
B8.map Char -> Char
C.toLower 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
B32.as_base32 ByteString
check)
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Int
BS.length ByteString
res Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
91)
  ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
res

-- | 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
B32.verify Encoding
Bech32m