Verify.hs

module PaymentChannel.Internal.Payment.Verify
( paymentValueIncrease
, StateSignature
, _invalidBtcSig
)
where

import PaymentChannel.Internal.Payment.Types as Export
import PaymentChannel.Internal.Error.User
import PaymentChannel.Internal.Error.Internal         (ReceiverError(BadSignatureInState))
import Bitcoin.Compare

import Control.Exception                              (throw)
import Debug.Trace


-- | When we don't have a valid signature for the 'Payment' in the state
--    its signature data will be an 'InvalidSig'. Conversion
--    to a BtcSig is for backwards compatibility with 'payValIncrease' etc.
class StateSignature a where
    checkStateSig  :: Payment a -> Either VerifyError ()
    _btcSigPossiblyFake :: Payment a -> Payment BtcSig    -- ^ For backwards compatibilty with 'payValIncrease' (which doesn't look at signature data)

instance StateSignature BtcSig where
    checkStateSig = singlePairVerifySig 
    _btcSigPossiblyFake = id

instance StateSignature InvalidSig where
    checkStateSig = const $ Right () 
    _btcSigPossiblyFake = mapSigData _invalidBtcSig
        
-- | WARNING: Produces invalid 'BtcSig'
_invalidBtcSig :: InvalidSig -> BtcSig
_invalidBtcSig (MkInvalidSig sh) = BtcSig dummySig sh

-- | Throws 'BadSignatureInState' on invalid in-state payment signature
paymentValueIncrease :: 
       ( MonadTime m
       , StateSignature stateSigData
       ) =>
       PayChanState stateSigData  -- ^ State with old payment
    -> Payment BtcSig             -- ^ New payment
    -> 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    -- ^ Old, in-state payment
    -> Payment BtcSig    -- ^ New payment
    -> 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)
            -- Means sig hash flags differ
            then Left $ show (tx1,tx2) `trace` BadSigHashFlag (bsSigFlag $ getSigData sp2) (bsSigFlag $ getSigData sp1)
            else Right di