-- | This module exports standard Bitcoin 'S.Script' constructions.
module Bitcoin.Address.Script
  ( -- * Scripts
    p2pkh
  , p2sh
  , segWit
  , multiSig
  ) where

import Bitcoin.Keys (Pub, pubCompressed)
import Control.Monad
import qualified Data.Bitcoin.Script as S

import Bitcoin.Address.Hash
import Bitcoin.Address.Internal (op0to16)
import qualified Bitcoin.Address.SegWit as SW

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

-- | Standard 'Bitcoin.Address.P2PKH' script.
--
-- [pubh]: 'PubHash160'.
--
-- Script:
--
-- @
-- 'S.OP_DUP'
-- 'S.OP_HASH160'
-- 'S.OP_PUSHDATA' pubh 'S.OPCODE'
-- 'S.OP_EQUALVERIFY'
-- 'S.OP_CHECKSIG'
-- @
p2pkh :: PubHash160 -> S.Script
p2pkh :: PubHash160 -> Script
p2pkh pkh :: PubHash160
pkh = [ScriptOp] -> Script
S.Script
  [ ScriptOp
S.OP_DUP
  , ScriptOp
S.OP_HASH160
  , ByteString -> PushDataType -> ScriptOp
S.OP_PUSHDATA (PubHash160 -> ByteString
unPubHash160 PubHash160
pkh) PushDataType
S.OPCODE
  , ScriptOp
S.OP_EQUALVERIFY
  , ScriptOp
S.OP_CHECKSIG
  ]

-- | Standard 'Bitcoin.Address.P2SH' script.
--
-- [sh]: 'ScriptHash160'.
--
-- Script:
--
-- @
-- 'S.OP_HASH160'
-- 'S.OP_PUSHDATA' sh 'S.OPCODE'
-- 'S.OP_EQUAL'
-- @
p2sh :: ScriptHash160 -> S.Script
p2sh :: ScriptHash160 -> Script
p2sh sh :: ScriptHash160
sh = [ScriptOp] -> Script
S.Script
  [ ScriptOp
S.OP_HASH160
  , ByteString -> PushDataType -> ScriptOp
S.OP_PUSHDATA (ScriptHash160 -> ByteString
unScriptHash160 ScriptHash160
sh) PushDataType
S.OPCODE
  , ScriptOp
S.OP_EQUAL
  ]

-- | Standard SegWit 'Bitcoin.Address.Program' script.
--
-- [ver]: SegWit 'SW.versionOp'
--
-- [prog]: SegWit 'SW.programData'
--
-- Script:
--
-- @
-- ver
-- 'S.OP_PUSHDATA' prog 'S.OPCODE'
-- @
segWit :: SW.Program -> S.Script
segWit :: Program -> Script
segWit swp :: Program
swp = [ScriptOp] -> Script
S.Script
  [ Version -> ScriptOp
SW.versionOp (Program -> Version
SW.programVersion Program
swp)
  , ByteString -> PushDataType -> ScriptOp
S.OP_PUSHDATA (Program -> ByteString
SW.programData Program
swp ) PushDataType
S.OPCODE
  ]

-- | Standard “m-of-n” multi-signature script.
--
-- [m]: Number of required signatures in range ['S.OP_1' … 'S.OP_16']
--
-- [n]: Number of 'Pub'lic keys given in range ['S.OP_1' … 'S.OP_16']
--
-- [pubs]: Compressed SEC representation the given 'Pub'lic keys, each one
-- (@pub@) encoded as @'S.OP_PUSHDATA' ('pubCompressed' pub) 'S.OPCODE'@.
--
-- Script:
--
-- @
-- m
-- pubs
-- n
-- 'S.OP_CHECKMULTISIG'
-- @
multiSig
  :: [Pub] -- ^ Public keys. Total number in range [1 … 16]
  -> Int   -- ^ Required number of signatures in range [1, 16].
  -> Maybe S.Script -- ^ 'Nothing' if any of the inputs is invalid.
multiSig :: [Pub] -> Int -> Maybe Script
multiSig pks :: [Pub]
pks req :: Int
req = do
  let len :: Int
len = [Pub] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pub]
pks
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
req Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 1 Bool -> Bool -> Bool
&& Int
req Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 16 Bool -> Bool -> Bool
&& Int
req Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
len)
  ScriptOp
opLen <- Int -> Maybe ScriptOp
op0to16 Int
len
  ScriptOp
opReq <- Int -> Maybe ScriptOp
op0to16 Int
req
  Script -> Maybe Script
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Script -> Maybe Script) -> Script -> Maybe Script
forall a b. (a -> b) -> a -> b
$ [ScriptOp] -> Script
S.Script ([ScriptOp] -> Script) -> [ScriptOp] -> Script
forall a b. (a -> b) -> a -> b
$ [[ScriptOp]] -> [ScriptOp]
forall a. Monoid a => [a] -> a
mconcat
    [ [ ScriptOp
opReq ]
    , do Pub
pk <- [Pub]
pks
         ScriptOp -> [ScriptOp]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScriptOp -> [ScriptOp]) -> ScriptOp -> [ScriptOp]
forall a b. (a -> b) -> a -> b
$ ByteString -> PushDataType -> ScriptOp
S.OP_PUSHDATA (Pub -> ByteString
pubCompressed Pub
pk) PushDataType
S.OPCODE
    , [ ScriptOp
opLen, ScriptOp
S.OP_CHECKMULTISIG ] ]