{-# LANGUAGE OverloadedStrings #-}
module Network.Haskoin.Script.Standard
( ScriptInput(..)
, SimpleInput(..)
, RedeemScript
, encodeInput
, encodeInputBS
, decodeInput
, decodeInputBS
, sortMulSig
, scriptOpToInt
, isSpendPK
, isSpendPKHash
, isSpendMulSig
, isScriptHashInput
) where
import Control.Applicative ((<|>))
import Control.Monad (guard, (<=<))
import Data.ByteString (ByteString)
import Data.Function (on)
import Data.List (sortBy)
import Data.Serialize (decode, encode)
import Network.Haskoin.Constants
import Network.Haskoin.Keys.Common
import Network.Haskoin.Script.Common
import Network.Haskoin.Script.SigHash
import Network.Haskoin.Util
data SimpleInput
= SpendPK { getInputSig :: !TxSignature
}
| SpendPKHash { getInputSig :: !TxSignature
, getInputKey :: !PubKeyI
}
| SpendMulSig { getInputMulSigKeys :: ![TxSignature]
}
deriving (Eq, Show)
isSpendPK :: ScriptInput -> Bool
isSpendPK (RegularInput (SpendPK _)) = True
isSpendPK _ = False
isSpendPKHash :: ScriptInput -> Bool
isSpendPKHash (RegularInput (SpendPKHash _ _)) = True
isSpendPKHash _ = False
isSpendMulSig :: ScriptInput -> Bool
isSpendMulSig (RegularInput (SpendMulSig _)) = True
isSpendMulSig _ = False
isScriptHashInput :: ScriptInput -> Bool
isScriptHashInput (ScriptHashInput _ _) = True
isScriptHashInput _ = False
type RedeemScript = ScriptOutput
data ScriptInput
= RegularInput {
getRegularInput :: SimpleInput
}
| ScriptHashInput {
getScriptHashInput :: SimpleInput
, getScriptHashRedeem :: RedeemScript
}
deriving (Eq, Show)
decodeSimpleInput :: Network -> Script -> Either String SimpleInput
decodeSimpleInput net (Script ops) =
maybeToEither errMsg $ matchPK ops <|> matchPKHash ops <|> matchMulSig ops
where
matchPK [op] = SpendPK <$> f op
matchPK _ = Nothing
matchPKHash [op, OP_PUSHDATA pub _] =
SpendPKHash <$> f op <*> eitherToMaybe (decode pub)
matchPKHash _ = Nothing
matchMulSig (x:xs) = do
guard $ x == OP_0
SpendMulSig <$> mapM f xs
matchMulSig _ = Nothing
f OP_0 = return TxSignatureEmpty
f (OP_PUSHDATA "" OPCODE) = f OP_0
f (OP_PUSHDATA bs _) = eitherToMaybe $ decodeTxSig net bs
f _ = Nothing
errMsg = "decodeInput: Could not decode script input"
decodeInput :: Network -> Script -> Either String ScriptInput
decodeInput net s@(Script ops) =
maybeToEither errMsg $ matchSimpleInput <|> matchPayScriptHash
where
matchSimpleInput =
RegularInput <$> eitherToMaybe (decodeSimpleInput net s)
matchPayScriptHash =
case splitAt (length (scriptOps s) - 1) ops of
(is, [OP_PUSHDATA bs _]) -> do
rdm <- eitherToMaybe $ decodeOutputBS bs
inp <- eitherToMaybe $ decodeSimpleInput net $ Script is
return $ ScriptHashInput inp rdm
_ -> Nothing
errMsg = "decodeInput: Could not decode script input"
decodeInputBS :: Network -> ByteString -> Either String ScriptInput
decodeInputBS net = decodeInput net <=< decode
encodeInput :: ScriptInput -> Script
encodeInput s = case s of
RegularInput ri -> encodeSimpleInput ri
ScriptHashInput i o -> Script $
scriptOps (encodeSimpleInput i) ++ [opPushData $ encodeOutputBS o]
encodeInputBS :: ScriptInput -> ByteString
encodeInputBS = encode . encodeInput
encodeSimpleInput :: SimpleInput -> Script
encodeSimpleInput s =
Script $
case s of
SpendPK ts -> [f ts]
SpendPKHash ts p -> [f ts, opPushData $ encode p]
SpendMulSig xs -> OP_0 : map f xs
where
f TxSignatureEmpty = OP_0
f ts = opPushData $ encodeTxSig ts
sortMulSig :: ScriptOutput -> ScriptOutput
sortMulSig out = case out of
PayMulSig keys r -> PayMulSig (sortBy (compare `on` encode) keys) r
_ -> error "Can only call orderMulSig on PayMulSig scripts"