{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
module PaymentChannel.Internal.ChanScript
( module PaymentChannel.Internal.ChanScript
)
where


import PaymentChannel.Internal.Crypto.PubKey
import PaymentChannel.Internal.Util
import Bitcoin.LockTime.Util
import Bitcoin.Util
import Bitcoin.BIP32
import Bitcoin.Signature
import Network.Haskoin.Script

import qualified Network.Haskoin.Internals as HI
import qualified Network.Haskoin.Crypto as HC
import qualified Data.ByteString as B
import Data.Serialize                 as Bin
import Data.Serialize.Put                 as BinPut


-- |Defines channel: sender, receiver, and expiration date
data ChanParams = ChanParams
  { cpSenderPubKey      ::  SendPubKey
  , cpReceiverPubKey    ::  RecvPubKey
    -- |Channel expiration date/time
  , cpLockTime          ::  LockTimeDate
  } deriving (Eq, Show, Typeable, Generic, NFData)

data UserParams = UserParams
  { upPubKey    :: SendPubKey
  , upLockTime  :: LockTimeDate
  }

instance DerivationSeed UserParams where
    toDerivSeed (UserParams pk lt) =
        BinPut.runPut $ do
            Bin.putWord32be (toWord32 lt)
            Bin.put pk

instance DerivationSeed ChanParams where
    toDerivSeed ChanParams{..} = toDerivSeed $
        UserParams cpSenderPubKey cpLockTime

class HasUserParams a where
    getUserParams :: a -> UserParams

instance HasUserParams UserParams where getUserParams = id
instance HasUserParams ChanParams where
    getUserParams (ChanParams sendPk _ lockTime) =
          UserParams sendPk lockTime

-- | Deterministically derive a server public key from client pubkey+expiration date
deriveRecvPub
    :: HasUserParams up
    => RootPub
    -> up
    -> (ChanParams, External ChildPub)
deriveRecvPub rootPub hup =
    (chanParams, extPub)
  where
    up@UserParams{..} = getUserParams hup
    chanParams = ChanParams upPubKey recvPub upLockTime
    recvPub    = MkRecvPubKey $ getKey extPub
    extPub     = detDerive rootPub up

instance HasSendPubKey ChanParams where
    getSendPubKey = cpSenderPubKey

instance HasRecvPubKey ChanParams where
    getRecvPubKey = cpReceiverPubKey

instance ToJSON ChanParams where
    toJSON = String . serHex . getRedeemScript

instance FromJSON ChanParams where
    parseJSON = withText "RedeemScriptHex" $
        deserHex >=> either fail return . fromRedeemScript

instance Serialize ChanParams where
    put (ChanParams pks pkr lt) =
        put pks >> put pkr >> put lt
    get = ChanParams <$> get <*> get <*> get

instance HasLockTimeDate ChanParams where
    getLockTimeDate = cpLockTime

-- |Generate OP_CHECKLOCKTIMEVERIFY redeemScript, which can be redeemed in two ways:
--  1) by providing a signature from both server and client
--  2) after the date specified by lockTime: by providing only a client signature
getRedeemScript :: ChanParams -> Script
getRedeemScript ChanParams{..} =
    let
        serverPubKey    = getPubKey cpReceiverPubKey
        clientPubKey    = getPubKey cpSenderPubKey
    in Script
             [OP_IF,
                 opPushData $ serialize serverPubKey, OP_CHECKSIGVERIFY,
             OP_ELSE,
                  encodeScriptLocktime cpLockTime, op_CHECKLOCKTIMEVERIFY, OP_DROP,
             OP_ENDIF,
             opPushData $ serialize clientPubKey, OP_CHECKSIG]

-- |Parse a redeemScript generated by 'mkChannelRedeemScript'
fromRedeemScript :: Script -> Either String ChanParams
fromRedeemScript (Script
            [OP_IF,
                OP_PUSHDATA serverPubKeyData OPCODE, OP_CHECKSIGVERIFY,
            OP_ELSE,
                lockTimeData, OP_NOP2, OP_DROP,    -- OP_NOP2 is OP_CHECKLOCKTIMEVERIFY
            OP_ENDIF,
            OP_PUSHDATA clientPubKeyData OPCODE, OP_CHECKSIG])
    = ChanParams
        <$> deserEither clientPubKeyData
        <*> deserEither serverPubKeyData
        <*> decodeScriptLocktime lockTimeData
fromRedeemScript _ = Left "Unrecognized redeemScript format"


-----Util-----

op_CHECKLOCKTIMEVERIFY = OP_NOP2

scriptToP2SHAddress :: Script -> HC.Address
scriptToP2SHAddress = HC.ScriptAddress . hash160

getP2SHFundingAddress :: ChanParams -> HC.Address
getP2SHFundingAddress = scriptToP2SHAddress . getRedeemScript

getRedeemScriptBS :: ChanParams -> B.ByteString
getRedeemScriptBS = serialize . getRedeemScript

-- Note: HI.encodeInt encodes values up to and including
-- 2^31-1 (maxBound :: Int32) as 4 bytes
-- and values 2^31 to 2^32-1 (maxBound :: Word32) as 5 bytes.
encodeScriptLocktime :: BtcLockTime lt => lt -> ScriptOp
encodeScriptLocktime =
    opPushData . B.pack . HI.cltvEncodeInt . toWord32

decodeScriptLocktime :: forall lt. BtcLockTime lt => ScriptOp -> Either String lt
decodeScriptLocktime op =
    maybe (Left "LockTime: Failed to decode script integer")
        (fmapL show . parseLockTime . fromIntegral) . HI.cltvDecodeInt . B.unpack
        =<< getPushBS op
  where
    -- TODO: Temporary. See https://github.com/haskoin/haskoin/issues/287
    getPushBS (OP_PUSHDATA pushBS OPCODE) = Right pushBS
    getPushBS OP_0 = Right ""
    getPushBS op = Left $ "LockTime: Expected data push, found: " ++ show op