{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
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,
    encodeOutputBS,
    decodeOutput,
    decodeOutputBS,
    toP2SH,
    toP2WSH,
    sortMulSig,

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

import Control.Applicative ((<|>))
import Control.DeepSeq
import Control.Monad (guard, liftM2, (<=<))
import qualified Data.Aeson as A
import qualified Data.Aeson.Encoding as A
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
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
import Haskoin.Data
import Haskoin.Keys.Common
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 {ScriptOutput -> PubKeyI
getOutputPubKey :: !PubKeyI}
    | -- | pay to public key hash
      PayPKHash {ScriptOutput -> Hash160
getOutputHash :: !Hash160}
    | -- | multisig
      PayMulSig
        { ScriptOutput -> [PubKeyI]
getOutputMulSigKeys :: ![PubKeyI]
        , ScriptOutput -> Int
getOutputMulSigRequired :: !Int
        }
    | -- | pay to a script hash
      PayScriptHash {getOutputHash :: !Hash160}
    | -- | pay to witness public key hash
      PayWitnessPKHash {getOutputHash :: !Hash160}
    | -- | pay to witness script hash
      PayWitnessScriptHash {ScriptOutput -> Hash256
getScriptHash :: !Hash256}
    | -- | another pay to witness address
      PayWitness
        { ScriptOutput -> Word8
getWitnessVersion :: !Word8
        , ScriptOutput -> ByteString
getWitnessData :: !ByteString
        }
    | -- | provably unspendable data carrier
      DataCarrier {ScriptOutput -> ByteString
getOutputData :: !ByteString}
    deriving (ScriptOutput -> ScriptOutput -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptOutput -> ScriptOutput -> Bool
$c/= :: ScriptOutput -> ScriptOutput -> Bool
== :: ScriptOutput -> ScriptOutput -> Bool
$c== :: ScriptOutput -> ScriptOutput -> Bool
Eq, Int -> ScriptOutput -> ShowS
[ScriptOutput] -> ShowS
ScriptOutput -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptOutput] -> ShowS
$cshowList :: [ScriptOutput] -> ShowS
show :: ScriptOutput -> String
$cshow :: ScriptOutput -> String
showsPrec :: Int -> ScriptOutput -> ShowS
$cshowsPrec :: Int -> ScriptOutput -> ShowS
Show, ReadPrec [ScriptOutput]
ReadPrec ScriptOutput
Int -> ReadS ScriptOutput
ReadS [ScriptOutput]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ScriptOutput]
$creadListPrec :: ReadPrec [ScriptOutput]
readPrec :: ReadPrec ScriptOutput
$creadPrec :: ReadPrec ScriptOutput
readList :: ReadS [ScriptOutput]
$creadList :: ReadS [ScriptOutput]
readsPrec :: Int -> ReadS ScriptOutput
$creadsPrec :: Int -> ReadS ScriptOutput
Read, forall x. Rep ScriptOutput x -> ScriptOutput
forall x. ScriptOutput -> Rep ScriptOutput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScriptOutput x -> ScriptOutput
$cfrom :: forall x. ScriptOutput -> Rep ScriptOutput x
Generic, Eq ScriptOutput
Int -> ScriptOutput -> Int
ScriptOutput -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ScriptOutput -> Int
$chash :: ScriptOutput -> Int
hashWithSalt :: Int -> ScriptOutput -> Int
$chashWithSalt :: Int -> ScriptOutput -> Int
Hashable, ScriptOutput -> ()
forall a. (a -> ()) -> NFData a
rnf :: ScriptOutput -> ()
$crnf :: ScriptOutput -> ()
NFData)

instance A.FromJSON ScriptOutput where
    parseJSON :: Value -> Parser ScriptOutput
parseJSON =
        forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"scriptoutput" forall a b. (a -> b) -> a -> b
$ \Text
t ->
            forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                forall b a. b -> Maybe a -> Either b a
maybeToEither String
"scriptoutput not hex" (Text -> Maybe ByteString
decodeHex Text
t)
                    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Either String ScriptOutput
decodeOutputBS

instance A.ToJSON ScriptOutput where
    toJSON :: ScriptOutput -> Value
toJSON = Text -> Value
A.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeHex forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptOutput -> ByteString
encodeOutputBS
    toEncoding :: ScriptOutput -> Encoding
toEncoding = forall a. Text -> Encoding' a
A.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeHex forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptOutput -> ByteString
encodeOutputBS

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

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

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

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

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

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

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

-- | Is script a data carrier output?
isDataCarrier :: ScriptOutput -> Bool
isDataCarrier :: ScriptOutput -> Bool
isDataCarrier (DataCarrier ByteString
_) = Bool
True
isDataCarrier ScriptOutput
_ = 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 :: Script -> Either String ScriptOutput
decodeOutput :: Script -> Either String ScriptOutput
decodeOutput Script
s = case Script -> [ScriptOp]
scriptOps Script
s of
    -- Pay to PubKey
    [OP_PUSHDATA ByteString
bs PushDataType
_, ScriptOp
OP_CHECKSIG] -> PubKeyI -> ScriptOutput
PayPK forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Get a -> ByteString -> Either String a
runGetS forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize ByteString
bs
    -- Pay to PubKey Hash
    [ScriptOp
OP_DUP, ScriptOp
OP_HASH160, OP_PUSHDATA ByteString
bs PushDataType
_, ScriptOp
OP_EQUALVERIFY, ScriptOp
OP_CHECKSIG] ->
        Hash160 -> ScriptOutput
PayPKHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Get a -> ByteString -> Either String a
runGetS forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize ByteString
bs
    -- Pay to Script Hash
    [ScriptOp
OP_HASH160, OP_PUSHDATA ByteString
bs PushDataType
_, ScriptOp
OP_EQUAL] ->
        Hash160 -> ScriptOutput
PayScriptHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Get a -> ByteString -> Either String a
runGetS forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize ByteString
bs
    -- Pay to Witness
    [ScriptOp
OP_0, OP_PUSHDATA ByteString
bs PushDataType
OPCODE]
        | ByteString -> Int
BS.length ByteString
bs forall a. Eq a => a -> a -> Bool
== Int
20 -> Hash160 -> ScriptOutput
PayWitnessPKHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Get a -> ByteString -> Either String a
runGetS forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize ByteString
bs
        | ByteString -> Int
BS.length ByteString
bs forall a. Eq a => a -> a -> Bool
== Int
32 -> Hash256 -> ScriptOutput
PayWitnessScriptHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Get a -> ByteString -> Either String a
runGetS forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize ByteString
bs
        | ByteString -> Int
BS.length ByteString
bs forall a. Eq a => a -> a -> Bool
/= Int
20 Bool -> Bool -> Bool
&& ByteString -> Int
BS.length ByteString
bs forall a. Eq a => a -> a -> Bool
/= Int
32 ->
            forall a b. a -> Either a b
Left String
"Version 0 segwit program must be 20 or 32 bytes long"
    -- Other Witness
    [ScriptOp
ver, OP_PUSHDATA ByteString
bs PushDataType
_]
        | forall a. Maybe a -> Bool
isJust (ScriptOp -> Maybe Word8
opWitnessVersion ScriptOp
ver)
            Bool -> Bool -> Bool
&& ByteString -> Int
BS.length ByteString
bs forall a. Ord a => a -> a -> Bool
>= Int
2
            Bool -> Bool -> Bool
&& ByteString -> Int
BS.length ByteString
bs forall a. Ord a => a -> a -> Bool
<= Int
40 ->
            forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> ScriptOutput
PayWitness (forall a. HasCallStack => Maybe a -> a
fromJust (ScriptOp -> Maybe Word8
opWitnessVersion ScriptOp
ver)) ByteString
bs
    -- Provably unspendable data carrier output
    [ScriptOp
OP_RETURN, OP_PUSHDATA ByteString
bs PushDataType
_] -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ ByteString -> ScriptOutput
DataCarrier ByteString
bs
    -- Pay to MultiSig Keys
    [ScriptOp]
_ -> Script -> Either String ScriptOutput
matchPayMulSig Script
s

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

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

-- | Similar to 'decodeOutput' but decodes from a 'ByteString'.
decodeOutputBS :: ByteString -> Either String ScriptOutput
decodeOutputBS :: ByteString -> Either String ScriptOutput
decodeOutputBS = Script -> Either String ScriptOutput
decodeOutput forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. Get a -> ByteString -> Either String a
runGetS forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

-- | Computes a 'Script' from a standard 'ScriptOutput'.
encodeOutput :: ScriptOutput -> Script
encodeOutput :: ScriptOutput -> Script
encodeOutput ScriptOutput
s = [ScriptOp] -> Script
Script forall a b. (a -> b) -> a -> b
$ case ScriptOutput
s of
    -- Pay to PubKey
    (PayPK PubKeyI
k) -> [ByteString -> ScriptOp
opPushData forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPutS forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize PubKeyI
k, ScriptOp
OP_CHECKSIG]
    -- Pay to PubKey Hash Address
    (PayPKHash Hash160
h) ->
        [ ScriptOp
OP_DUP
        , ScriptOp
OP_HASH160
        , ByteString -> ScriptOp
opPushData forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPutS forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Hash160
h
        , ScriptOp
OP_EQUALVERIFY
        , ScriptOp
OP_CHECKSIG
        ]
    -- Pay to MultiSig Keys
    (PayMulSig [PubKeyI]
ps Int
r)
        | Int
r forall a. Ord a => a -> a -> Bool
<= forall (t :: * -> *) a. Foldable t => t a -> Int
length [PubKeyI]
ps ->
            let opM :: ScriptOp
opM = Int -> ScriptOp
intToScriptOp Int
r
                opN :: ScriptOp
opN = Int -> ScriptOp
intToScriptOp forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [PubKeyI]
ps
                keys :: [ScriptOp]
keys = forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> ScriptOp
opPushData forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize) [PubKeyI]
ps
             in ScriptOp
opM forall a. a -> [a] -> [a]
: [ScriptOp]
keys forall a. [a] -> [a] -> [a]
++ [ScriptOp
opN, ScriptOp
OP_CHECKMULTISIG]
        | Bool
otherwise -> 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 forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPutS forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Hash160
h, ScriptOp
OP_EQUAL]
    -- Pay to Witness PubKey Hash Address
    (PayWitnessPKHash Hash160
h) ->
        [ScriptOp
OP_0, ByteString -> ScriptOp
opPushData forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPutS forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Hash160
h]
    (PayWitnessScriptHash Hash256
h) ->
        [ScriptOp
OP_0, ByteString -> ScriptOp
opPushData forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPutS forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize Hash256
h]
    (PayWitness Word8
v ByteString
h) ->
        [ case Word8 -> Maybe ScriptOp
witnessVersionOp Word8
v of
            Maybe ScriptOp
Nothing -> 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]

-- | Similar to 'encodeOutput' but encodes to a ByteString
encodeOutputBS :: ScriptOutput -> ByteString
encodeOutputBS :: ScriptOutput -> ByteString
encodeOutputBS = Put -> ByteString
runPutS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptOutput -> Script
encodeOutput

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

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

-- | Match @[OP_N, PubKey1, ..., PubKeyM, OP_M, OP_CHECKMULTISIG]@
matchPayMulSig :: Script -> Either String ScriptOutput
matchPayMulSig :: Script -> Either String ScriptOutput
matchPayMulSig (Script [ScriptOp]
ops) = case forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [ScriptOp]
ops 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) <- 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 forall a. Ord a => a -> a -> Bool
<= Int
intN Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length [ScriptOp]
xs forall a. Eq a => a -> a -> Bool
== Int
intN
            then forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [PubKeyI] -> Int -> ScriptOutput
PayMulSig (forall {a1}. Serial a1 => [ScriptOp] -> Either String [a1]
go [ScriptOp]
xs) (forall (m :: * -> *) a. Monad m => a -> m a
return Int
intM)
            else forall a b. a -> Either a b
Left String
"matchPayMulSig: Invalid M or N parameters"
    ([ScriptOp], [ScriptOp])
_ -> 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) = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) (forall a. Get a -> ByteString -> Either String a
runGetS forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize ByteString
bs) ([ScriptOp] -> Either String [a1]
go [ScriptOp]
xs)
    go [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
    go [ScriptOp]
_ = 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 :: ScriptOutput -> ScriptOutput
sortMulSig :: ScriptOutput -> ScriptOutput
sortMulSig ScriptOutput
out = case ScriptOutput
out of
    PayMulSig [PubKeyI]
keys Int
r -> [PubKeyI] -> Int -> ScriptOutput
PayMulSig (forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Put -> ByteString
runPutS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize)) [PubKeyI]
keys) Int
r
    ScriptOutput
_ -> 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
getInputSig :: !TxSignature
        }
    | SpendPKHash
        { -- | embedded signature
          getInputSig :: !TxSignature
        , -- | public key
          SimpleInput -> PubKeyI
getInputKey :: !PubKeyI
        }
    | SpendMulSig
        { -- | list of signatures
          SimpleInput -> [TxSignature]
getInputMulSigKeys :: ![TxSignature]
        }
    deriving (SimpleInput -> SimpleInput -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleInput -> SimpleInput -> Bool
$c/= :: SimpleInput -> SimpleInput -> Bool
== :: SimpleInput -> SimpleInput -> Bool
$c== :: SimpleInput -> SimpleInput -> Bool
Eq, Int -> SimpleInput -> ShowS
[SimpleInput] -> ShowS
SimpleInput -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimpleInput] -> ShowS
$cshowList :: [SimpleInput] -> ShowS
show :: SimpleInput -> String
$cshow :: SimpleInput -> String
showsPrec :: Int -> SimpleInput -> ShowS
$cshowsPrec :: Int -> SimpleInput -> ShowS
Show, 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
$cto :: forall x. Rep SimpleInput x -> SimpleInput
$cfrom :: forall x. SimpleInput -> Rep SimpleInput x
Generic, SimpleInput -> ()
forall a. (a -> ()) -> NFData a
rnf :: SimpleInput -> ()
$crnf :: 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
_ PubKeyI
_)) = 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
_ ScriptOutput
_) = 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
getRegularInput :: !SimpleInput
        }
    | ScriptHashInput
        { -- | get simple input associated with redeem script
          ScriptInput -> SimpleInput
getScriptHashInput :: !SimpleInput
        , -- | redeem script
          ScriptInput -> ScriptOutput
getScriptHashRedeem :: !RedeemScript
        }
    deriving (ScriptInput -> ScriptInput -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptInput -> ScriptInput -> Bool
$c/= :: ScriptInput -> ScriptInput -> Bool
== :: ScriptInput -> ScriptInput -> Bool
$c== :: ScriptInput -> ScriptInput -> Bool
Eq, Int -> ScriptInput -> ShowS
[ScriptInput] -> ShowS
ScriptInput -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptInput] -> ShowS
$cshowList :: [ScriptInput] -> ShowS
show :: ScriptInput -> String
$cshow :: ScriptInput -> String
showsPrec :: Int -> ScriptInput -> ShowS
$cshowsPrec :: Int -> ScriptInput -> ShowS
Show, 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
$cto :: forall x. Rep ScriptInput x -> ScriptInput
$cfrom :: forall x. ScriptInput -> Rep ScriptInput x
Generic, ScriptInput -> ()
forall a. (a -> ()) -> NFData a
rnf :: ScriptInput -> ()
$crnf :: ScriptInput -> ()
NFData)

-- | Heuristic to decode an input script into one of the standard types.
decodeSimpleInput :: Network -> Script -> Either String SimpleInput
decodeSimpleInput :: Network -> Script -> Either String SimpleInput
decodeSimpleInput Network
net (Script [ScriptOp]
ops) =
    forall b a. b -> Maybe a -> Either b a
maybeToEither String
errMsg forall a b. (a -> b) -> a -> b
$ [ScriptOp] -> Maybe SimpleInput
matchPK [ScriptOp]
ops forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [ScriptOp] -> Maybe SimpleInput
matchPKHash [ScriptOp]
ops 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptOp -> Maybe TxSignature
f ScriptOp
op
    matchPK [ScriptOp]
_ = forall a. Maybe a
Nothing
    matchPKHash :: [ScriptOp] -> Maybe SimpleInput
matchPKHash [ScriptOp
op, OP_PUSHDATA ByteString
pub PushDataType
_] =
        TxSignature -> PubKeyI -> SimpleInput
SpendPKHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptOp -> Maybe TxSignature
f ScriptOp
op forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a b. Either a b -> Maybe b
eitherToMaybe (forall a. Get a -> ByteString -> Either String a
runGetS forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize ByteString
pub)
    matchPKHash [ScriptOp]
_ = forall a. Maybe a
Nothing
    matchMulSig :: [ScriptOp] -> Maybe SimpleInput
matchMulSig (ScriptOp
x : [ScriptOp]
xs) = do
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ ScriptOp
x forall a. Eq a => a -> a -> Bool
== ScriptOp
OP_0
        [TxSignature] -> SimpleInput
SpendMulSig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ScriptOp -> Maybe TxSignature
f [ScriptOp]
xs
    matchMulSig [ScriptOp]
_ = forall a. Maybe a
Nothing
    f :: ScriptOp -> Maybe TxSignature
f ScriptOp
OP_0 = 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
_) = forall a b. Either a b -> Maybe b
eitherToMaybe forall a b. (a -> b) -> a -> b
$ Network -> ByteString -> Either String TxSignature
decodeTxSig Network
net ByteString
bs
    f ScriptOp
_ = 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 -> Script -> Either String ScriptInput
decodeInput :: Network -> Script -> Either String ScriptInput
decodeInput Network
net s :: Script
s@(Script [ScriptOp]
ops) =
    forall b a. b -> Maybe a -> Either b a
maybeToEither String
errMsg forall a b. (a -> b) -> a -> b
$ Maybe ScriptInput
matchSimpleInput forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe ScriptInput
matchPayScriptHash
  where
    matchSimpleInput :: Maybe ScriptInput
matchSimpleInput =
        SimpleInput -> ScriptInput
RegularInput forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Either a b -> Maybe b
eitherToMaybe (Network -> Script -> Either String SimpleInput
decodeSimpleInput Network
net Script
s)
    matchPayScriptHash :: Maybe ScriptInput
matchPayScriptHash =
        case forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length (Script -> [ScriptOp]
scriptOps Script
s) forall a. Num a => a -> a -> a
- Int
1) [ScriptOp]
ops of
            ([ScriptOp]
is, [OP_PUSHDATA ByteString
bs PushDataType
_]) -> do
                ScriptOutput
rdm <- forall a b. Either a b -> Maybe b
eitherToMaybe forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ScriptOutput
decodeOutputBS ByteString
bs
                SimpleInput
inp <- forall a b. Either a b -> Maybe b
eitherToMaybe forall a b. (a -> b) -> a -> b
$ Network -> Script -> Either String SimpleInput
decodeSimpleInput Network
net forall a b. (a -> b) -> a -> b
$ [ScriptOp] -> Script
Script [ScriptOp]
is
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SimpleInput -> ScriptOutput -> ScriptInput
ScriptHashInput SimpleInput
inp ScriptOutput
rdm
            ([ScriptOp], [ScriptOp])
_ -> forall a. Maybe a
Nothing
    errMsg :: String
errMsg = String
"decodeInput: Could not decode script input"

{- | Like 'decodeInput' but decodes directly from a serialized script
 'ByteString'.
-}
decodeInputBS :: Network -> ByteString -> Either String ScriptInput
decodeInputBS :: Network -> ByteString -> Either String ScriptInput
decodeInputBS Network
net = Network -> Script -> Either String ScriptInput
decodeInput Network
net forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. Get a -> ByteString -> Either String a
runGetS forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

-- | Encode a standard input into a script.
encodeInput :: ScriptInput -> Script
encodeInput :: ScriptInput -> Script
encodeInput ScriptInput
s = case ScriptInput
s of
    RegularInput SimpleInput
ri -> SimpleInput -> Script
encodeSimpleInput SimpleInput
ri
    ScriptHashInput SimpleInput
i ScriptOutput
o ->
        [ScriptOp] -> Script
Script forall a b. (a -> b) -> a -> b
$
            Script -> [ScriptOp]
scriptOps (SimpleInput -> Script
encodeSimpleInput SimpleInput
i) forall a. [a] -> [a] -> [a]
++ [ByteString -> ScriptOp
opPushData forall a b. (a -> b) -> a -> b
$ ScriptOutput -> ByteString
encodeOutputBS ScriptOutput
o]

{- | Similar to 'encodeInput' but encodes directly to a serialized script
 'ByteString'.
-}
encodeInputBS :: ScriptInput -> ByteString
encodeInputBS :: ScriptInput -> ByteString
encodeInputBS = Put -> ByteString
runPutS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptInput -> Script
encodeInput

-- | Encode a standard 'SimpleInput' into opcodes as an input 'Script'.
encodeSimpleInput :: SimpleInput -> Script
encodeSimpleInput :: SimpleInput -> Script
encodeSimpleInput SimpleInput
s =
    [ScriptOp] -> Script
Script forall a b. (a -> b) -> a -> b
$
        case SimpleInput
s of
            SpendPK TxSignature
ts -> [TxSignature -> ScriptOp
f TxSignature
ts]
            SpendPKHash TxSignature
ts PubKeyI
p -> [TxSignature -> ScriptOp
f TxSignature
ts, ByteString -> ScriptOp
opPushData forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPutS forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize PubKeyI
p]
            SpendMulSig [TxSignature]
xs -> ScriptOp
OP_0 forall a. a -> [a] -> [a]
: 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 forall a b. (a -> b) -> a -> b
$ TxSignature -> ByteString
encodeTxSig TxSignature
ts