{-# 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 (Address -> Address -> Bool
(Address -> Address -> Bool)
-> (Address -> Address -> Bool) -> Eq Address
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Address -> Address -> Bool
$c/= :: Address -> Address -> Bool
== :: Address -> Address -> Bool
$c== :: Address -> Address -> Bool
Eq, Eq Address
Eq Address =>
(Address -> Address -> Ordering)
-> (Address -> Address -> Bool)
-> (Address -> Address -> Bool)
-> (Address -> Address -> Bool)
-> (Address -> Address -> Bool)
-> (Address -> Address -> Address)
-> (Address -> Address -> Address)
-> Ord Address
Address -> Address -> Bool
Address -> Address -> Ordering
Address -> Address -> Address
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Address -> Address -> Address
$cmin :: Address -> Address -> Address
max :: Address -> Address -> Address
$cmax :: Address -> Address -> Address
>= :: Address -> Address -> Bool
$c>= :: Address -> Address -> Bool
> :: Address -> Address -> Bool
$c> :: Address -> Address -> Bool
<= :: Address -> Address -> Bool
$c<= :: Address -> Address -> Bool
< :: Address -> Address -> Bool
$c< :: Address -> Address -> Bool
compare :: Address -> Address -> Ordering
$ccompare :: Address -> Address -> Ordering
$cp1Ord :: Eq Address
Ord)

-- | As 'renderAddress'.
instance Show Address where
  show :: Address -> String
show = ByteString -> String
B8.unpack (ByteString -> String)
-> (Address -> ByteString) -> Address -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> ByteString
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 :: Settings -> Pub -> Address
p2pkh sett :: Settings
sett = PrefixP2PKH -> PubHash160 -> Address
P2PKH (Settings -> PrefixP2PKH
settings_prefixP2PKH Settings
sett) (PubHash160 -> Address) -> (Pub -> PubHash160) -> Pub -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pub -> PubHash160
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 :: Settings -> Script -> Address
p2sh sett :: Settings
sett = PrefixP2SH -> ScriptHash160 -> Address
P2SH (Settings -> PrefixP2SH
settings_prefixP2SH Settings
sett) (ScriptHash160 -> Address)
-> (Script -> ScriptHash160) -> Script -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script -> ScriptHash160
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 :: Settings -> Pub -> Address
p2sh_p2wpkh sett :: Settings
sett = Settings -> Script -> Address
p2sh Settings
sett (Script -> Address) -> (Pub -> Script) -> Pub -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> Script
XS.segWit (Program -> Script) -> (Pub -> Program) -> Pub -> Script
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubHash160 -> Program
SW.p2wpkh (PubHash160 -> Program) -> (Pub -> PubHash160) -> Pub -> Program
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pub -> PubHash160
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 :: Settings -> [Pub] -> Int -> Maybe Address
p2sh_multiSig sett :: Settings
sett pks :: [Pub]
pks req :: Int
req = Settings -> Script -> Address
p2sh Settings
sett (Script -> Address) -> Maybe Script -> Maybe Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pub] -> Int -> Maybe Script
XS.multiSig [Pub]
pks Int
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 :: Settings -> Script -> Address
p2sh_p2wsh sett :: Settings
sett = Settings -> Script -> Address
p2sh Settings
sett (Script -> Address) -> (Script -> Script) -> Script -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> Script
XS.segWit (Program -> Script) -> (Script -> Program) -> Script -> Script
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptSHA256 -> Program
SW.p2wsh (ScriptSHA256 -> Program)
-> (Script -> ScriptSHA256) -> Script -> Program
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script -> ScriptSHA256
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 :: Settings -> [Pub] -> Int -> Maybe Address
p2sh_p2wsh_multiSig sett :: Settings
sett pks :: [Pub]
pks req :: Int
req = Settings -> Script -> Address
p2sh_p2wsh Settings
sett (Script -> Address) -> Maybe Script -> Maybe Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pub] -> Int -> Maybe Script
XS.multiSig [Pub]
pks Int
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 :: Settings -> Pub -> Address
p2wpkh sett :: Settings
sett = PrefixSegWit -> Program -> Address
SegWit (Settings -> PrefixSegWit
settings_prefixSegWit Settings
sett) (Program -> Address) -> (Pub -> Program) -> Pub -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubHash160 -> Program
SW.p2wpkh (PubHash160 -> Program) -> (Pub -> PubHash160) -> Pub -> Program
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pub -> PubHash160
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 :: Settings -> Script -> Address
p2wsh sett :: Settings
sett = PrefixSegWit -> Program -> Address
SegWit (Settings -> PrefixSegWit
settings_prefixSegWit Settings
sett) (Program -> Address) -> (Script -> Program) -> Script -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptSHA256 -> Program
SW.p2wsh (ScriptSHA256 -> Program)
-> (Script -> ScriptSHA256) -> Script -> Program
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script -> ScriptSHA256
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 :: Settings -> [Pub] -> Int -> Maybe Address
p2wsh_multiSig sett :: Settings
sett pks :: [Pub]
pks req :: Int
req = Settings -> Script -> Address
p2wsh Settings
sett (Script -> Address) -> Maybe Script -> Maybe Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Pub] -> Int -> Maybe Script
XS.multiSig [Pub]
pks Int
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 :: Address -> Script
addressScript = \case
  P2PKH _ pkh :: PubHash160
pkh    -> PubHash160 -> Script
XS.p2pkh PubHash160
pkh
  P2SH _ sh :: ScriptHash160
sh      -> ScriptHash160 -> Script
XS.p2sh ScriptHash160
sh
  SegWit _ swp :: Program
swp   -> Program -> Script
XS.segWit Program
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 :: Address -> ByteString
renderAddress = \case
  P2PKH pre :: PrefixP2PKH
pre pkh :: PubHash160
pkh -> ByteString -> ByteString
toBase58Check (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> ByteString
B.cons (PrefixP2PKH -> Word8
unPrefixP2PKH PrefixP2PKH
pre) (PubHash160 -> ByteString
unPubHash160 PubHash160
pkh)
  P2SH pre :: PrefixP2SH
pre sh :: ScriptHash160
sh -> ByteString -> ByteString
toBase58Check (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> ByteString
B.cons (PrefixP2SH -> Word8
unPrefixP2SH PrefixP2SH
pre) (ScriptHash160 -> ByteString
unScriptHash160 ScriptHash160
sh)
  SegWit pre :: PrefixSegWit
pre swp :: Program
swp -> PrefixSegWit -> Program -> ByteString
SW.renderProgram PrefixSegWit
pre Program
swp

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

toBase58Check :: B.ByteString -> B.ByteString
{-# INLINE toBase58Check #-}
toBase58Check :: ByteString -> ByteString
toBase58Check a :: ByteString
a = Alphabet -> ByteString -> ByteString
B58.encodeBase58 Alphabet
B58.bitcoinAlphabet (ByteString
a ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
check32 ByteString
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 -> PrefixP2SH -> PrefixSegWit -> Settings
Settings PrefixP2PKH
btc_prefixP2PKH PrefixP2SH
btc_prefixP2SH PrefixSegWit
btc_prefixSegWit

btc_prefixP2PKH :: PrefixP2PKH
btc_prefixP2PKH :: PrefixP2PKH
btc_prefixP2PKH = Word8 -> PrefixP2PKH
PrefixP2PKH 0x00

btc_prefixP2SH :: PrefixP2SH
btc_prefixP2SH :: PrefixP2SH
btc_prefixP2SH = Word8 -> PrefixP2SH
PrefixP2SH 0x05

btc_prefixSegWit :: PrefixSegWit
Just btc_prefixSegWit :: PrefixSegWit
btc_prefixSegWit = ByteString -> Maybe 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 -> PrefixP2SH -> PrefixSegWit -> Settings
Settings PrefixP2PKH
btcTestnet_prefixP2PKH PrefixP2SH
btcTestnet_prefixP2SH
                      PrefixSegWit
btcTestnet_prefixSegWit

btcTestnet_prefixP2PKH :: PrefixP2PKH
btcTestnet_prefixP2PKH :: PrefixP2PKH
btcTestnet_prefixP2PKH = Word8 -> PrefixP2PKH
PrefixP2PKH 0x6f

btcTestnet_prefixP2SH :: PrefixP2SH
btcTestnet_prefixP2SH :: PrefixP2SH
btcTestnet_prefixP2SH = Word8 -> PrefixP2SH
PrefixP2SH 0xc4

btcTestnet_prefixSegWit :: PrefixSegWit
Just btcTestnet_prefixSegWit :: PrefixSegWit
btcTestnet_prefixSegWit = ByteString -> Maybe PrefixSegWit
prefixSegWit "tb"