bitcoin-payment-channel-1.0.0.0: src/PaymentChannel/Internal/Payment/Verify.hs
module PaymentChannel.Internal.Payment.Verify
(
paymentValueIncrease
)
where
import PaymentChannel.Internal.Payment.Types as Export
import PaymentChannel.Internal.Error.User
-- import RBPCP.Types
import PaymentChannel.Internal.RBPCP.Parse
import PaymentChannel.Internal.Types
import PaymentChannel.Internal.ChanScript
import Bitcoin.Util
import Bitcoin.SinglePair
import Bitcoin.Compare
import PaymentChannel.Internal.Util
import qualified Network.Haskoin.Transaction as HT
import qualified Network.Haskoin.Crypto as HC
import qualified Network.Haskoin.Script as HS
import qualified Data.List.NonEmpty as NE
paymentValueIncrease :: MonadTime m =>
Payment BtcSig
-> Payment BtcSig
-> m (Either PayChanError BtcAmount)
paymentValueIncrease sp1 sp2 = do
fundingLocked <- fundingIsLocked sp2
if fundingLocked then return checkedPayVal else return $ Left ChannelExpired
where
checkedPayVal = do
valRecvd <- payValIncrease sp1 sp2
_ <- fmapL (const SigVerifyFailed) (singlePairVerifySig sp2)
return valRecvd
payValIncrease ::
Payment BtcSig
-> Payment BtcSig
-> Either PayChanError BtcAmount
payValIncrease sp1 sp2 =
comparePayments sp1 sp2 >>=
\res -> case res of
-- Inspect change in client change value.
-- A decrease in client change value is an increase in value to us.
DiffInfo [(_, Decrease val)] -> Right val
DiffInfo [(_, NoChange)] -> Right 0
DiffInfo [(_, Increase val)] -> Left $ BadPaymentValue val
DiffInfo x -> error $ "Not exactly one output in a 'Payment': " ++ show x
comparePayments ::
Payment BtcSig
-> Payment BtcSig
-> Either PayChanError DiffInfo
comparePayments sp1 sp2 =
fmapL PaymentError (valueDiff tx1 tx2) >>= eqIgnoreVal
where
(tx1,tx2) = (toBtcTx sp1, toBtcTx sp2)
eqIgnoreVal di =
if not $ eqIgnoreOutVal (IgnoreSigData tx1) (IgnoreSigData tx2)
then Left BadSigHashFlag -- Means sig hash flags differ
else Right di