{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Haskoin.Script.Standard
(
ScriptOutput(..)
, RedeemScript
, isPayPK
, isPayPKHash
, isPayMulSig
, isPayScriptHash
, isPayWitnessPKHash
, isPayWitnessScriptHash
, isDataCarrier
, encodeOutput
, encodeOutputBS
, decodeOutput
, decodeOutputBS
, toP2SH
, toP2WSH
, sortMulSig
, 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.Function (on)
import Data.Hashable
import Data.List (sortBy)
import Data.Maybe (fromJust, isJust)
import Data.Serialize as S
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 ScriptOutput
= PayPK { ScriptOutput -> PubKeyI
getOutputPubKey :: !PubKeyI }
| PayPKHash { ScriptOutput -> Hash160
getOutputHash :: !Hash160 }
| PayMulSig { ScriptOutput -> [PubKeyI]
getOutputMulSigKeys :: ![PubKeyI]
, ScriptOutput -> Int
getOutputMulSigRequired :: !Int }
| PayScriptHash { getOutputHash :: !Hash160 }
| PayWitnessPKHash { getOutputHash :: !Hash160 }
| PayWitnessScriptHash { ScriptOutput -> Hash256
getScriptHash :: !Hash256 }
| PayWitness { ScriptOutput -> Word8
getWitnessVersion :: !Word8
, ScriptOutput -> ByteString
getWitnessData :: !ByteString
}
| 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
isPayPK :: ScriptOutput -> Bool
isPayPK :: ScriptOutput -> Bool
isPayPK (PayPK _) = Bool
True
isPayPK _ = Bool
False
isPayPKHash :: ScriptOutput -> Bool
isPayPKHash :: ScriptOutput -> Bool
isPayPKHash (PayPKHash _) = Bool
True
isPayPKHash _ = Bool
False
isPayMulSig :: ScriptOutput -> Bool
isPayMulSig :: ScriptOutput -> Bool
isPayMulSig (PayMulSig _ _) = Bool
True
isPayMulSig _ = Bool
False
isPayScriptHash :: ScriptOutput -> Bool
isPayScriptHash :: ScriptOutput -> Bool
isPayScriptHash (PayScriptHash _) = Bool
True
isPayScriptHash _ = Bool
False
isPayWitnessPKHash :: ScriptOutput -> Bool
isPayWitnessPKHash :: ScriptOutput -> Bool
isPayWitnessPKHash (PayWitnessPKHash _) = Bool
True
isPayWitnessPKHash _ = Bool
False
isPayWitnessScriptHash :: ScriptOutput -> Bool
isPayWitnessScriptHash :: ScriptOutput -> Bool
isPayWitnessScriptHash (PayWitnessScriptHash _) = Bool
True
isPayWitnessScriptHash _ = Bool
False
isPayWitness :: ScriptOutput -> Bool
isPayWitness :: ScriptOutput -> Bool
isPayWitness (PayWitness _ _) = Bool
True
isPayWitness _ = Bool
False
isDataCarrier :: ScriptOutput -> Bool
isDataCarrier :: ScriptOutput -> Bool
isDataCarrier (DataCarrier _) = Bool
True
isDataCarrier _ = Bool
False
decodeOutput :: Script -> Either String ScriptOutput
decodeOutput :: Script -> Either String ScriptOutput
decodeOutput s :: Script
s = case Script -> [ScriptOp]
scriptOps Script
s of
[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
<$> ByteString -> Either String PubKeyI
forall a. Serialize a => ByteString -> Either String a
S.decode ByteString
bs
[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
<$> ByteString -> Either String Hash160
forall a. Serialize a => ByteString -> Either String a
S.decode ByteString
bs
[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
<$> ByteString -> Either String Hash160
forall a. Serialize a => ByteString -> Either String a
S.decode ByteString
bs
[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
<$> ByteString -> Either String Hash160
forall a. Serialize a => ByteString -> Either String a
S.decode 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
<$> ByteString -> Either String Hash256
forall a. Serialize a => ByteString -> Either String a
S.decode ByteString
bs
[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
[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
_ -> 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
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
<=< ByteString -> Either String Script
forall a. Serialize a => ByteString -> Either String a
S.decode
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
(PayPK k :: PubKeyI
k) -> [ByteString -> ScriptOp
opPushData (ByteString -> ScriptOp) -> ByteString -> ScriptOp
forall a b. (a -> b) -> a -> b
$ PubKeyI -> ByteString
forall a. Serialize a => a -> ByteString
S.encode PubKeyI
k, ScriptOp
OP_CHECKSIG]
(PayPKHash h :: Hash160
h) ->
[ ScriptOp
OP_DUP
, ScriptOp
OP_HASH160
, ByteString -> ScriptOp
opPushData (ByteString -> ScriptOp) -> ByteString -> ScriptOp
forall a b. (a -> b) -> a -> b
$ Hash160 -> ByteString
forall a. Serialize a => a -> ByteString
S.encode Hash160
h
, ScriptOp
OP_EQUALVERIFY, ScriptOp
OP_CHECKSIG
]
(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
. PubKeyI -> ByteString
forall a. Serialize a => a -> ByteString
S.encode) [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"
(PayScriptHash h :: Hash160
h) ->
[ ScriptOp
OP_HASH160, ByteString -> ScriptOp
opPushData (ByteString -> ScriptOp) -> ByteString -> ScriptOp
forall a b. (a -> b) -> a -> b
$ Hash160 -> ByteString
forall a. Serialize a => a -> ByteString
S.encode Hash160
h, ScriptOp
OP_EQUAL]
(PayWitnessPKHash h :: Hash160
h) ->
[ ScriptOp
OP_0, ByteString -> ScriptOp
opPushData (ByteString -> ScriptOp) -> ByteString -> ScriptOp
forall a b. (a -> b) -> a -> b
$ Hash160 -> ByteString
forall a. Serialize a => a -> ByteString
S.encode Hash160
h ]
(PayWitnessScriptHash h :: Hash256
h) ->
[ ScriptOp
OP_0, ByteString -> ScriptOp
opPushData (ByteString -> ScriptOp) -> ByteString -> ScriptOp
forall a b. (a -> b) -> a -> b
$ Hash256 -> ByteString
forall a. Serialize a => a -> ByteString
S.encode 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 ]
(DataCarrier d :: ByteString
d) -> [ScriptOp
OP_RETURN, ByteString -> ScriptOp
opPushData ByteString
d]
encodeOutputBS :: ScriptOutput -> ByteString
encodeOutputBS :: ScriptOutput -> ByteString
encodeOutputBS = Script -> ByteString
forall a. Serialize a => a -> ByteString
S.encode (Script -> ByteString)
-> (ScriptOutput -> Script) -> ScriptOutput -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptOutput -> Script
encodeOutput
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
. Script -> ByteString
forall a. Serialize a => a -> ByteString
S.encode
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
. Script -> ByteString
forall a. Serialize a => a -> ByteString
S.encode
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. Serialize 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 (:) (ByteString -> Either String a
forall a. Serialize a => ByteString -> Either String a
S.decode 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"
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` PubKeyI -> ByteString
forall a. Serialize a => a -> ByteString
encode) [PubKeyI]
keys) Int
r
_ -> String -> ScriptOutput
forall a. HasCallStack => String -> a
error "Can only call orderMulSig on PayMulSig scripts"
data SimpleInput = SpendPK
{ SimpleInput -> TxSignature
getInputSig :: !TxSignature
}
| SpendPKHash
{ getInputSig :: !TxSignature
, SimpleInput -> PubKeyI
getInputKey :: !PubKeyI
}
| SpendMulSig
{ SimpleInput -> [TxSignature]
getInputMulSigKeys :: ![TxSignature]
}
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)
isSpendPK :: ScriptInput -> Bool
isSpendPK :: ScriptInput -> Bool
isSpendPK (RegularInput (SpendPK _)) = Bool
True
isSpendPK _ = Bool
False
isSpendPKHash :: ScriptInput -> Bool
isSpendPKHash :: ScriptInput -> Bool
isSpendPKHash (RegularInput (SpendPKHash _ _)) = Bool
True
isSpendPKHash _ = Bool
False
isSpendMulSig :: ScriptInput -> Bool
isSpendMulSig :: ScriptInput -> Bool
isSpendMulSig (RegularInput (SpendMulSig _)) = Bool
True
isSpendMulSig _ = Bool
False
isScriptHashInput :: ScriptInput -> Bool
isScriptHashInput :: ScriptInput -> Bool
isScriptHashInput (ScriptHashInput _ _) = Bool
True
isScriptHashInput _ = Bool
False
type RedeemScript = ScriptOutput
data ScriptInput = RegularInput
{ ScriptInput -> SimpleInput
getRegularInput :: !SimpleInput
}
| ScriptHashInput
{ ScriptInput -> SimpleInput
getScriptHashInput :: !SimpleInput
, ScriptInput -> ScriptOutput
getScriptHashRedeem :: !RedeemScript
}
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)
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 (ByteString -> Either String PubKeyI
forall a. Serialize a => ByteString -> Either String a
decode 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"
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"
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
<=< ByteString -> Either String Script
forall a. Serialize a => ByteString -> Either String a
decode
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]
encodeInputBS :: ScriptInput -> ByteString
encodeInputBS :: ScriptInput -> ByteString
encodeInputBS = Script -> ByteString
forall a. Serialize a => a -> ByteString
encode (Script -> ByteString)
-> (ScriptInput -> Script) -> ScriptInput -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptInput -> Script
encodeInput
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
$ PubKeyI -> ByteString
forall a. Serialize a => a -> ByteString
encode 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