{-# 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
data ChanParams = ChanParams
{ cpSenderPubKey :: SendPubKey
, cpReceiverPubKey :: RecvPubKey
, 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
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
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]
fromRedeemScript :: Script -> Either String ChanParams
fromRedeemScript (Script
[OP_IF,
OP_PUSHDATA serverPubKeyData OPCODE, OP_CHECKSIGVERIFY,
OP_ELSE,
lockTimeData, OP_NOP2, OP_DROP,
OP_ENDIF,
OP_PUSHDATA clientPubKeyData OPCODE, OP_CHECKSIG])
= ChanParams
<$> deserEither clientPubKeyData
<*> deserEither serverPubKeyData
<*> decodeScriptLocktime lockTimeData
fromRedeemScript _ = Left "Unrecognized redeemScript format"
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
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
getPushBS (OP_PUSHDATA pushBS OPCODE) = Right pushBS
getPushBS OP_0 = Right ""
getPushBS op = Left $ "LockTime: Expected data push, found: " ++ show op