module PaymentChannel.Internal.Payment.Verify
( paymentValueIncrease
, StateSignature
, _invalidBtcSig
)
where
import Bitcoin.Compare
import PaymentChannel.Internal.Error.Internal (ReceiverError (BadSignatureInState))
import PaymentChannel.Internal.Error.User
import PaymentChannel.Internal.Payment.Types as Export
import Control.Exception (throw)
import Debug.Trace
class StateSignature a where
checkStateSig :: Payment a -> Either VerifyError ()
_btcSigPossiblyFake :: Payment a -> Payment BtcSig
instance StateSignature BtcSig where
checkStateSig = singlePairVerifySig
_btcSigPossiblyFake = id
instance StateSignature InvalidSig where
checkStateSig = const $ Right ()
_btcSigPossiblyFake = mapSigData _invalidBtcSig
_invalidBtcSig :: InvalidSig -> BtcSig
_invalidBtcSig (MkInvalidSig sh) = BtcSig dummySig sh
paymentValueIncrease ::
( MonadTime m
, StateSignature stateSigData
) =>
PayChanState stateSigData
-> Payment BtcSig
-> m (Either PayChanError BtcAmount)
paymentValueIncrease state newPayment = do
let settlePeriod = runConfM (pcsSettings state) confSettlePeriod
fundingLocked <- fundingIsLocked (toSeconds settlePeriod) newPayment
return $
if fundingLocked
then checkedPayVal (pcsPayment state) newPayment
else Left ChannelExpired
where
checkedPayVal statePayment payment = do
valRecvd <- payValIncrease (_btcSigPossiblyFake statePayment) payment
fmapL (const $ throw BadSignatureInState) (checkStateSig statePayment)
_ <- fmapL (const SigVerifyFailed) (singlePairVerifySig payment)
return valRecvd
payValIncrease ::
Payment BtcSig
-> Payment BtcSig
-> Either PayChanError BtcAmount
payValIncrease sp1 sp2 =
comparePayments sp1 sp2 >>=
\res -> case res of
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)
isLastPayment = (== nullAmount) . btcAmount . singleOutput
eqIgnoreVal di
| eqIgnoreOutVal (IgnoreSigData tx1) (IgnoreSigData tx2) = Right di
| otherwise =
if isLastPayment sp2
then Right di
else Left $ BadSigHashFlag (bsSigFlag $ getSigData sp2) (bsSigFlag $ getSigData sp1)