{-# LANGUAGE DeriveAnyClass #-}
module Bitcoin.SpendCond.Util
( getPrevIns
, singlePrevIn
, PickOutError(..)
, module Bitcoin.Util
)
where
import Bitcoin.Internal.Util
import Bitcoin.SpendCond.Cond
import Bitcoin.Util
import Data.Word (Word32)
import Debug.Trace
import qualified Network.Haskoin.Transaction as HT
getPrevIns :: SpendCondition r =>
HT.Tx
-> r
-> [InputG P2SH r ()]
getPrevIns tx rdmScr =
map mkInput . catMaybes . checkOuts $ libCheckOut
where
mkInput (idx,val) = mkNoSigTxIn (mkPrevOut idx) (fromIntegral val) rdmScr
mkPrevOut = HT.OutPoint (HT.txHash tx)
checkOuts f = zipWith f [0..] (HT.txOut tx)
libCheckOut idx out =
if HT.scriptOutput out == encode (asScript (scriptPubKey rdmScr :: TxOutputScript P2SH))
then Just (idx, HT.outValue out)
else Nothing
haskoinCheckOut idx out =
either (const Nothing) (_checkMatch idx)
(decodeScriptHash (HT.scriptOutput out) >>= \sh -> Right (sh, HT.outValue out))
_checkMatch idx (hash,val) = if hash == _scrHash then Just (idx,val) else Nothing
_scrHash = hash160 $ conditionScript rdmScr
singlePrevIn ::
( Show r
, SpendCondition r
)
=> HT.Tx
-> r
-> Word32
-> Either (PickOutError r) (InputG P2SH r ())
singlePrevIn tx scr i =
let inputOfInterest = (== i) . HT.outPointIndex . btcPrevOut
pickOut =
case filter inputOfInterest $ getPrevIns tx scr of
[] -> Left $ IrrelevantOutput i (HT.txHash tx) scr
[inp] -> Right inp
x -> error $ "getPrevIns: multiple inputs with same prevOutIndex: " ++ show x
in
if i >= fromIntegral (length $ HT.txOut tx)
then Left $ NoSuchOutput i (HT.txHash tx)
else pickOut
data PickOutError r
= NoSuchOutput Word32 HT.TxHash
| IrrelevantOutput Word32 HT.TxHash r
deriving (Eq, Generic, NFData, ToJSON, FromJSON, Serialize)
instance SpendCondition r => Show (PickOutError r) where
show (NoSuchOutput i h) = unwords
[ "no such output:"
, showOut h i
]
show (IrrelevantOutput i h scr) = unwords
[ showOut h i
, "doesn't pay to spendCondition"
, show scr
]
showOut h i = show i ++ ":" ++ cs (encode h)