easy-bitcoin-0.0.0.2: Network/EasyBitcoin/Script.hs
{-# LANGUAGE DataKinds, ScopedTypeVariables, GeneralizedNewtypeDeriving #-}
module Network.EasyBitcoin.Script
where
import Network.EasyBitcoin.Internal.Script
import Network.EasyBitcoin.Keys
import Network.EasyBitcoin.Internal.Words
import Network.EasyBitcoin.Internal.ByteString
import Network.EasyBitcoin.Internal.Transaction
import Network.EasyBitcoin.Internal.Signatures
import Network.EasyBitcoin.Internal.Keys
import Data.Word
import qualified Data.ByteString as BS
import Data.List (nub) -- not to use nub!! TODO
import Network.EasyBitcoin.Internal.InstanciationHelpers
import Data.Binary (Binary, get, put)
import Data.Binary.Get ( getWord64be
, getWord32be
, getWord8
, getWord16le
, getWord32le
, getByteString
, Get
, isEmpty
)
import Data.Binary.Put( putWord64be
, putWord32be
, putWord32le
, putWord16le
, putWord8
, putByteString
)
import Database.PostgreSQL.Simple.ToField
import Control.Monad (unless, guard,replicateM,forM_,liftM2)
import Control.Applicative((<$>))
import Network.EasyBitcoin.Address
import Network.EasyBitcoin.Internal.HashFunctions
import Network.EasyBitcoin.NetworkParams
import Network.EasyBitcoin.BitcoinUnits
-- | Contains:
-- * number of requiered signatures.
-- * public keys allowed to use for signing.
-- The signature order does matter, it should sign using the keys from the tail of the list
-- till the button, so for eaxample, given @RedeemScript 2 [k_a,k_b,key_c] @,
-- @ signA.signB @ , @ signA.signC @ and @ signB.signC @ would valid combination, but
-- @ signB.signA @ would not.
data RedeemScript net = RedeemScript { numRequired :: Int
, redeemSignatures :: [Key Public net]
} deriving (Eq)
newtype ScriptSig = ScriptSig Script deriving(Eq,Ord,Binary)
instance Show ScriptSig where
show (ScriptSig x) = showAsBinary x
instance Read ScriptSig where
readsPrec n = fmap (\(a,b)->(ScriptSig a,b)) . readsPrecAsBinary n
instance (BlockNetwork net) => Show (RedeemScript net) where
show = showAsBinary
instance (BlockNetwork net) => Read (RedeemScript net) where
readsPrec = readsPrecAsBinary
generalScript (RedeemScript minKeys keys) = Script $ [ op minKeys ]
++ [ opPushData $ serializeCompressedSingleton k | k <- keys]
++ [ op $ length keys, OP_CHECKMULTISIG]
interpret (Script (opMin : rest )) = case splitAt (length rest -2) rest of
(rest_, [opMax,OP_CHECKMULTISIG]) -> do op_min <- opNumber opMin
op_max <- opNumber opMax
compressed <- mapM getPubKeys rest_
if op_max == length rest_ && op_min <= op_max
then return $ RedeemScript op_min compressed
else Nothing
_ -> Nothing
where
getPubKeys scriptOp = do content <- opContent scriptOp
Compressed _ pub <- decodeToMaybe content
return $ ExtendedPub 0 0 0 0 pub
instance Addressable RedeemScript where
address = ScriptAddress . hash160 . hash256BS . encode'
------------------------------------------------------------------------------------------------------------------------------------
encodeOutput :: Address net -> Script
encodeOutput addr = case addr of
PubKeyAddress payload -> Script [ OP_DUP
, OP_HASH160
, opPushData (encode' payload)
, OP_EQUALVERIFY
, OP_CHECKSIG
]
ScriptAddress payload -> Script [ OP_HASH160
, opPushData (encode' payload)
, OP_EQUAL
]
------------------------------------------------------------------------------------------------------------------------------------
encodeInputPayPKH :: TxSignature -> PubKey a -> Script
encodeInputPayPKH ts p = Script $ [ opPushData$encode' ts, opPushData$encode' p]
------------------------------------------------------------------------------------------------------------------------------------
decodeOutput :: forall net. BlockNetwork net => Script -> Maybe (Address net)
decodeOutput (Script script) = case script of
[OP_DUP, OP_HASH160, OP_PUSHDATA payload _, OP_EQUALVERIFY, OP_CHECKSIG]
| Just content <- decodeToMaybe payload -> Just $ PubKeyAddress content
[OP_HASH160, OP_PUSHDATA payload _, OP_EQUAL]
| Just content <- decodeToMaybe payload -> Just $ ScriptAddress content
_ -> Nothing
decodeInput :: forall net. BlockNetwork net => Script -> Maybe (Address net)
decodeInput (Script script) = case script of
[OP_PUSHDATA _ _ , OP_PUSHDATA content _] -> Just . PubKeyAddress . hash160 $ hash256BS content
OP__ 0 : rest
| (OP_PUSHDATA content _: _) <- reverse rest
, Just redeem <- decodeToMaybe content -> Just $address (redeem::RedeemScript net)
_ -> Nothing
-------------------------------------------------------------------------------------------------------------
---------------------------------------------------------------------------------------------------------------
dncodeInputPayPKH :: Script -> Maybe (TxSignature, Key Public a)
dncodeInputPayPKH (Script script) = case script of
[OP_PUSHDATA payload1 _, OP_PUSHDATA payload2 _]
| Just sign <- decodeToMaybe payload1
, Just pubk <- decodeToMaybe payload2 -> Just $ (sign, ExtendedPub 0 0 0 0 pubk)
_ -> Nothing
-------------------------------------------------------------------------------------------------------------
instance (BlockNetwork net) => Binary (RedeemScript net) where
get = get >>= maybe (fail "This script is not an standard multisg redeem script") return . interpret
put = put . generalScript