{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoFieldSelectors #-}

-- |
-- Module      : Haskoin.Script.Standard
-- Copyright   : No rights reserved
-- License     : MIT
-- Maintainer  : jprupp@protonmail.ch
-- Stability   : experimental
-- Portability : POSIX
--
-- Standard scripts like pay-to-public-key, pay-to-public-key-hash,
-- pay-to-script-hash, pay-to-multisig and corresponding SegWit variants.
module Haskoin.Script.Standard
  ( -- * Standard Script Outputs
    ScriptOutput (..),
    RedeemScript,
    isPayPK,
    isPayPKHash,
    isPayMulSig,
    isPayScriptHash,
    isPayWitness,
    isPayWitnessPKHash,
    isPayWitnessScriptHash,
    isDataCarrier,
    encodeOutput,
    decodeOutput,
    toP2SH,
    toP2WSH,
    sortMulSig,

    -- * Standard Script Inputs
    ScriptInput (..),
    SimpleInput (..),
    encodeInput,
    decodeInput,
    isSpendPK,
    isSpendPKHash,
    isSpendMulSig,
    isScriptHashInput,
  )
where

import Control.Applicative ((<|>))
import Control.DeepSeq
import Control.Monad (guard, liftM2, (<=<))
import Crypto.Secp256k1
import Data.Aeson (ToJSON (..), Value (..), withText)
import Data.Aeson.Encoding (Encoding, text)
import Data.Aeson.Types (Parser)
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
import Data.Function (on)
import Data.Hashable
import Data.List (sortBy)
import Data.Maybe (fromJust, isJust)
import Data.Word (Word8)
import GHC.Generics (Generic)
import Haskoin.Crypto.Hash
import Haskoin.Crypto.Keys.Common
import Haskoin.Network.Data
import Haskoin.Script.Common
import Haskoin.Script.SigHash
import Haskoin.Util

-- | Data type describing standard transaction output scripts. Output scripts
-- provide the conditions that must be fulfilled for someone to spend the funds
-- in a transaction output.
data ScriptOutput
  = -- | pay to public key
    PayPK {RedeemScript -> PublicKey
key :: !PublicKey}
  | -- | pay to public key hash
    PayPKHash {RedeemScript -> Hash160
hash160 :: !Hash160}
  | -- | multisig
    PayMulSig
      { RedeemScript -> [PublicKey]
keys :: ![PublicKey],
        RedeemScript -> Int
required :: !Int
      }
  | -- | pay to a script hash
    PayScriptHash {hash160 :: !Hash160}
  | -- | pay to witness public key hash
    PayWitnessPKHash {hash160 :: !Hash160}
  | -- | pay to witness script hash
    PayWitnessScriptHash {RedeemScript -> Hash256
hash256 :: !Hash256}
  | -- | another pay to witness address
    PayWitness
      { RedeemScript -> Word8
version :: !Word8,
        RedeemScript -> ByteString
bytes :: !ByteString
      }
  | -- | provably unspendable data carrier
    DataCarrier {bytes :: !ByteString}
  deriving (RedeemScript -> RedeemScript -> Bool
(RedeemScript -> RedeemScript -> Bool)
-> (RedeemScript -> RedeemScript -> Bool) -> Eq RedeemScript
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RedeemScript -> RedeemScript -> Bool
== :: RedeemScript -> RedeemScript -> Bool
$c/= :: RedeemScript -> RedeemScript -> Bool
/= :: RedeemScript -> RedeemScript -> Bool
Eq, Int -> RedeemScript -> ShowS
[RedeemScript] -> ShowS
RedeemScript -> String
(Int -> RedeemScript -> ShowS)
-> (RedeemScript -> String)
-> ([RedeemScript] -> ShowS)
-> Show RedeemScript
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RedeemScript -> ShowS
showsPrec :: Int -> RedeemScript -> ShowS
$cshow :: RedeemScript -> String
show :: RedeemScript -> String
$cshowList :: [RedeemScript] -> ShowS
showList :: [RedeemScript] -> ShowS
Show, ReadPrec [RedeemScript]
ReadPrec RedeemScript
Int -> ReadS RedeemScript
ReadS [RedeemScript]
(Int -> ReadS RedeemScript)
-> ReadS [RedeemScript]
-> ReadPrec RedeemScript
-> ReadPrec [RedeemScript]
-> Read RedeemScript
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RedeemScript
readsPrec :: Int -> ReadS RedeemScript
$creadList :: ReadS [RedeemScript]
readList :: ReadS [RedeemScript]
$creadPrec :: ReadPrec RedeemScript
readPrec :: ReadPrec RedeemScript
$creadListPrec :: ReadPrec [RedeemScript]
readListPrec :: ReadPrec [RedeemScript]
Read, (forall x. RedeemScript -> Rep RedeemScript x)
-> (forall x. Rep RedeemScript x -> RedeemScript)
-> Generic RedeemScript
forall x. Rep RedeemScript x -> RedeemScript
forall x. RedeemScript -> Rep RedeemScript x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RedeemScript -> Rep RedeemScript x
from :: forall x. RedeemScript -> Rep RedeemScript x
$cto :: forall x. Rep RedeemScript x -> RedeemScript
to :: forall x. Rep RedeemScript x -> RedeemScript
Generic, RedeemScript -> ()
(RedeemScript -> ()) -> NFData RedeemScript
forall a. (a -> ()) -> NFData a
$crnf :: RedeemScript -> ()
rnf :: RedeemScript -> ()
NFData)

instance MarshalJSON Ctx ScriptOutput where
  unmarshalValue :: Ctx -> Value -> Parser RedeemScript
unmarshalValue Ctx
ctx =
    String
-> (Text -> Parser RedeemScript) -> Value -> Parser RedeemScript
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ScriptOutput" ((Text -> Parser RedeemScript) -> Value -> Parser RedeemScript)
-> (Text -> Parser RedeemScript) -> Value -> Parser RedeemScript
forall a b. (a -> b) -> a -> b
$ \Text
t ->
      case Text -> Maybe ByteString
decodeHex Text
t of
        Maybe ByteString
Nothing -> String -> Parser RedeemScript
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not decode hex script"
        Just ByteString
bs -> (String -> Parser RedeemScript)
-> (RedeemScript -> Parser RedeemScript)
-> Either String RedeemScript
-> Parser RedeemScript
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser RedeemScript
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail RedeemScript -> Parser RedeemScript
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String RedeemScript -> Parser RedeemScript)
-> Either String RedeemScript -> Parser RedeemScript
forall a b. (a -> b) -> a -> b
$ Ctx -> ByteString -> Either String RedeemScript
forall s a. Marshal s a => s -> ByteString -> Either String a
unmarshal Ctx
ctx ByteString
bs

  marshalValue :: Ctx -> RedeemScript -> Value
marshalValue Ctx
ctx = Text -> Value
String (Text -> Value) -> (RedeemScript -> Text) -> RedeemScript -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeHex (ByteString -> Text)
-> (RedeemScript -> ByteString) -> RedeemScript -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> RedeemScript -> ByteString
forall s a. Marshal s a => s -> a -> ByteString
marshal Ctx
ctx

  marshalEncoding :: Ctx -> RedeemScript -> Encoding
marshalEncoding Ctx
ctx = ByteString -> Encoding
hexEncoding (ByteString -> Encoding)
-> (RedeemScript -> ByteString) -> RedeemScript -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutL (Put -> ByteString)
-> (RedeemScript -> Put) -> RedeemScript -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> RedeemScript -> Put
forall s a (m :: * -> *).
(Marshal s a, MonadPut m) =>
s -> a -> m ()
forall (m :: * -> *). MonadPut m => Ctx -> RedeemScript -> m ()
marshalPut Ctx
ctx

-- | Is script a pay-to-public-key output?
isPayPK :: ScriptOutput -> Bool
isPayPK :: RedeemScript -> Bool
isPayPK (PayPK PublicKey
_) = Bool
True
isPayPK RedeemScript
_ = Bool
False

-- | Is script a pay-to-pub-key-hash output?
isPayPKHash :: ScriptOutput -> Bool
isPayPKHash :: RedeemScript -> Bool
isPayPKHash (PayPKHash Hash160
_) = Bool
True
isPayPKHash RedeemScript
_ = Bool
False

-- | Is script a pay-to-multi-sig output?
isPayMulSig :: ScriptOutput -> Bool
isPayMulSig :: RedeemScript -> Bool
isPayMulSig (PayMulSig [PublicKey]
_ Int
_) = Bool
True
isPayMulSig RedeemScript
_ = Bool
False

-- | Is script a pay-to-script-hash output?
isPayScriptHash :: ScriptOutput -> Bool
isPayScriptHash :: RedeemScript -> Bool
isPayScriptHash (PayScriptHash Hash160
_) = Bool
True
isPayScriptHash RedeemScript
_ = Bool
False

-- | Is script a pay-to-witness-pub-key-hash output?
isPayWitnessPKHash :: ScriptOutput -> Bool
isPayWitnessPKHash :: RedeemScript -> Bool
isPayWitnessPKHash (PayWitnessPKHash Hash160
_) = Bool
True
isPayWitnessPKHash RedeemScript
_ = Bool
False

-- | Is script a pay-to-witness-script-hash output?
isPayWitnessScriptHash :: ScriptOutput -> Bool
isPayWitnessScriptHash :: RedeemScript -> Bool
isPayWitnessScriptHash (PayWitnessScriptHash Hash256
_) = Bool
True
isPayWitnessScriptHash RedeemScript
_ = Bool
False

-- | Is script paying to a different type of witness address?
isPayWitness :: ScriptOutput -> Bool
isPayWitness :: RedeemScript -> Bool
isPayWitness (PayWitness Word8
_ ByteString
_) = Bool
True
isPayWitness RedeemScript
_ = Bool
False

-- | Is script a data carrier output?
isDataCarrier :: ScriptOutput -> Bool
isDataCarrier :: RedeemScript -> Bool
isDataCarrier (DataCarrier ByteString
_) = Bool
True
isDataCarrier RedeemScript
_ = Bool
False

-- | Tries to decode a 'ScriptOutput' from a 'Script'. This can fail if the
-- script is not recognized as any of the standard output types.
decodeOutput :: Ctx -> Script -> Either String ScriptOutput
decodeOutput :: Ctx -> Script -> Either String RedeemScript
decodeOutput Ctx
ctx Script
s = case Script
s.ops of
  -- Pay to PubKey
  [OP_PUSHDATA ByteString
bs PushDataType
_, ScriptOp
OP_CHECKSIG] ->
    PublicKey -> RedeemScript
PayPK (PublicKey -> RedeemScript)
-> Either String PublicKey -> Either String RedeemScript
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ctx -> ByteString -> Either String PublicKey
forall s a. Marshal s a => s -> ByteString -> Either String a
unmarshal Ctx
ctx ByteString
bs
  -- Pay to PubKey Hash
  [ScriptOp
OP_DUP, ScriptOp
OP_HASH160, OP_PUSHDATA ByteString
bs PushDataType
_, ScriptOp
OP_EQUALVERIFY, ScriptOp
OP_CHECKSIG] ->
    Hash160 -> RedeemScript
PayPKHash (Hash160 -> RedeemScript)
-> Either String Hash160 -> Either String RedeemScript
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Hash160 -> ByteString -> Either String Hash160
forall a. Get a -> ByteString -> Either String a
runGetS Get Hash160
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Hash160
deserialize ByteString
bs
  -- Pay to Script Hash
  [ScriptOp
OP_HASH160, OP_PUSHDATA ByteString
bs PushDataType
_, ScriptOp
OP_EQUAL] ->
    Hash160 -> RedeemScript
PayScriptHash (Hash160 -> RedeemScript)
-> Either String Hash160 -> Either String RedeemScript
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Hash160 -> ByteString -> Either String Hash160
forall a. Get a -> ByteString -> Either String a
runGetS Get Hash160
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Hash160
deserialize ByteString
bs
  -- Pay to Witness
  [ScriptOp
OP_0, OP_PUSHDATA ByteString
bs PushDataType
OPCODE]
    | ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
20 ->
        Hash160 -> RedeemScript
PayWitnessPKHash (Hash160 -> RedeemScript)
-> Either String Hash160 -> Either String RedeemScript
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Hash160 -> ByteString -> Either String Hash160
forall a. Get a -> ByteString -> Either String a
runGetS Get Hash160
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Hash160
deserialize ByteString
bs
    | ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 ->
        Hash256 -> RedeemScript
PayWitnessScriptHash (Hash256 -> RedeemScript)
-> Either String Hash256 -> Either String RedeemScript
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Hash256 -> ByteString -> Either String Hash256
forall a. Get a -> ByteString -> Either String a
runGetS Get Hash256
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Hash256
deserialize ByteString
bs
    | ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
20 Bool -> Bool -> Bool
&& ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
32 ->
        String -> Either String RedeemScript
forall a b. a -> Either a b
Left
          String
"decodeOutput: invalid version 0 segwit \
          \(must be 20 or 32 bytes)"
  -- Other Witness
  [ScriptOp
ver, OP_PUSHDATA ByteString
bs PushDataType
_]
    | Just Word8
wv <- ScriptOp -> Maybe Word8
opWitnessVersion ScriptOp
ver,
      ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2,
      ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
40 ->
        RedeemScript -> Either String RedeemScript
forall a b. b -> Either a b
Right (RedeemScript -> Either String RedeemScript)
-> RedeemScript -> Either String RedeemScript
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> RedeemScript
PayWitness Word8
wv ByteString
bs
  -- Provably unspendable data carrier output
  [ScriptOp
OP_RETURN, OP_PUSHDATA ByteString
bs PushDataType
_] -> RedeemScript -> Either String RedeemScript
forall a b. b -> Either a b
Right (RedeemScript -> Either String RedeemScript)
-> RedeemScript -> Either String RedeemScript
forall a b. (a -> b) -> a -> b
$ ByteString -> RedeemScript
DataCarrier ByteString
bs
  -- Pay to MultiSig Keys
  [ScriptOp]
_ -> case Ctx -> Script -> Either String RedeemScript
matchPayMulSig Ctx
ctx Script
s of
    Right RedeemScript
x -> RedeemScript -> Either String RedeemScript
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return RedeemScript
x
    Left String
_ -> String -> Either String RedeemScript
forall a b. a -> Either a b
Left String
"decodeOutput: Non-standard output"

witnessVersionOp :: Word8 -> Maybe ScriptOp
witnessVersionOp :: Word8 -> Maybe ScriptOp
witnessVersionOp Word8
0 = ScriptOp -> Maybe ScriptOp
forall a. a -> Maybe a
Just ScriptOp
OP_0
witnessVersionOp Word8
1 = ScriptOp -> Maybe ScriptOp
forall a. a -> Maybe a
Just ScriptOp
OP_1
witnessVersionOp Word8
2 = ScriptOp -> Maybe ScriptOp
forall a. a -> Maybe a
Just ScriptOp
OP_2
witnessVersionOp Word8
3 = ScriptOp -> Maybe ScriptOp
forall a. a -> Maybe a
Just ScriptOp
OP_3
witnessVersionOp Word8
4 = ScriptOp -> Maybe ScriptOp
forall a. a -> Maybe a
Just ScriptOp
OP_4
witnessVersionOp Word8
5 = ScriptOp -> Maybe ScriptOp
forall a. a -> Maybe a
Just ScriptOp
OP_5
witnessVersionOp Word8
6 = ScriptOp -> Maybe ScriptOp
forall a. a -> Maybe a
Just ScriptOp
OP_6
witnessVersionOp Word8
7 = ScriptOp -> Maybe ScriptOp
forall a. a -> Maybe a
Just ScriptOp
OP_7
witnessVersionOp Word8
8 = ScriptOp -> Maybe ScriptOp
forall a. a -> Maybe a
Just ScriptOp
OP_8
witnessVersionOp Word8
9 = ScriptOp -> Maybe ScriptOp
forall a. a -> Maybe a
Just ScriptOp
OP_9
witnessVersionOp Word8
10 = ScriptOp -> Maybe ScriptOp
forall a. a -> Maybe a
Just ScriptOp
OP_10
witnessVersionOp Word8
11 = ScriptOp -> Maybe ScriptOp
forall a. a -> Maybe a
Just ScriptOp
OP_11
witnessVersionOp Word8
12 = ScriptOp -> Maybe ScriptOp
forall a. a -> Maybe a
Just ScriptOp
OP_12
witnessVersionOp Word8
13 = ScriptOp -> Maybe ScriptOp
forall a. a -> Maybe a
Just ScriptOp
OP_13
witnessVersionOp Word8
14 = ScriptOp -> Maybe ScriptOp
forall a. a -> Maybe a
Just ScriptOp
OP_14
witnessVersionOp Word8
15 = ScriptOp -> Maybe ScriptOp
forall a. a -> Maybe a
Just ScriptOp
OP_15
witnessVersionOp Word8
16 = ScriptOp -> Maybe ScriptOp
forall a. a -> Maybe a
Just ScriptOp
OP_16
witnessVersionOp Word8
_ = Maybe ScriptOp
forall a. Maybe a
Nothing

opWitnessVersion :: ScriptOp -> Maybe Word8
opWitnessVersion :: ScriptOp -> Maybe Word8
opWitnessVersion ScriptOp
OP_0 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
0
opWitnessVersion ScriptOp
OP_1 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
1
opWitnessVersion ScriptOp
OP_2 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
2
opWitnessVersion ScriptOp
OP_3 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
3
opWitnessVersion ScriptOp
OP_4 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
4
opWitnessVersion ScriptOp
OP_5 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
5
opWitnessVersion ScriptOp
OP_6 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
6
opWitnessVersion ScriptOp
OP_7 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
7
opWitnessVersion ScriptOp
OP_8 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
8
opWitnessVersion ScriptOp
OP_9 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
9
opWitnessVersion ScriptOp
OP_10 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
10
opWitnessVersion ScriptOp
OP_11 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
11
opWitnessVersion ScriptOp
OP_12 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
12
opWitnessVersion ScriptOp
OP_13 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
13
opWitnessVersion ScriptOp
OP_14 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
14
opWitnessVersion ScriptOp
OP_15 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
15
opWitnessVersion ScriptOp
OP_16 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
16
opWitnessVersion ScriptOp
_ = Maybe Word8
forall a. Maybe a
Nothing

-- | Computes a 'Script' from a standard 'ScriptOutput'.
encodeOutput :: Ctx -> ScriptOutput -> Script
encodeOutput :: Ctx -> RedeemScript -> Script
encodeOutput Ctx
ctx RedeemScript
s = [ScriptOp] -> Script
Script ([ScriptOp] -> Script) -> [ScriptOp] -> Script
forall a b. (a -> b) -> a -> b
$ case RedeemScript
s of
  -- Pay to PubKey
  (PayPK PublicKey
k) -> [ByteString -> ScriptOp
opPushData (ByteString -> ScriptOp) -> ByteString -> ScriptOp
forall a b. (a -> b) -> a -> b
$ Ctx -> PublicKey -> ByteString
forall s a. Marshal s a => s -> a -> ByteString
marshal Ctx
ctx PublicKey
k, ScriptOp
OP_CHECKSIG]
  -- Pay to PubKey Hash Address
  (PayPKHash Hash160
h) ->
    [ ScriptOp
OP_DUP,
      ScriptOp
OP_HASH160,
      ByteString -> ScriptOp
opPushData (ByteString -> ScriptOp) -> ByteString -> ScriptOp
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Hash160 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash160 -> m ()
serialize Hash160
h,
      ScriptOp
OP_EQUALVERIFY,
      ScriptOp
OP_CHECKSIG
    ]
  -- Pay to MultiSig Keys
  (PayMulSig [PublicKey]
ps Int
r)
    | Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [PublicKey] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PublicKey]
ps ->
        let opM :: ScriptOp
opM = Int -> ScriptOp
intToScriptOp Int
r
            opN :: ScriptOp
opN = Int -> ScriptOp
intToScriptOp (Int -> ScriptOp) -> Int -> ScriptOp
forall a b. (a -> b) -> a -> b
$ [PublicKey] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PublicKey]
ps
            keys :: [ScriptOp]
keys = (PublicKey -> ScriptOp) -> [PublicKey] -> [ScriptOp]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> ScriptOp
opPushData (ByteString -> ScriptOp)
-> (PublicKey -> ByteString) -> PublicKey -> ScriptOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> PublicKey -> ByteString
forall s a. Marshal s a => s -> a -> ByteString
marshal Ctx
ctx) [PublicKey]
ps
         in ScriptOp
opM ScriptOp -> [ScriptOp] -> [ScriptOp]
forall a. a -> [a] -> [a]
: [ScriptOp]
keys [ScriptOp] -> [ScriptOp] -> [ScriptOp]
forall a. [a] -> [a] -> [a]
++ [ScriptOp
opN, ScriptOp
OP_CHECKMULTISIG]
    | Bool
otherwise -> String -> [ScriptOp]
forall a. HasCallStack => String -> a
error String
"encodeOutput: PayMulSig r must be <= than pkeys"
  -- Pay to Script Hash Address
  (PayScriptHash Hash160
h) ->
    [ScriptOp
OP_HASH160, ByteString -> ScriptOp
opPushData (ByteString -> ScriptOp) -> ByteString -> ScriptOp
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Hash160 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash160 -> m ()
serialize Hash160
h, ScriptOp
OP_EQUAL]
  -- Pay to Witness PubKey Hash Address
  (PayWitnessPKHash Hash160
h) ->
    [ScriptOp
OP_0, ByteString -> ScriptOp
opPushData (ByteString -> ScriptOp) -> ByteString -> ScriptOp
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Hash160 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash160 -> m ()
serialize Hash160
h]
  (PayWitnessScriptHash Hash256
h) ->
    [ScriptOp
OP_0, ByteString -> ScriptOp
opPushData (ByteString -> ScriptOp) -> ByteString -> ScriptOp
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Hash256 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash256 -> m ()
serialize Hash256
h]
  (PayWitness Word8
v ByteString
h) ->
    [ case Word8 -> Maybe ScriptOp
witnessVersionOp Word8
v of
        Maybe ScriptOp
Nothing -> String -> ScriptOp
forall a. HasCallStack => String -> a
error String
"encodeOutput: invalid witness version"
        Just ScriptOp
c -> ScriptOp
c,
      ByteString -> ScriptOp
opPushData ByteString
h
    ]
  -- Provably unspendable output
  (DataCarrier ByteString
d) -> [ScriptOp
OP_RETURN, ByteString -> ScriptOp
opPushData ByteString
d]

instance Marshal Ctx ScriptOutput where
  marshalGet :: forall (m :: * -> *). MonadGet m => Ctx -> m RedeemScript
marshalGet Ctx
ctx = do
    Script
script <- m Script
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Script
deserialize
    case Ctx -> Script -> Either String RedeemScript
decodeOutput Ctx
ctx Script
script of
      Left String
e -> String -> m RedeemScript
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
      Right RedeemScript
o -> RedeemScript -> m RedeemScript
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return RedeemScript
o
  marshalPut :: forall (m :: * -> *). MonadPut m => Ctx -> RedeemScript -> m ()
marshalPut Ctx
ctx = Script -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Script -> m ()
serialize (Script -> m ())
-> (RedeemScript -> Script) -> RedeemScript -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> RedeemScript -> Script
encodeOutput Ctx
ctx

-- | Encode script as pay-to-script-hash script
toP2SH :: Script -> ScriptOutput
toP2SH :: Script -> RedeemScript
toP2SH = Hash160 -> RedeemScript
PayScriptHash (Hash160 -> RedeemScript)
-> (Script -> Hash160) -> Script -> RedeemScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Hash160
forall b. ByteArrayAccess b => b -> Hash160
addressHash (ByteString -> Hash160)
-> (Script -> ByteString) -> Script -> Hash160
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS (Put -> ByteString) -> (Script -> Put) -> Script -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Script -> m ()
serialize

-- | Encode script as a pay-to-witness-script-hash script
toP2WSH :: Script -> ScriptOutput
toP2WSH :: Script -> RedeemScript
toP2WSH = Hash256 -> RedeemScript
PayWitnessScriptHash (Hash256 -> RedeemScript)
-> (Script -> Hash256) -> Script -> RedeemScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Hash256
forall b. ByteArrayAccess b => b -> Hash256
sha256 (ByteString -> Hash256)
-> (Script -> ByteString) -> Script -> Hash256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS (Put -> ByteString) -> (Script -> Put) -> Script -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Script -> m ()
serialize

-- | Match @[OP_N, PubKey1, ..., PubKeyM, OP_M, OP_CHECKMULTISIG]@
matchPayMulSig :: Ctx -> Script -> Either String ScriptOutput
matchPayMulSig :: Ctx -> Script -> Either String RedeemScript
matchPayMulSig Ctx
ctx (Script [ScriptOp]
ops) = case Int -> [ScriptOp] -> ([ScriptOp], [ScriptOp])
forall a. Int -> [a] -> ([a], [a])
splitAt ([ScriptOp] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ScriptOp]
ops Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) [ScriptOp]
ops of
  (ScriptOp
m : [ScriptOp]
xs, [ScriptOp
n, ScriptOp
OP_CHECKMULTISIG]) -> do
    (Int
intM, Int
intN) <- (Int -> Int -> (Int, Int))
-> Either String Int
-> Either String Int
-> Either String (Int, Int)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (ScriptOp -> Either String Int
scriptOpToInt ScriptOp
m) (ScriptOp -> Either String Int
scriptOpToInt ScriptOp
n)
    if Int
intM Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
intN Bool -> Bool -> Bool
&& [ScriptOp] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ScriptOp]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
intN
      then ([PublicKey] -> Int -> RedeemScript)
-> Either String [PublicKey]
-> Either String Int
-> Either String RedeemScript
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [PublicKey] -> Int -> RedeemScript
PayMulSig ([ScriptOp] -> Either String [PublicKey]
forall {a1}. Marshal Ctx a1 => [ScriptOp] -> Either String [a1]
go [ScriptOp]
xs) (Int -> Either String Int
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
intM)
      else String -> Either String RedeemScript
forall a b. a -> Either a b
Left String
"matchPayMulSig: Invalid M or N parameters"
  ([ScriptOp], [ScriptOp])
_ -> String -> Either String RedeemScript
forall a b. a -> Either a b
Left String
"matchPayMulSig: script did not match output template"
  where
    go :: [ScriptOp] -> Either String [a1]
go (OP_PUSHDATA ByteString
bs PushDataType
_ : [ScriptOp]
xs) =
      (a1 -> [a1] -> [a1])
-> Either String a1 -> Either String [a1] -> Either String [a1]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) (Ctx -> ByteString -> Either String a1
forall s a. Marshal s a => s -> ByteString -> Either String a
unmarshal Ctx
ctx ByteString
bs) ([ScriptOp] -> Either String [a1]
go [ScriptOp]
xs)
    go [] =
      [a1] -> Either String [a1]
forall a b. b -> Either a b
Right []
    go [ScriptOp]
_ =
      String -> Either String [a1]
forall a b. a -> Either a b
Left String
"matchPayMulSig: invalid multisig opcode"

-- | Sort the public keys of a multisig output in ascending order by comparing
-- their compressed serialized representations. Refer to BIP-67.
sortMulSig :: Ctx -> ScriptOutput -> ScriptOutput
sortMulSig :: Ctx -> RedeemScript -> RedeemScript
sortMulSig Ctx
ctx RedeemScript
out = case RedeemScript
out of
  PayMulSig [PublicKey]
keys Int
r ->
    [PublicKey] -> Int -> RedeemScript
PayMulSig
      ((PublicKey -> PublicKey -> Ordering) -> [PublicKey] -> [PublicKey]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ByteString -> ByteString -> Ordering)
-> (PublicKey -> ByteString) -> PublicKey -> PublicKey -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Ctx -> PublicKey -> ByteString
forall s a. Marshal s a => s -> a -> ByteString
marshal Ctx
ctx) [PublicKey]
keys)
      Int
r
  RedeemScript
_ -> String -> RedeemScript
forall a. HasCallStack => String -> a
error String
"Can only call orderMulSig on PayMulSig scripts"

-- | Data type describing standard transaction input scripts. Input scripts
-- provide the signing data required to unlock the coins of the output they are
-- trying to spend, except in pay-to-witness-public-key-hash and
-- pay-to-script-hash transactions.
data SimpleInput
  = SpendPK
      { -- | transaction signature
        SimpleInput -> TxSignature
signature :: !TxSignature
      }
  | SpendPKHash
      { -- | embedded signature
        signature :: !TxSignature,
        -- | public key
        SimpleInput -> PublicKey
key :: !PublicKey
      }
  | SpendMulSig
      { -- | list of signatures
        SimpleInput -> [TxSignature]
signatures :: ![TxSignature]
      }
  deriving (SimpleInput -> SimpleInput -> Bool
(SimpleInput -> SimpleInput -> Bool)
-> (SimpleInput -> SimpleInput -> Bool) -> Eq SimpleInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SimpleInput -> SimpleInput -> Bool
== :: SimpleInput -> SimpleInput -> Bool
$c/= :: SimpleInput -> SimpleInput -> Bool
/= :: SimpleInput -> SimpleInput -> Bool
Eq, Int -> SimpleInput -> ShowS
[SimpleInput] -> ShowS
SimpleInput -> String
(Int -> SimpleInput -> ShowS)
-> (SimpleInput -> String)
-> ([SimpleInput] -> ShowS)
-> Show SimpleInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SimpleInput -> ShowS
showsPrec :: Int -> SimpleInput -> ShowS
$cshow :: SimpleInput -> String
show :: SimpleInput -> String
$cshowList :: [SimpleInput] -> ShowS
showList :: [SimpleInput] -> ShowS
Show, ReadPrec [SimpleInput]
ReadPrec SimpleInput
Int -> ReadS SimpleInput
ReadS [SimpleInput]
(Int -> ReadS SimpleInput)
-> ReadS [SimpleInput]
-> ReadPrec SimpleInput
-> ReadPrec [SimpleInput]
-> Read SimpleInput
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SimpleInput
readsPrec :: Int -> ReadS SimpleInput
$creadList :: ReadS [SimpleInput]
readList :: ReadS [SimpleInput]
$creadPrec :: ReadPrec SimpleInput
readPrec :: ReadPrec SimpleInput
$creadListPrec :: ReadPrec [SimpleInput]
readListPrec :: ReadPrec [SimpleInput]
Read, (forall x. SimpleInput -> Rep SimpleInput x)
-> (forall x. Rep SimpleInput x -> SimpleInput)
-> Generic SimpleInput
forall x. Rep SimpleInput x -> SimpleInput
forall x. SimpleInput -> Rep SimpleInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SimpleInput -> Rep SimpleInput x
from :: forall x. SimpleInput -> Rep SimpleInput x
$cto :: forall x. Rep SimpleInput x -> SimpleInput
to :: forall x. Rep SimpleInput x -> SimpleInput
Generic, SimpleInput -> ()
(SimpleInput -> ()) -> NFData SimpleInput
forall a. (a -> ()) -> NFData a
$crnf :: SimpleInput -> ()
rnf :: SimpleInput -> ()
NFData)

-- | Returns true if the input script is spending from a pay-to-public-key
-- output.
isSpendPK :: ScriptInput -> Bool
isSpendPK :: ScriptInput -> Bool
isSpendPK (RegularInput (SpendPK TxSignature
_)) = Bool
True
isSpendPK ScriptInput
_ = Bool
False

-- | Returns true if the input script is spending from a pay-to-public-key-hash
-- output.
isSpendPKHash :: ScriptInput -> Bool
isSpendPKHash :: ScriptInput -> Bool
isSpendPKHash (RegularInput (SpendPKHash TxSignature
_ PublicKey
_)) = Bool
True
isSpendPKHash ScriptInput
_ = Bool
False

-- | Returns true if the input script is spending a multisig output.
isSpendMulSig :: ScriptInput -> Bool
isSpendMulSig :: ScriptInput -> Bool
isSpendMulSig (RegularInput (SpendMulSig [TxSignature]
_)) = Bool
True
isSpendMulSig ScriptInput
_ = Bool
False

-- | Returns true if the input script is spending a pay-to-script-hash output.
isScriptHashInput :: ScriptInput -> Bool
isScriptHashInput :: ScriptInput -> Bool
isScriptHashInput (ScriptHashInput SimpleInput
_ RedeemScript
_) = Bool
True
isScriptHashInput ScriptInput
_ = Bool
False

-- | A redeem script is the output script serialized into the spending input
-- script. It must be included in inputs that spend pay-to-script-hash outputs.
type RedeemScript = ScriptOutput

-- | Standard input script high-level representation.
data ScriptInput
  = RegularInput
      { -- | get wrapped simple input
        ScriptInput -> SimpleInput
get :: !SimpleInput
      }
  | ScriptHashInput
      { -- | get simple input associated with redeem script
        get :: !SimpleInput,
        -- | redeem script
        ScriptInput -> RedeemScript
redeem :: !RedeemScript
      }
  deriving (Int -> ScriptInput -> ShowS
[ScriptInput] -> ShowS
ScriptInput -> String
(Int -> ScriptInput -> ShowS)
-> (ScriptInput -> String)
-> ([ScriptInput] -> ShowS)
-> Show ScriptInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScriptInput -> ShowS
showsPrec :: Int -> ScriptInput -> ShowS
$cshow :: ScriptInput -> String
show :: ScriptInput -> String
$cshowList :: [ScriptInput] -> ShowS
showList :: [ScriptInput] -> ShowS
Show, ReadPrec [ScriptInput]
ReadPrec ScriptInput
Int -> ReadS ScriptInput
ReadS [ScriptInput]
(Int -> ReadS ScriptInput)
-> ReadS [ScriptInput]
-> ReadPrec ScriptInput
-> ReadPrec [ScriptInput]
-> Read ScriptInput
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ScriptInput
readsPrec :: Int -> ReadS ScriptInput
$creadList :: ReadS [ScriptInput]
readList :: ReadS [ScriptInput]
$creadPrec :: ReadPrec ScriptInput
readPrec :: ReadPrec ScriptInput
$creadListPrec :: ReadPrec [ScriptInput]
readListPrec :: ReadPrec [ScriptInput]
Read, ScriptInput -> ScriptInput -> Bool
(ScriptInput -> ScriptInput -> Bool)
-> (ScriptInput -> ScriptInput -> Bool) -> Eq ScriptInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScriptInput -> ScriptInput -> Bool
== :: ScriptInput -> ScriptInput -> Bool
$c/= :: ScriptInput -> ScriptInput -> Bool
/= :: ScriptInput -> ScriptInput -> Bool
Eq, (forall x. ScriptInput -> Rep ScriptInput x)
-> (forall x. Rep ScriptInput x -> ScriptInput)
-> Generic ScriptInput
forall x. Rep ScriptInput x -> ScriptInput
forall x. ScriptInput -> Rep ScriptInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScriptInput -> Rep ScriptInput x
from :: forall x. ScriptInput -> Rep ScriptInput x
$cto :: forall x. Rep ScriptInput x -> ScriptInput
to :: forall x. Rep ScriptInput x -> ScriptInput
Generic, ScriptInput -> ()
(ScriptInput -> ()) -> NFData ScriptInput
forall a. (a -> ()) -> NFData a
$crnf :: ScriptInput -> ()
rnf :: ScriptInput -> ()
NFData)

-- | Heuristic to decode an input script into one of the standard types.
decodeSimpleInput :: Network -> Ctx -> Script -> Either String SimpleInput
decodeSimpleInput :: Network -> Ctx -> Script -> Either String SimpleInput
decodeSimpleInput Network
net Ctx
ctx (Script [ScriptOp]
ops) =
  String -> Maybe SimpleInput -> Either String SimpleInput
forall b a. b -> Maybe a -> Either b a
maybeToEither String
errMsg (Maybe SimpleInput -> Either String SimpleInput)
-> Maybe SimpleInput -> Either String SimpleInput
forall a b. (a -> b) -> a -> b
$ [ScriptOp] -> Maybe SimpleInput
matchPK [ScriptOp]
ops Maybe SimpleInput -> Maybe SimpleInput -> Maybe SimpleInput
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [ScriptOp] -> Maybe SimpleInput
matchPKHash [ScriptOp]
ops Maybe SimpleInput -> Maybe SimpleInput -> Maybe SimpleInput
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [ScriptOp] -> Maybe SimpleInput
matchMulSig [ScriptOp]
ops
  where
    matchPK :: [ScriptOp] -> Maybe SimpleInput
matchPK [ScriptOp
op] = TxSignature -> SimpleInput
SpendPK (TxSignature -> SimpleInput)
-> Maybe TxSignature -> Maybe SimpleInput
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptOp -> Maybe TxSignature
f ScriptOp
op
    matchPK [ScriptOp]
_ = Maybe SimpleInput
forall a. Maybe a
Nothing
    matchPKHash :: [ScriptOp] -> Maybe SimpleInput
matchPKHash [ScriptOp
op, OP_PUSHDATA ByteString
pub PushDataType
_] =
      TxSignature -> PublicKey -> SimpleInput
SpendPKHash (TxSignature -> PublicKey -> SimpleInput)
-> Maybe TxSignature -> Maybe (PublicKey -> SimpleInput)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptOp -> Maybe TxSignature
f ScriptOp
op Maybe (PublicKey -> SimpleInput)
-> Maybe PublicKey -> Maybe SimpleInput
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either String PublicKey -> Maybe PublicKey
forall a b. Either a b -> Maybe b
eitherToMaybe (Ctx -> ByteString -> Either String PublicKey
forall s a. Marshal s a => s -> ByteString -> Either String a
unmarshal Ctx
ctx ByteString
pub)
    matchPKHash [ScriptOp]
_ = Maybe SimpleInput
forall a. Maybe a
Nothing
    matchMulSig :: [ScriptOp] -> Maybe SimpleInput
matchMulSig (ScriptOp
x : [ScriptOp]
xs) = do
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ScriptOp
x ScriptOp -> ScriptOp -> Bool
forall a. Eq a => a -> a -> Bool
== ScriptOp
OP_0
      [TxSignature] -> SimpleInput
SpendMulSig ([TxSignature] -> SimpleInput)
-> Maybe [TxSignature] -> Maybe SimpleInput
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ScriptOp -> Maybe TxSignature)
-> [ScriptOp] -> Maybe [TxSignature]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ScriptOp -> Maybe TxSignature
f [ScriptOp]
xs
    matchMulSig [ScriptOp]
_ = Maybe SimpleInput
forall a. Maybe a
Nothing
    f :: ScriptOp -> Maybe TxSignature
f ScriptOp
OP_0 = TxSignature -> Maybe TxSignature
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return TxSignature
TxSignatureEmpty
    f (OP_PUSHDATA ByteString
"" PushDataType
OPCODE) = ScriptOp -> Maybe TxSignature
f ScriptOp
OP_0
    f (OP_PUSHDATA ByteString
bs PushDataType
_) = Either String TxSignature -> Maybe TxSignature
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String TxSignature -> Maybe TxSignature)
-> Either String TxSignature -> Maybe TxSignature
forall a b. (a -> b) -> a -> b
$ Network -> Ctx -> ByteString -> Either String TxSignature
decodeTxSig Network
net Ctx
ctx ByteString
bs
    f ScriptOp
_ = Maybe TxSignature
forall a. Maybe a
Nothing
    errMsg :: String
errMsg = String
"decodeInput: Could not decode script input"

-- | Heuristic to decode a 'ScriptInput' from a 'Script'. This function fails if
-- the script can not be parsed as a standard script input.
decodeInput :: Network -> Ctx -> Script -> Either String ScriptInput
decodeInput :: Network -> Ctx -> Script -> Either String ScriptInput
decodeInput Network
net Ctx
ctx s :: Script
s@(Script [ScriptOp]
ops) =
  String -> Maybe ScriptInput -> Either String ScriptInput
forall b a. b -> Maybe a -> Either b a
maybeToEither String
errMsg (Maybe ScriptInput -> Either String ScriptInput)
-> Maybe ScriptInput -> Either String ScriptInput
forall a b. (a -> b) -> a -> b
$ Maybe ScriptInput
matchSimpleInput Maybe ScriptInput -> Maybe ScriptInput -> Maybe ScriptInput
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe ScriptInput
matchPayScriptHash
  where
    matchSimpleInput :: Maybe ScriptInput
matchSimpleInput =
      SimpleInput -> ScriptInput
RegularInput (SimpleInput -> ScriptInput)
-> Maybe SimpleInput -> Maybe ScriptInput
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String SimpleInput -> Maybe SimpleInput
forall a b. Either a b -> Maybe b
eitherToMaybe (Network -> Ctx -> Script -> Either String SimpleInput
decodeSimpleInput Network
net Ctx
ctx Script
s)
    matchPayScriptHash :: Maybe ScriptInput
matchPayScriptHash =
      case Int -> [ScriptOp] -> ([ScriptOp], [ScriptOp])
forall a. Int -> [a] -> ([a], [a])
splitAt ([ScriptOp] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Script
s.ops Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [ScriptOp]
ops of
        ([ScriptOp]
is, [OP_PUSHDATA ByteString
bs PushDataType
_]) -> do
          RedeemScript
rdm <- Either String RedeemScript -> Maybe RedeemScript
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String RedeemScript -> Maybe RedeemScript)
-> Either String RedeemScript -> Maybe RedeemScript
forall a b. (a -> b) -> a -> b
$ Ctx -> ByteString -> Either String RedeemScript
forall s a. Marshal s a => s -> ByteString -> Either String a
unmarshal Ctx
ctx ByteString
bs
          SimpleInput
inp <- Either String SimpleInput -> Maybe SimpleInput
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String SimpleInput -> Maybe SimpleInput)
-> Either String SimpleInput -> Maybe SimpleInput
forall a b. (a -> b) -> a -> b
$ Network -> Ctx -> Script -> Either String SimpleInput
decodeSimpleInput Network
net Ctx
ctx (Script -> Either String SimpleInput)
-> Script -> Either String SimpleInput
forall a b. (a -> b) -> a -> b
$ [ScriptOp] -> Script
Script [ScriptOp]
is
          ScriptInput -> Maybe ScriptInput
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptInput -> Maybe ScriptInput)
-> ScriptInput -> Maybe ScriptInput
forall a b. (a -> b) -> a -> b
$ SimpleInput -> RedeemScript -> ScriptInput
ScriptHashInput SimpleInput
inp RedeemScript
rdm
        ([ScriptOp], [ScriptOp])
_ -> Maybe ScriptInput
forall a. Maybe a
Nothing
    errMsg :: String
errMsg = String
"decodeInput: Could not decode script input"

instance Marshal (Network, Ctx) ScriptInput where
  marshalGet :: forall (m :: * -> *). MonadGet m => (Network, Ctx) -> m ScriptInput
marshalGet (Network
net, Ctx
ctx) =
    m Script
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Script
deserialize m Script -> (Script -> m ScriptInput) -> m ScriptInput
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> m ScriptInput)
-> (ScriptInput -> m ScriptInput)
-> Either String ScriptInput
-> m ScriptInput
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m ScriptInput
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ScriptInput -> m ScriptInput
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String ScriptInput -> m ScriptInput)
-> (Script -> Either String ScriptInput) -> Script -> m ScriptInput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network -> Ctx -> Script -> Either String ScriptInput
decodeInput Network
net Ctx
ctx

  marshalPut :: forall (m :: * -> *).
MonadPut m =>
(Network, Ctx) -> ScriptInput -> m ()
marshalPut (Network
net, Ctx
ctx) =
    Script -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Script -> m ()
serialize (Script -> m ()) -> (ScriptInput -> Script) -> ScriptInput -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network -> Ctx -> ScriptInput -> Script
encodeInput Network
net Ctx
ctx

-- | Encode a standard input into a script.
encodeInput :: Network -> Ctx -> ScriptInput -> Script
encodeInput :: Network -> Ctx -> ScriptInput -> Script
encodeInput Network
net Ctx
ctx ScriptInput
s = case ScriptInput
s of
  RegularInput SimpleInput
ri -> Network -> Ctx -> SimpleInput -> Script
encodeSimpleInput Network
net Ctx
ctx SimpleInput
ri
  ScriptHashInput SimpleInput
i RedeemScript
o ->
    [ScriptOp] -> Script
Script ([ScriptOp] -> Script) -> [ScriptOp] -> Script
forall a b. (a -> b) -> a -> b
$ (Network -> Ctx -> SimpleInput -> Script
encodeSimpleInput Network
net Ctx
ctx SimpleInput
i).ops [ScriptOp] -> [ScriptOp] -> [ScriptOp]
forall a. [a] -> [a] -> [a]
++ [ByteString -> ScriptOp
opPushData (ByteString -> ScriptOp) -> ByteString -> ScriptOp
forall a b. (a -> b) -> a -> b
$ Ctx -> RedeemScript -> ByteString
forall s a. Marshal s a => s -> a -> ByteString
marshal Ctx
ctx RedeemScript
o]

-- | Encode a standard 'SimpleInput' into opcodes as an input 'Script'.
encodeSimpleInput :: Network -> Ctx -> SimpleInput -> Script
encodeSimpleInput :: Network -> Ctx -> SimpleInput -> Script
encodeSimpleInput Network
net Ctx
ctx SimpleInput
s =
  [ScriptOp] -> Script
Script ([ScriptOp] -> Script) -> [ScriptOp] -> Script
forall a b. (a -> b) -> a -> b
$
    case SimpleInput
s of
      SpendPK TxSignature
ts -> [TxSignature -> ScriptOp
f TxSignature
ts]
      SpendPKHash TxSignature
ts PublicKey
p -> [TxSignature -> ScriptOp
f TxSignature
ts, ByteString -> ScriptOp
opPushData (ByteString -> ScriptOp) -> ByteString -> ScriptOp
forall a b. (a -> b) -> a -> b
$ Ctx -> PublicKey -> ByteString
forall s a. Marshal s a => s -> a -> ByteString
marshal Ctx
ctx PublicKey
p]
      SpendMulSig [TxSignature]
xs -> ScriptOp
OP_0 ScriptOp -> [ScriptOp] -> [ScriptOp]
forall a. a -> [a] -> [a]
: (TxSignature -> ScriptOp) -> [TxSignature] -> [ScriptOp]
forall a b. (a -> b) -> [a] -> [b]
map TxSignature -> ScriptOp
f [TxSignature]
xs
  where
    f :: TxSignature -> ScriptOp
f TxSignature
TxSignatureEmpty = ScriptOp
OP_0
    f TxSignature
ts = ByteString -> ScriptOp
opPushData (ByteString -> ScriptOp) -> ByteString -> ScriptOp
forall a b. (a -> b) -> a -> b
$ Network -> Ctx -> TxSignature -> ByteString
encodeTxSig Network
net Ctx
ctx TxSignature
ts