{-# LANGUAGE DeriveAnyClass #-}
module PaymentChannel.Internal.Receiver.Open
( OpenError(..)
, initialServerState
)
where
import PaymentChannel.Internal.Util
import PaymentChannel.Internal.Receiver.Types
import PaymentChannel.RBPCP.Parse (ParseError, fromPaymentData, parseRedeemScript)
import Bitcoin.SpendCond.Util (singlePrevIn, PickOutError)
import qualified RBPCP.Types as RBPCP
import qualified Network.Haskoin.Transaction as HT
data OpenError
= PickOutError (PickOutError ChanParams)
| ResourcePaymentMismatch HT.Tx HT.TxHash
| FundingTxError ParseError
| FundingTxDustOut BtcAmount
| IncorrectInitialPaymentValue (ExpectFail BtcAmount)
| InsufficientDuration Hour
deriving (Eq, Generic, NFData, ToJSON, FromJSON, Serialize)
initialServerState ::
ServerSettings
-> HT.Tx
-> RBPCP.PaymentData
-> Either OpenError (ServerPayChanG () InvalidSig)
initialServerState cfg@ServerSettings{..} tx pd@RBPCP.PaymentData{..}
| RBPCP.btcTxId paymentDataFundingTxid /= HT.txHash tx =
Left $ ResourcePaymentMismatch tx (RBPCP.btcTxId paymentDataFundingTxid)
| otherwise = do
let rdmScrE = fmapL FundingTxError $ parseRedeemScript pd
mkInput scr = fmapL PickOutError (singlePrevIn tx scr paymentDataFundingVout)
sp <- mkSignedPayment =<< mkInput =<< rdmScrE
brandNewState cfg sp
where
mkSignedPayment input = fmapL FundingTxError $ runConfM cfg $
fromPaymentData (btcInValue input) pd
brandNewState ::
ServerSettings
-> SignedPayment
-> Either OpenError (ServerPayChanG () InvalidSig)
brandNewState cfg@ServerSettings{..} signedPaym = do
let setErr = fmapL (const $ FundingTxDustOut serverConfDustLimit)
newSp <- setErr $ runConfM cfg $ resetClientChangeVal signedPaym
Right $ MkServerPayChan (mkChanState newSp) initialMetadata
where
mkChanState sp = MkPayChanState sp (fromInitialPayment signedPaym) cfg
instance Show OpenError where
show (PickOutError e) = "Incorrect funding output specified: " ++ show e
show (ResourcePaymentMismatch tx h) = unwords
[ "prevOutHash mismatch for payment data/payment resource. resource: "
, show (cs . encode . HT.txHash $ tx :: String)
, "data:"
, show (cs . encode $ h :: String)
]
show (FundingTxError pe) = "funding tx error: " ++ show pe
show (FundingTxDustOut dl) = unwords
["funding output below dust limit of", show dl]
show (IncorrectInitialPaymentValue expec) = unwords
["incorrect initial payment-value.", show expec]
show (InsufficientDuration minDur) = unwords
["insufficient channel duration. expected at least:", show minDur]