Script.hs

-- | 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 pkh = S.Script
  [ S.OP_DUP
  , S.OP_HASH160
  , S.OP_PUSHDATA (unPubHash160 pkh) S.OPCODE
  , S.OP_EQUALVERIFY
  , 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 sh = S.Script
  [ S.OP_HASH160
  , S.OP_PUSHDATA (unScriptHash160 sh) S.OPCODE
  , 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 swp = S.Script
  [ SW.versionOp (SW.programVersion swp)
  , S.OP_PUSHDATA (SW.programData swp ) 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 pks req = do
  let len = length pks
  guard (req >= 1 && req <= 16 && req <= len)
  opLen <- op0to16 len
  opReq <- op0to16 req
  pure $ S.Script $ mconcat
    [ [ opReq ]
    , do pk <- pks
         pure $ S.OP_PUSHDATA (pubCompressed pk) S.OPCODE
    , [ opLen, S.OP_CHECKMULTISIG ] ]