{-# LANGUAGE StrictData #-}

-- | Bitcoin address generation and rendering. Parsing is comming soon.
--
-- Most of what you'll normally need for safely dealing with Bitcoin addresses
-- is exported from this module.
module Bitcoin.Address
  ( -- * Network settings
    btc
  , btcTestnet

    -- * Addresses
  , Address(..)
  , renderAddress
  , addressScript
    -- ** P2PKH
  , p2pkh
    -- ** P2SH
  , p2sh
  , p2sh_multiSig
  , p2sh_p2wpkh
  , p2sh_p2wsh
  , p2sh_p2wsh_multiSig
    -- ** SegWit P2WPKH
  , p2wpkh
    -- ** SegWit P2WSH
  , p2wsh
  , p2wsh_multiSig
  ) where

import Bitcoin.Keys (Pub)
import Bitcoin.Hash (check32)
import qualified Data.Bitcoin.Script as S
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Base58 as B58

import Bitcoin.Address.Hash
import qualified Bitcoin.Address.Script as XS
import qualified Bitcoin.Address.SegWit as SW
import Bitcoin.Address.Settings

--------------------------------------------------------------------------------

-- | A Bitcoin compatible address.
--
-- These constructors are safe to use. However, you may find the similarly
-- named helper functions in "Bitcoin.Address" more practical.
data Address
  = P2PKH PrefixP2PKH PubHash160
  -- ^ A “pay to public-key hash” address. See 'p2pkh'.
  | P2SH PrefixP2SH ScriptHash160
  -- ^ A “pay to script hash” address. See 'p2sh', 'p2sh_multiSig',
  -- 'p2sh_p2wpkh', 'p2sh_p2wsh_multiSig'.
  | SegWit PrefixSegWit SW.Program
  -- ^ A native SegWit address. See 'p2wpkh', 'p2wsh', 'p2wsh_multiSig'.
  deriving (Eq, Ord)

-- | As 'renderAddress'.
instance Show Address where
  show = B8.unpack . renderAddress

--------------------------------------------------------------------------------
-- P2PKH

-- | 'P2PKH' 'Address' for a 'Pub'lic key.
--
-- This is the address format associated with BIP-0032
-- derivation path @m\/44'\/0'@
p2pkh :: Settings -> Pub -> Address
p2pkh sett = P2PKH (settings_prefixP2PKH sett) . pubHash160

--------------------------------------------------------------------------------
-- P2SH

-- | 'P2SH' 'Address' for a 'S.Script'.
--
-- See 'p2sh_p2wpkh', 'p2sh_p2wpkh' or 'p2sh_p2wsh_multiSig' for some of
-- the typical constructions using 'p2sh'. It's unlikely that you'll need to use
-- 'p2sh' directly unless you are deploying a non-standard 'S.Script'.
p2sh :: Settings -> S.Script -> Address
p2sh sett = P2SH (settings_prefixP2SH sett) . scriptHash160

-- | 'P2SH' “P2WPKH-in-'P2SH'” 'Address' for a 'Pub'lic key.
--
-- This is the address format associated with BIP-0032
-- derivation path @m\/49'\/0'@
p2sh_p2wpkh :: Settings -> Pub -> Address
p2sh_p2wpkh sett = p2sh sett . XS.segWit . SW.p2wpkh . pubHash160

-- | 'P2SH' 'Address' for a standard m-of-n 'XS.multiSig' 'S.Script'.
p2sh_multiSig
  :: Settings
  -> [Pub] -- ^ Public keys. Total number in range [1 … 16]
  -> Int   -- ^ Required number of signatures in range [1 … 16]
  -> Maybe Address -- ^ 'Nothing' if any of the inputs is invalid.
p2sh_multiSig sett pks req = p2sh sett <$> XS.multiSig pks req

-- | 'P2SH' “P2WSH-in-'P2SH'” 'Address' for a 'S.Script'.
--
-- __WARNING__ SegWit does not support uncompressed SEC 'Pub'lic addresses
-- (i.e., 'Bitcoin.Keys.pubUncompressed' and 'pubUncompressedHash160'), so be
-- sure to only mention compressed SEC 'Pub'lic addresses in your 'S.Script's
-- (i.e., 'Bitcoin.Keys.pubCompressed' and 'pubHash160').
p2sh_p2wsh :: Settings -> S.Script -> Address
p2sh_p2wsh sett = p2sh sett . XS.segWit . SW.p2wsh . scriptSHA256

-- | 'P2SH' “P2WSH-in-'P2SH'” 'Address' for a standard m-of-n 'XS.multiSig'
-- 'S.Script'.
p2sh_p2wsh_multiSig
  :: Settings
  -> [Pub] -- ^ Public keys. Total number in range [1 … 16]
  -> Int   -- ^ Required number of signatures in range [1 … 16]
  -> Maybe Address -- ^ 'Nothing' if any of the inputs is invalid.
p2sh_p2wsh_multiSig sett pks req = p2sh_p2wsh sett <$> XS.multiSig pks req

--------------------------------------------------------------------------------
-- SegWit

-- | 'SegWit' “P2WPKH” 'Address' for a 'Pub'lic key.
--
-- This is the address format associated with BIP-0032
-- derivation path @m\/84'\/0'@
p2wpkh :: Settings -> Pub -> Address
p2wpkh sett = SegWit (settings_prefixSegWit sett) . SW.p2wpkh . pubHash160

-- | 'SegWit' “P2WSH” 'Address' for a 'S.Script'.
--
-- Please see 'p2wsh_multiSig' for some of the typical constructions using
-- 'p2wsh'. It's unlikely that you'll need to use 'p2wsh' directly unless you
-- are deploying a non-standard 'S.Script'.
--
-- __WARNING__ SegWit does not support uncompressed SEC 'Pub'lic addresses
-- (i.e., 'Bitcoin.Keys.pubUncompressed' and 'pubUncompressedHash160'), so be
-- sure to only mention compressed SEC 'Pub'lic addresses in your 'S.Script's
-- (i.e., 'Bitcoin.Keys.pubCompressed' and 'pubHash160').
p2wsh :: Settings -> S.Script -> Address
p2wsh sett = SegWit (settings_prefixSegWit sett) . SW.p2wsh . scriptSHA256

-- | 'SegWit' “P2WSH” 'Address' for a standard m-of-n 'XS.multiSig' 'S.Script'.
p2wsh_multiSig
  :: Settings
  -> [Pub] -- ^ Public keys. Total number in range [1 … 16]
  -> Int   -- ^ Required number of signatures in range [1 … 16]
  -> Maybe Address -- ^ 'Nothing' if any of the inputs is invalid.
p2wsh_multiSig sett pks req = p2wsh sett <$> XS.multiSig pks req

--------------------------------------------------------------------------------

-- | Obtain the 'S.Script' associated with a particular 'Address'.
--
-- This will be one of 'XS.p2pkh', 'XS.p2sh' or 'XS.segWit' from
-- the "Bitcoin.Address.Script" module.
addressScript :: Address -> S.Script
addressScript = \case
  P2PKH _ pkh    -> XS.p2pkh pkh
  P2SH _ sh      -> XS.p2sh sh
  SegWit _ swp   -> XS.segWit swp

--------------------------------------------------------------------------------
{-
fromBase58Check :: B.ByteString -> Maybe B.ByteString
fromBase58Check a = do
  b <- B58.decodeBase58 B58.bitcoinAlphabet a
  guard (B.length b >= 4)
  let (x, ch) = B.splitAt (B.length b - 4) b
  guard (check32 x == ch)
  pure x
-}
--------------------------------------------------------------------------------

-- | Render and 'Address' to its human readable form.
renderAddress :: Address -> B.ByteString
renderAddress = \case
  P2PKH pre pkh -> toBase58Check $ B.cons (unPrefixP2PKH pre) (unPubHash160 pkh)
  P2SH pre sh -> toBase58Check $ B.cons (unPrefixP2SH pre) (unScriptHash160 sh)
  SegWit pre swp -> SW.renderProgram pre swp

--------------------------------------------------------------------------------

toBase58Check :: B.ByteString -> B.ByteString
{-# INLINE toBase58Check #-}
toBase58Check a = B58.encodeBase58 B58.bitcoinAlphabet (a <> check32 a)

--------------------------------------------------------------------------------

-- | BTC /mainnet/ network settings.
--
-- * 'P2PKH' addresses, when rendered, start with __1__.
--
-- * 'P2SH' addresses, when rendered, start with __3__.
--
-- * 'SegWit' addresses, when rendered, start with __bc1__.
btc :: Settings
btc = Settings btc_prefixP2PKH btc_prefixP2SH btc_prefixSegWit

btc_prefixP2PKH :: PrefixP2PKH
btc_prefixP2PKH = PrefixP2PKH 0x00

btc_prefixP2SH :: PrefixP2SH
btc_prefixP2SH = PrefixP2SH 0x05

btc_prefixSegWit :: PrefixSegWit
Just btc_prefixSegWit = prefixSegWit "bc"

--------------------------------------------------------------------------------

-- | BTC /testnet/ network settings.
--
-- * 'P2PKH' addresses, when rendered, start with __m__ or __n__.
--
-- * 'P2SH' addresses, when rendered, start with __2__.
--
-- * 'SegWit' addresses, when rendered, start with __tb1__.
btcTestnet :: Settings
btcTestnet = Settings btcTestnet_prefixP2PKH btcTestnet_prefixP2SH
                      btcTestnet_prefixSegWit

btcTestnet_prefixP2PKH :: PrefixP2PKH
btcTestnet_prefixP2PKH = PrefixP2PKH 0x6f

btcTestnet_prefixP2SH :: PrefixP2SH
btcTestnet_prefixP2SH = PrefixP2SH 0xc4

btcTestnet_prefixSegWit :: PrefixSegWit
Just btcTestnet_prefixSegWit = prefixSegWit "tb"