module Network.Haskoin.Script.SigHash
( SigHash(..)
, encodeSigHash32
, isSigAll
, isSigNone
, isSigSingle
, isSigUnknown
, txSigHash
, TxSignature(..)
, encodeSig
, decodeSig
, decodeCanonicalSig
) where
import Control.DeepSeq (NFData, rnf)
import Control.Monad (liftM2, mzero, (<=<))
import Data.Word (Word8)
import Data.Bits (testBit, clearBit)
import Data.Maybe (fromMaybe)
import Data.Binary (Binary, get, put, getWord8, putWord8)
import Data.Aeson (Value(String), FromJSON, ToJSON, parseJSON, toJSON, withText)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
( init
, singleton
, length
, last
, append
, pack
, splitAt
, empty
)
import Data.String.Conversions (cs)
import Network.Haskoin.Crypto.Hash
import Network.Haskoin.Crypto.ECDSA
import Network.Haskoin.Script.Types
import Network.Haskoin.Transaction.Types
import Network.Haskoin.Util
data SigHash
= SigAll { anyoneCanPay :: !Bool }
| SigNone { anyoneCanPay :: !Bool }
| SigSingle { anyoneCanPay :: !Bool }
| SigUnknown { anyoneCanPay :: !Bool
, getSigCode :: !Word8
}
deriving (Eq, Show, Read)
instance NFData SigHash where
rnf (SigAll a) = rnf a
rnf (SigNone a) = rnf a
rnf (SigSingle a) = rnf a
rnf (SigUnknown a c) = rnf a `seq` rnf c
isSigAll :: SigHash -> Bool
isSigAll sh = case sh of
SigAll _ -> True
_ -> False
isSigNone :: SigHash -> Bool
isSigNone sh = case sh of
SigNone _ -> True
_ -> False
isSigSingle :: SigHash -> Bool
isSigSingle sh = case sh of
SigSingle _ -> True
_ -> False
isSigUnknown :: SigHash -> Bool
isSigUnknown sh = case sh of
SigUnknown _ _ -> True
_ -> False
instance Binary SigHash where
get = getWord8 >>= \w ->
let acp = testBit w 7
in return $ case clearBit w 7 of
1 -> SigAll acp
2 -> SigNone acp
3 -> SigSingle acp
_ -> SigUnknown acp w
put sh = putWord8 $ case sh of
SigAll acp -> if acp then 0x81 else 0x01
SigNone acp -> if acp then 0x82 else 0x02
SigSingle acp -> if acp then 0x83 else 0x03
SigUnknown _ w -> w
instance ToJSON SigHash where
toJSON = String . cs . encodeHex . encode'
instance FromJSON SigHash where
parseJSON = withText "sighash" $
maybe mzero return . (decodeToMaybe <=< decodeHex) . cs
encodeSigHash32 :: SigHash -> ByteString
encodeSigHash32 sh = encode' sh `BS.append` BS.pack [0,0,0]
txSigHash :: Tx
-> Script
-> Int
-> SigHash
-> Hash256
txSigHash tx out i sh = do
let newIn = buildInputs (txIn tx) out i sh
fromMaybe one $ do
newOut <- buildOutputs (txOut tx) i sh
let newTx = tx{ txIn = newIn, txOut = newOut }
return $ doubleHash256 $ encode' newTx `BS.append` encodeSigHash32 sh
where
one = "0100000000000000000000000000000000000000000000000000000000000000"
buildInputs :: [TxIn] -> Script -> Int -> SigHash -> [TxIn]
buildInputs txins out i sh
| anyoneCanPay sh = (txins !! i) { scriptInput = encode' out } : []
| isSigAll sh || isSigUnknown sh = single
| otherwise = map noSeq $ zip single [0..]
where
empty = map (\ti -> ti{ scriptInput = BS.empty }) txins
single = updateIndex i empty $ \ti -> ti{ scriptInput = encode' out }
noSeq (ti,j) = if i == j then ti else ti{ txInSequence = 0 }
buildOutputs :: [TxOut] -> Int -> SigHash -> Maybe [TxOut]
buildOutputs txos i sh
| isSigAll sh || isSigUnknown sh = return txos
| isSigNone sh = return []
| i >= length txos = Nothing
| otherwise = return $ buffer ++ [txos !! i]
where
buffer = replicate i $ TxOut (1) BS.empty
data TxSignature = TxSignature
{ txSignature :: !Signature
, sigHashType :: !SigHash
} deriving (Eq, Show, Read)
instance NFData TxSignature where
rnf (TxSignature s h) = rnf s `seq` rnf h
encodeSig :: TxSignature -> ByteString
encodeSig (TxSignature sig sh) = runPut' $ put sig >> put sh
decodeSig :: ByteString -> Either String TxSignature
decodeSig bs = do
let (h, l) = BS.splitAt (BS.length bs 1) bs
liftM2 TxSignature (decodeToEither h) (decodeToEither l)
decodeCanonicalSig :: ByteString -> Either String TxSignature
decodeCanonicalSig bs
| hashtype < 1 || hashtype > 3 =
Left "Non-canonical signature: unknown hashtype byte"
| otherwise =
case decodeStrictSig $ BS.init bs of
Just sig ->
TxSignature sig <$> decodeToEither (BS.singleton $ BS.last bs)
Nothing ->
Left "Non-canonical signature: could not parse signature"
where
hashtype = clearBit (BS.last bs) 7