{-# 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
    , 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, isNothing)
import           Data.Word              (Word8)
import           GHC.Generics           (Generic)
import           Haskoin.Constants
import           Haskoin.Crypto
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
(ScriptOutput -> ScriptOutput -> Bool)
-> (ScriptOutput -> ScriptOutput -> Bool) -> Eq ScriptOutput
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
(Int -> ScriptOutput -> ShowS)
-> (ScriptOutput -> String)
-> ([ScriptOutput] -> ShowS)
-> Show ScriptOutput
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]
(Int -> ReadS ScriptOutput)
-> ReadS [ScriptOutput]
-> ReadPrec ScriptOutput
-> ReadPrec [ScriptOutput]
-> Read 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. ScriptOutput -> Rep ScriptOutput x)
-> (forall x. Rep ScriptOutput x -> ScriptOutput)
-> Generic ScriptOutput
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, Int -> ScriptOutput -> Int
ScriptOutput -> Int
(Int -> ScriptOutput -> Int)
-> (ScriptOutput -> Int) -> Hashable ScriptOutput
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ScriptOutput -> Int
$chash :: ScriptOutput -> Int
hashWithSalt :: Int -> ScriptOutput -> Int
$chashWithSalt :: Int -> ScriptOutput -> Int
Hashable, ScriptOutput -> ()
(ScriptOutput -> ()) -> NFData ScriptOutput
forall a. (a -> ()) -> NFData a
rnf :: ScriptOutput -> ()
$crnf :: ScriptOutput -> ()
NFData)

instance A.FromJSON ScriptOutput where
    parseJSON :: Value -> Parser ScriptOutput
parseJSON =
        String
-> (Text -> Parser ScriptOutput) -> Value -> Parser ScriptOutput
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText "scriptoutput" ((Text -> Parser ScriptOutput) -> Value -> Parser ScriptOutput)
-> (Text -> Parser ScriptOutput) -> Value -> Parser ScriptOutput
forall a b. (a -> b) -> a -> b
$ \t :: Text
t ->
            (String -> Parser ScriptOutput)
-> (ScriptOutput -> Parser ScriptOutput)
-> Either String ScriptOutput
-> Parser ScriptOutput
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser ScriptOutput
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ScriptOutput -> Parser ScriptOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String ScriptOutput -> Parser ScriptOutput)
-> Either String ScriptOutput -> Parser ScriptOutput
forall a b. (a -> b) -> a -> b
$
            String -> Maybe ByteString -> Either String ByteString
forall b a. b -> Maybe a -> Either b a
maybeToEither "scriptoutput not hex" (Text -> Maybe ByteString
decodeHex Text
t) Either String ByteString
-> (ByteString -> Either String ScriptOutput)
-> Either String ScriptOutput
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 (Text -> Value) -> (ScriptOutput -> Text) -> ScriptOutput -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeHex (ByteString -> Text)
-> (ScriptOutput -> ByteString) -> ScriptOutput -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptOutput -> ByteString
encodeOutputBS
    toEncoding :: ScriptOutput -> Encoding
toEncoding = Text -> Encoding
forall a. Text -> Encoding' a
A.text (Text -> Encoding)
-> (ScriptOutput -> Text) -> ScriptOutput -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
encodeHex (ByteString -> Text)
-> (ScriptOutput -> ByteString) -> ScriptOutput -> Text
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 _) = Bool
True
isPayPK _         = Bool
False

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

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

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

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

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

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

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

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

opWitnessVersion :: ScriptOp -> Maybe Word8
opWitnessVersion :: ScriptOp -> Maybe Word8
opWitnessVersion OP_0  = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 0
opWitnessVersion OP_1  = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 1
opWitnessVersion OP_2  = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 2
opWitnessVersion OP_3  = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 3
opWitnessVersion OP_4  = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 4
opWitnessVersion OP_5  = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 5
opWitnessVersion OP_6  = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 6
opWitnessVersion OP_7  = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 7
opWitnessVersion OP_8  = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 8
opWitnessVersion OP_9  = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 9
opWitnessVersion OP_10 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 10
opWitnessVersion OP_11 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 11
opWitnessVersion OP_12 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 12
opWitnessVersion OP_13 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 13
opWitnessVersion OP_14 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 14
opWitnessVersion OP_15 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 15
opWitnessVersion OP_16 = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just 16
opWitnessVersion _     = Maybe Word8
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 (Script -> Either String ScriptOutput)
-> (ByteString -> Either String Script)
-> ByteString
-> Either String ScriptOutput
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Get Script -> ByteString -> Either String Script
forall a. Get a -> ByteString -> Either String a
runGetS Get Script
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

-- | Computes a 'Script' from a standard 'ScriptOutput'.
encodeOutput :: ScriptOutput -> Script
encodeOutput :: ScriptOutput -> Script
encodeOutput s :: ScriptOutput
s = [ScriptOp] -> Script
Script ([ScriptOp] -> Script) -> [ScriptOp] -> Script
forall a b. (a -> b) -> a -> b
$ case ScriptOutput
s of
    -- Pay to PubKey
    (PayPK k :: PubKeyI
k) -> [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
$ PubKeyI -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize PubKeyI
k, ScriptOp
OP_CHECKSIG]
    -- Pay to PubKey Hash Address
    (PayPKHash h :: 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 ()
serialize Hash160
h
        , ScriptOp
OP_EQUALVERIFY, ScriptOp
OP_CHECKSIG
        ]
    -- Pay to MultiSig Keys
    (PayMulSig ps :: [PubKeyI]
ps r :: Int
r)
      | Int
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [PubKeyI] -> Int
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 (Int -> ScriptOp) -> Int -> ScriptOp
forall a b. (a -> b) -> a -> b
$ [PubKeyI] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [PubKeyI]
ps
            keys :: [ScriptOp]
keys = (PubKeyI -> ScriptOp) -> [PubKeyI] -> [ScriptOp]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> ScriptOp
opPushData (ByteString -> ScriptOp)
-> (PubKeyI -> ByteString) -> PubKeyI -> ScriptOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS (Put -> ByteString) -> (PubKeyI -> Put) -> PubKeyI -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKeyI -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize) [PubKeyI]
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 "encodeOutput: PayMulSig r must be <= than pkeys"
    -- Pay to Script Hash Address
    (PayScriptHash h :: 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 ()
serialize Hash160
h, ScriptOp
OP_EQUAL]
    -- Pay to Witness PubKey Hash Address
    (PayWitnessPKHash h :: 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 ()
serialize Hash160
h ]
    (PayWitnessScriptHash h :: 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 ()
serialize Hash256
h ]
    (PayWitness v :: Word8
v h :: ByteString
h) ->
        [ case Word8 -> Maybe ScriptOp
witnessVersionOp Word8
v of
              Nothing -> String -> ScriptOp
forall a. HasCallStack => String -> a
error "encodeOutput: invalid witness version"
              Just c :: ScriptOp
c  -> ScriptOp
c
        , ByteString -> ScriptOp
opPushData ByteString
h ]
    -- Provably unspendable output
    (DataCarrier d :: 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 (Put -> ByteString)
-> (ScriptOutput -> Put) -> ScriptOutput -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Script -> Put) -> (ScriptOutput -> Script) -> ScriptOutput -> Put
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 (Hash160 -> ScriptOutput)
-> (Script -> Hash160) -> Script -> ScriptOutput
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 ()
serialize

-- | Encode script as a pay-to-witness-script-hash script
toP2WSH :: Script -> ScriptOutput
toP2WSH :: Script -> ScriptOutput
toP2WSH = Hash256 -> ScriptOutput
PayWitnessScriptHash (Hash256 -> ScriptOutput)
-> (Script -> Hash256) -> Script -> ScriptOutput
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 ()
serialize

-- | Match @[OP_N, PubKey1, ..., PubKeyM, OP_M, OP_CHECKMULTISIG]@
matchPayMulSig :: Script -> Either String ScriptOutput
matchPayMulSig :: Script -> Either String ScriptOutput
matchPayMulSig (Script ops :: [ScriptOp]
ops) = case Int -> [ScriptOp] -> ([ScriptOp], [ScriptOp])
forall a. Int -> [a] -> ([a], [a])
splitAt ([ScriptOp] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ScriptOp]
ops Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2) [ScriptOp]
ops of
    (m :: ScriptOp
m:xs :: [ScriptOp]
xs,[n :: ScriptOp
n,OP_CHECKMULTISIG]) -> do
        (intM :: Int
intM,intN :: 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 (t :: * -> *) a. Foldable t => t a -> Int
length [ScriptOp]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
intN
            then ([PubKeyI] -> Int -> ScriptOutput)
-> Either String [PubKeyI]
-> Either String Int
-> Either String ScriptOutput
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [PubKeyI] -> Int -> ScriptOutput
PayMulSig ([ScriptOp] -> Either String [PubKeyI]
forall a. Serial a => [ScriptOp] -> Either String [a]
go [ScriptOp]
xs) (Int -> Either String Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
intM)
            else String -> Either String ScriptOutput
forall a b. a -> Either a b
Left "matchPayMulSig: Invalid M or N parameters"
    _ -> String -> Either String ScriptOutput
forall a b. a -> Either a b
Left "matchPayMulSig: script did not match output template"
  where
    go :: [ScriptOp] -> Either String [a]
go (OP_PUSHDATA bs :: ByteString
bs _:xs :: [ScriptOp]
xs) = (a -> [a] -> [a])
-> Either String a -> Either String [a] -> Either String [a]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) (Get a -> ByteString -> Either String a
forall a. Get a -> ByteString -> Either String a
runGetS Get a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize ByteString
bs) ([ScriptOp] -> Either String [a]
go [ScriptOp]
xs)
    go []                    = [a] -> Either String [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    go  _                    = String -> Either String [a]
forall a b. a -> Either a b
Left "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 out :: ScriptOutput
out = case ScriptOutput
out of
    PayMulSig keys :: [PubKeyI]
keys r :: Int
r -> [PubKeyI] -> Int -> ScriptOutput
PayMulSig ((PubKeyI -> PubKeyI -> Ordering) -> [PubKeyI] -> [PubKeyI]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ByteString -> ByteString -> Ordering)
-> (PubKeyI -> ByteString) -> PubKeyI -> PubKeyI -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Put -> ByteString
runPutS (Put -> ByteString) -> (PubKeyI -> Put) -> PubKeyI -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKeyI -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize)) [PubKeyI]
keys) Int
r
    _                -> String -> ScriptOutput
forall a. HasCallStack => String -> a
error "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
    { SimpleInput -> TxSignature
getInputSig :: !TxSignature
    -- ^ transaction signature
    }
    | SpendPKHash
    { getInputSig :: !TxSignature
    -- ^ embedded signature
    , SimpleInput -> PubKeyI
getInputKey :: !PubKeyI
    -- ^ public key
    }
    | SpendMulSig
    { SimpleInput -> [TxSignature]
getInputMulSigKeys :: ![TxSignature]
    -- ^ list of signatures
    }
    deriving (SimpleInput -> SimpleInput -> Bool
(SimpleInput -> SimpleInput -> Bool)
-> (SimpleInput -> SimpleInput -> Bool) -> Eq SimpleInput
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
(Int -> SimpleInput -> ShowS)
-> (SimpleInput -> String)
-> ([SimpleInput] -> ShowS)
-> Show SimpleInput
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. 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
$cto :: forall x. Rep SimpleInput x -> SimpleInput
$cfrom :: forall x. SimpleInput -> Rep SimpleInput x
Generic, SimpleInput -> ()
(SimpleInput -> ()) -> NFData 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 _)) = Bool
True
isSpendPK _                          = 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 _ _)) = Bool
True
isSpendPKHash _                                = Bool
False

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

-- | Returns true if the input script is spending a pay-to-script-hash output.
isScriptHashInput :: ScriptInput -> Bool
isScriptHashInput :: ScriptInput -> Bool
isScriptHashInput (ScriptHashInput _ _) = Bool
True
isScriptHashInput _                     = 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
    { ScriptInput -> SimpleInput
getRegularInput :: !SimpleInput
    -- ^ get wrapped simple input
    }
    | ScriptHashInput
    { ScriptInput -> SimpleInput
getScriptHashInput  :: !SimpleInput
    -- ^ get simple input associated with redeem script
    , ScriptInput -> ScriptOutput
getScriptHashRedeem :: !RedeemScript
    -- ^ redeem script
    }
    deriving (ScriptInput -> ScriptInput -> Bool
(ScriptInput -> ScriptInput -> Bool)
-> (ScriptInput -> ScriptInput -> Bool) -> Eq ScriptInput
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
(Int -> ScriptInput -> ShowS)
-> (ScriptInput -> String)
-> ([ScriptInput] -> ShowS)
-> Show ScriptInput
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. 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
$cto :: forall x. Rep ScriptInput x -> ScriptInput
$cfrom :: forall x. ScriptInput -> Rep ScriptInput x
Generic, ScriptInput -> ()
(ScriptInput -> ()) -> NFData 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 net :: Network
net (Script ops :: [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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [ScriptOp] -> Maybe SimpleInput
matchPKHash [ScriptOp]
ops Maybe SimpleInput -> Maybe SimpleInput -> Maybe SimpleInput
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [ScriptOp] -> Maybe SimpleInput
matchMulSig [ScriptOp]
ops
  where
    matchPK :: [ScriptOp] -> Maybe SimpleInput
matchPK [op :: 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 _    = Maybe SimpleInput
forall a. Maybe a
Nothing
    matchPKHash :: [ScriptOp] -> Maybe SimpleInput
matchPKHash [op :: ScriptOp
op, OP_PUSHDATA pub :: ByteString
pub _] =
        TxSignature -> PubKeyI -> SimpleInput
SpendPKHash (TxSignature -> PubKeyI -> SimpleInput)
-> Maybe TxSignature -> Maybe (PubKeyI -> SimpleInput)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptOp -> Maybe TxSignature
f ScriptOp
op Maybe (PubKeyI -> SimpleInput)
-> Maybe PubKeyI -> Maybe SimpleInput
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either String PubKeyI -> Maybe PubKeyI
forall a b. Either a b -> Maybe b
eitherToMaybe (Get PubKeyI -> ByteString -> Either String PubKeyI
forall a. Get a -> ByteString -> Either String a
runGetS Get PubKeyI
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize ByteString
pub)
    matchPKHash _ = Maybe SimpleInput
forall a. Maybe a
Nothing
    matchMulSig :: [ScriptOp] -> Maybe SimpleInput
matchMulSig (x :: ScriptOp
x:xs :: [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)
mapM ScriptOp -> Maybe TxSignature
f [ScriptOp]
xs
    matchMulSig _ = Maybe SimpleInput
forall a. Maybe a
Nothing
    f :: ScriptOp -> Maybe TxSignature
f OP_0                    = TxSignature -> Maybe TxSignature
forall (m :: * -> *) a. Monad m => a -> m a
return TxSignature
TxSignatureEmpty
    f (OP_PUSHDATA "" OPCODE) = ScriptOp -> Maybe TxSignature
f ScriptOp
OP_0
    f (OP_PUSHDATA bs :: ByteString
bs _)      = 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 -> ByteString -> Either String TxSignature
decodeTxSig Network
net ByteString
bs
    f _                       = Maybe TxSignature
forall a. Maybe a
Nothing
    errMsg :: String
errMsg = "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 net :: Network
net s :: Script
s@(Script ops :: [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 (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 -> Script -> Either String SimpleInput
decodeSimpleInput Network
net Script
s)
    matchPayScriptHash :: Maybe ScriptInput
matchPayScriptHash =
        case Int -> [ScriptOp] -> ([ScriptOp], [ScriptOp])
forall a. Int -> [a] -> ([a], [a])
splitAt ([ScriptOp] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Script -> [ScriptOp]
scriptOps Script
s) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) [ScriptOp]
ops of
            (is :: [ScriptOp]
is, [OP_PUSHDATA bs :: ByteString
bs _]) -> do
                ScriptOutput
rdm <- Either String ScriptOutput -> Maybe ScriptOutput
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String ScriptOutput -> Maybe ScriptOutput)
-> Either String ScriptOutput -> Maybe ScriptOutput
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ScriptOutput
decodeOutputBS 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 -> Script -> Either String SimpleInput
decodeSimpleInput Network
net (Script -> Either String SimpleInput)
-> Script -> Either String SimpleInput
forall a b. (a -> b) -> a -> b
$ [ScriptOp] -> Script
Script [ScriptOp]
is
                ScriptInput -> Maybe ScriptInput
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptInput -> Maybe ScriptInput)
-> ScriptInput -> Maybe ScriptInput
forall a b. (a -> b) -> a -> b
$ SimpleInput -> ScriptOutput -> ScriptInput
ScriptHashInput SimpleInput
inp ScriptOutput
rdm
            _ -> Maybe ScriptInput
forall a. Maybe a
Nothing
    errMsg :: String
errMsg = "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 net :: Network
net = Network -> Script -> Either String ScriptInput
decodeInput Network
net (Script -> Either String ScriptInput)
-> (ByteString -> Either String Script)
-> ByteString
-> Either String ScriptInput
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Get Script -> ByteString -> Either String Script
forall a. Get a -> ByteString -> Either String a
runGetS Get Script
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

-- | Encode a standard input into a script.
encodeInput :: ScriptInput -> Script
encodeInput :: ScriptInput -> Script
encodeInput s :: ScriptInput
s = case ScriptInput
s of
    RegularInput ri :: SimpleInput
ri -> SimpleInput -> Script
encodeSimpleInput SimpleInput
ri
    ScriptHashInput i :: SimpleInput
i o :: ScriptOutput
o -> [ScriptOp] -> Script
Script ([ScriptOp] -> Script) -> [ScriptOp] -> Script
forall a b. (a -> b) -> a -> b
$
        Script -> [ScriptOp]
scriptOps (SimpleInput -> Script
encodeSimpleInput SimpleInput
i) [ScriptOp] -> [ScriptOp] -> [ScriptOp]
forall a. [a] -> [a] -> [a]
++ [ByteString -> ScriptOp
opPushData (ByteString -> ScriptOp) -> ByteString -> ScriptOp
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 (Put -> ByteString)
-> (ScriptInput -> Put) -> ScriptInput -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Script -> Put) -> (ScriptInput -> Script) -> ScriptInput -> Put
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 s :: SimpleInput
s =
    [ScriptOp] -> Script
Script ([ScriptOp] -> Script) -> [ScriptOp] -> Script
forall a b. (a -> b) -> a -> b
$
    case SimpleInput
s of
        SpendPK ts :: TxSignature
ts       -> [TxSignature -> ScriptOp
f TxSignature
ts]
        SpendPKHash ts :: TxSignature
ts p :: PubKeyI
p -> [TxSignature -> ScriptOp
f TxSignature
ts, 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
$ PubKeyI -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize PubKeyI
p]
        SpendMulSig xs :: [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 TxSignatureEmpty = ScriptOp
OP_0
    f ts :: TxSignature
ts               = ByteString -> ScriptOp
opPushData (ByteString -> ScriptOp) -> ByteString -> ScriptOp
forall a b. (a -> b) -> a -> b
$ TxSignature -> ByteString
encodeTxSig TxSignature
ts