module PaymentChannel.Client
( validFundingInfo
, channelWithInitialPayment
, createPayment
, createPaymentCapped
, createClosingPayment
, getRefundBitcoinTx
, RefundTx
)
where

import PaymentChannel.Server                            (getSettlementBitcoinTx)
import PaymentChannel.Internal.Payment
import PaymentChannel.Internal.Receiver.Util
import Bitcoin.Util                                     (calcTxSize)
import PaymentChannel.Internal.Refund                   (RefundTx, mkRefundTx)
import PaymentChannel.Types
import Data.Functor.Identity                            (Identity(..))
import Control.Exception                                (Exception, throw)
import qualified RBPCP.Types                            as RBPCP
import qualified  Network.Haskoin.Crypto                as HC
import qualified  Network.Haskoin.Transaction           as HT


data ChannelCreationError
  = FundingError CreationError          -- ^ Invalid funding output or dusty funding amount
  | InsufficientFundingValue BtcAmount  -- ^ Insufficient funding value to pay server-defined "open price"
  | BadServerFundingAddress (ExpectFail HC.Address)

instance Exception ChannelCreationError
instance Show ChannelCreationError where
    show (FundingError e) = unwords
        [ "Funding error:"
        , show e
        ]
    show (InsufficientFundingValue val) = unwords
        [ "Insufficient funding value to pay server-defined 'open price' of"
        , show val
        ]
    show (BadServerFundingAddress expec) = unwords
        [ "Disagreement on channel funding address.", show expec ]

validFundingInfo
    :: SendPubKey
    -> LockTimeDate
    -> RBPCP.FundingInfo
    -> Either ChannelCreationError ChanParams
validFundingInfo sendPK lockTime RBPCP.FundingInfo{..} =
    if correctAddress /= serversAddress
        then Left $ BadServerFundingAddress $ serversAddress `FoundButExpected` correctAddress
        else Right chanParams
  where
    serversAddress = fundingInfoFundingAddressCopy
    getServerKey (RBPCP.Server pk) = pk
    correctAddress = getP2SHFundingAddress chanParams
    chanParams = ChanParams
            sendPK
            (MkRecvPubKey $ getServerKey fundingInfoServerPubkey)
            lockTime

channelWithInitialPayment
    :: HC.PrvKeyC
    -- ^ Client private key. Its corresponding public key was provided to server when fetching 'RBPCP.FundingInfo'
    -> LockTimeDate
    -- ^ Channel expiration date (was also provided to the server when fetching 'RBPCP.FundingInfo')
    -> (HT.Tx, RBPCP.Vout)
    -- ^ Funding transaction, plus transaction output index to use
    -> RBPCP.FundingInfo
    -- ^ Server-returned funding info
    -> Either ChannelCreationError (ClientPayChanI BtcSig, SignedPayment)
    -- ^ Client state and first payment (or error).
channelWithInitialPayment prvKey expTime fundingTxVout fi@RBPCP.FundingInfo{..} =
    let serverConf = fromFundingInfo fi
        mkPayChanState sp = MkPayChanState sp (fromInitialPayment sp) serverConf
        mkClientChan sp = (MkClientPayChan (mkPayChanState sp) prvKey, sp)
        openPrice = fromIntegral fundingInfoOpenPrice
        clientPK = MkSendPubKey $ HC.derivePubKey prvKey
    in do
        cp <- validFundingInfo clientPK expTime fi
        unsignedPay <- fmapL FundingError $ runConfM serverConf $
                          mkUnsignedPayment cp fundingTxVout (getP2SHFundingAddress cp)
        initialPay <- fmapL (const $ InsufficientFundingValue openPrice) $
                          createPaymentInternal unsignedPay serverConf prvKey (openPrice :: BtcAmount)
        Right $ mkClientChan initialPay

-- |Create new payment of specified value, along with updated state containing this payment.
createPayment ::
       ClientPayChan
    -- ^ Sender state object
    -> BtcAmount
    -- ^ Amount to send
    -> Either BtcError (ClientPayChan, SignedPayment)
    -- ^ Updated sender state & payment
createPayment cpc@MkClientPayChan{..} val = do
    payment <- createPaymentInternal (pcsPayment spcState) (pcsSettings spcState) spcPrvKey val
    Right (updateClientState cpc payment, payment)

updateClientState :: ClientPayChan -> SignedPayment -> ClientPayChan
updateClientState cpc@MkClientPayChan{..} payment =
    cpc { spcState = updatePcs payment }
  where
    updatePcs p = spcState { pcsPayment = p }


-- |Create new payment of, at most, specified value, along with updated state containing this payment.
createPaymentCapped ::
       ClientPayChan
    -- ^ Sender state object
    -> Capped BtcAmount
    -- ^ Maximum amount to send
    -> (ClientPayChan, SignedPayment, BtcAmount)
    -- ^ Updated sender state, payment and actual payment value
createPaymentCapped = createPaymentCappedInternal

-- | Same as 'createPaymentCapped', but accepts a client state without a signature
createPaymentCappedInternal ::
       ClientPayChanI sd
    -> Capped BtcAmount
    -> (ClientPayChan, SignedPayment, BtcAmount)
createPaymentCappedInternal cpc@MkClientPayChan{..} cappedVal =
    let
        newPayment = failOnBug $ createPaymentInternal
            (pcsPayment spcState) (pcsSettings spcState) spcPrvKey cappedVal
        failOnBug (Right newPay) = newPay
        failOnBug (Left e) = error $ "BUG: createPaymentCapped: capped amount math fail: " ++ show e
        realVal = clientChangeVal (pcsPayment spcState) - clientChangeVal newPayment
        updatePcs   p = spcState { pcsPayment = p }
        updateState p = cpc { spcState = updatePcs p }
    in
    (updateState newPayment, newPayment, realVal)

-- |Create new payment of specified value, along with updated state containing this payment.
createPaymentInternal ::
       PaymentValueSpec value
    => Payment sd
    -- ^ Sender state object
    -> ServerSettings
    -> HC.PrvKeyC
    -- ^ Sender private key
    -> value
    -- ^ Amount to send. Either exact ('BtcAmount') or capped ('Capped BtcAmount')
    -> Either BtcError SignedPayment
    -- ^ Payment (+ payment value)
createPaymentInternal oldPayment servSettings prvKey payVal =
    let
        actualPayVal = paymentValue (clientChangeVal oldPayment) servSettings payVal
        paymentE = runConfM servSettings $ createPaymentOfValue
              prvKey (clearSig oldPayment) actualPayVal
        -- BUG: Fail if we supplied the wrong private key to the signing function
        --  (pubkey derived from private key does match client pubkey in 'ChanParams')
        checkSignErr e = if isKeyError e then throw $ Bug e else e
    in
        fmapL checkSignErr paymentE

-- TODO: cleanup
createClosingPayment
    :: (ChangeOutFee fee, HasFee fee )
    => ClientPayChanI BtcSig    -- ^ Client state
    -> HC.Address               -- ^ Client change address
    -> fee                      -- ^ Settlement transaction fee (which equals value of closing payment)
    -> (ClientPayChanI BtcSig, SignedPayment, BtcAmount)
        -- ^ Closed state; closing payment; actual fee (capped to remaining channel value)
createClosingPayment clientState changeAddress fee =
    createPaymentCapped newState (Capped $ absoluteFee 0 (dummySettleTxSize newState actualAmount) fee)
  where
    (newState, _, actualAmount) = createPaymentCappedInternal
          newChangeAddrState (Capped $ absoluteFee 0 (dummySettleTxSize fakeSigNewAddrState (0 :: BtcAmount)) fee)

    dummySettleTxSize cpc' fee' = calcTxSize $ dummyClientSettleTx cpc' fee'
    newChangeAddrState = _setClientChangeAddr clientState changeAddress
    -- ### Dummy
    fakeSigNewAddrState = mapSigData _invalidBtcSig newChangeAddrState
    handleSettleRet (Right dummySettleTx) = dummySettleTx
    handleSettleRet (Left e) = error $ "createClosingPayment. woops: " ++ show e
    dummyAddress = HC.PubKeyAddress "0000000000000000000000000000000000000000"
    dummyClientSettleTx :: ChangeOutFee txFee => ClientPayChan -> txFee -> HT.Tx
    dummyClientSettleTx  cpc txFee = toHaskoinTx . handleSettleRet . runDummy $ getSettlementBitcoinTx
                          (dummyFromClientState cpc) dummyAddress txFee DropDust


-- |Produces a Bitcoin transaction which sends all channel funds back to the sender.
-- Will not be accepted by the Bitcoin network until the expiration time specified in
-- 'ChanParams'. Receiver should be aware of Bitcoin network time drift and the
-- unpreditable nature of finding new blocks.
getRefundBitcoinTx
    :: Monad m
    => HC.PrvKeyC
    -> ChanParams
    -> FundingTxInfo
    -> HC.Address           -- ^ Refund address
    -> SatoshisPerByte      -- ^ Refund transaction fee
    -- ^ Refund Bitcoin transaction.
    -- Error only in case of insufficient value to cover fee
    --  (dust outputs are accepted).
    -> m (Either BtcError RefundTx)
getRefundBitcoinTx =
    mkRefundTx

{-# SPECIALIZE createPaymentInternal :: Payment BtcSig -> ServerSettings -> HC.PrvKeyC -> BtcAmount -> Either BtcError SignedPayment #-}
{-# SPECIALIZE createPaymentInternal :: Payment BtcSig -> ServerSettings -> HC.PrvKeyC -> Capped BtcAmount -> Either BtcError SignedPayment #-}