diff --git a/bitcoin-payment-channel.cabal b/bitcoin-payment-channel.cabal --- a/bitcoin-payment-channel.cabal +++ b/bitcoin-payment-channel.cabal @@ -1,5 +1,5 @@ name: bitcoin-payment-channel -version: 0.3.0.1 +version: 0.4.0.0 synopsis: Library for working with Bitcoin payment channels description: A Bitcoin payment channel allows secure and instant transfer of bitcoins from one @@ -31,22 +31,23 @@ location: git://github.com/runeksvendsen/bitcoin-payment-channel.git library - exposed-modules: Data.Bitcoin.PaymentChannel, - Data.Bitcoin.PaymentChannel.Types, - Data.Bitcoin.PaymentChannel.Util, + exposed-modules: Data.Bitcoin.PaymentChannel + Data.Bitcoin.PaymentChannel.Types + Data.Bitcoin.PaymentChannel.Util + Data.Bitcoin.PaymentChannel.Movable -- Exposed for testing purposes Data.Bitcoin.PaymentChannel.Internal.State other-modules: Data.Bitcoin.PaymentChannel.Internal.Error - Data.Bitcoin.PaymentChannel.Internal.Payment, - Data.Bitcoin.PaymentChannel.Internal.Refund, - Data.Bitcoin.PaymentChannel.Internal.Bitcoin.Amount, + Data.Bitcoin.PaymentChannel.Internal.Payment + Data.Bitcoin.PaymentChannel.Internal.Refund + Data.Bitcoin.PaymentChannel.Internal.Bitcoin.Amount Data.Bitcoin.PaymentChannel.Internal.Bitcoin.Script - Data.Bitcoin.PaymentChannel.Internal.Bitcoin.Util, - Data.Bitcoin.PaymentChannel.Internal.Bitcoin.LockTime, - Data.Bitcoin.PaymentChannel.Internal.Settlement, - Data.Bitcoin.PaymentChannel.Internal.Types, - Data.Bitcoin.PaymentChannel.Internal.Serialization, + Data.Bitcoin.PaymentChannel.Internal.Bitcoin.Util + Data.Bitcoin.PaymentChannel.Internal.Bitcoin.LockTime + Data.Bitcoin.PaymentChannel.Internal.Settlement + Data.Bitcoin.PaymentChannel.Internal.Types + Data.Bitcoin.PaymentChannel.Internal.Serialization Data.Bitcoin.PaymentChannel.Internal.Util ghc-options: -W @@ -62,7 +63,8 @@ text >= 1.2.0 && < 1.3.0, time >= 1.5.0 && < 1.7.0, aeson >= 0.11.0 && < 0.12.0, - scientific >= 0.3.0 && < 0.4.0 + scientific >= 0.3.0 && < 0.4.0, + string-conversions >= 0.4 && < 0.5 hs-source-dirs: src @@ -77,7 +79,8 @@ haskoin-core >= 0.4.0 && < 1.0.0, bytestring, base16-bytestring, base64-bytestring, - base58string, hexstring, text, + hexstring, text, + string-conversions, time, cereal, aeson, diff --git a/src/Data/Bitcoin/PaymentChannel.hs b/src/Data/Bitcoin/PaymentChannel.hs --- a/src/Data/Bitcoin/PaymentChannel.hs +++ b/src/Data/Bitcoin/PaymentChannel.hs @@ -96,7 +96,7 @@ where import Data.Bitcoin.PaymentChannel.Internal.Types - (PaymentTxConfig(..), Payment(..), pcsValueLeft) + (PaymentTxConfig(..), Payment(..), FullPayment(..), pcsClientChangeVal) import Data.Bitcoin.PaymentChannel.Internal.State (newPaymentChannelState, updatePaymentChannelState) import qualified Data.Bitcoin.PaymentChannel.Internal.State as S @@ -124,10 +124,11 @@ -> (HC.Hash256 -> HC.Signature) -- ^Used to sign payments from sender. When given a 'HC.Hash256', produces a signature that verifies against sender PubKey. -> HC.Address -- ^ Value sender/client change address -> BitcoinAmount -- ^ Value of initial payment. Must be greater than or equal to 'minimumInitialPayment' - -> (BitcoinAmount, Payment, SenderPaymentChannel) -- ^Initial payment amount (may be capped), initial payment, and new sender state object + -> (BitcoinAmount, FullPayment, SenderPaymentChannel) -- ^Initial payment amount (may be capped), initial payment, and new sender state object channelWithInitialPaymentOf cp fundInf signFunc sendAddr amount = let pConf = CPaymentTxConfig sendAddr - (CPayment _ tmpSig) = createPayment cp fundInf sendAddr amount signFunc + (CFullPayment (CPayment _ tmpSig) _ _ _) = + createPayment cp fundInf sendAddr amount signFunc in flip sendPayment amount $ CSenderPaymentChannel (newPaymentChannelState cp fundInf pConf tmpSig) signFunc @@ -136,24 +137,20 @@ sendPayment :: SenderPaymentChannel -- ^Sender state object -> BitcoinAmount -- ^ Amount to send (the actual payment amount is capped so that that, at minimu, the client change value equals the dust limit) - -> (BitcoinAmount, Payment, SenderPaymentChannel) -- ^ Actual amount sent, payment, and updated sender state object + -> (BitcoinAmount, FullPayment, SenderPaymentChannel) -- ^ Actual amount sent, payment, and updated sender state object sendPayment (CSenderPaymentChannel cs signFunc) amountToSend = let - valSent = pcsValueLeft cs - newSenderValue - newSenderValue = max (S.pcsDustLimit cs) (pcsValueLeft cs - amountToSend) - payment = paymentFromState cs newSenderValue signFunc + valSent = pcsClientChangeVal cs - newSenderValue + newSenderValue = max (S.pcsDustLimit cs) (pcsClientChangeVal cs - amountToSend) + fullPay = paymentFromState cs newSenderValue signFunc in - case updatePaymentChannelState cs payment of + case updatePaymentChannelState cs fullPay of Right newCS -> (valSent - ,payment + ,fullPay ,CSenderPaymentChannel newCS signFunc) - Left (BadPaymentValue val) -> - error $ "BUG: 'createPayment' created value-backtracking tx of" ++ show val - Left DustOutput -> - error "BUG: 'createPayment' created dust output" - Left e -> - error $ "BUG: 'updatePaymentChannelState' returned unknown error: " ++ show e + Left e -> + error $ "BUG: bad payment" ++ show e -- |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 @@ -175,13 +172,13 @@ ChannelParameters -- ^ Specifies channel sender and receiver, plus channel expiration date -> FundingTxInfo -- ^ Holds information about the transaction used to fund the channel -> HC.Address -- ^ Value sender/client change address - -> Payment -- ^Initial channel payment + -> FullPayment -- ^Initial channel payment -> Either PayChanError (BitcoinAmount, ReceiverPaymentChannel) -- ^Error or: value_received plus state object -channelFromInitialPayment cp fundInf sendAddr payment@(CPayment _ sig) = +channelFromInitialPayment cp fundInf sendAddr fp@(CFullPayment (CPayment _ sig) _ _ _) = let pConf = CPaymentTxConfig sendAddr in - flip recvPayment payment $ CReceiverPaymentChannel + flip recvPayment fp $ CReceiverPaymentChannel -- Create a new state with the unverified signature; then verify the same signature in 'recvPayment' (newPaymentChannelState cp fundInf pConf sig) @@ -190,14 +187,14 @@ -- the amount received with this 'Payment' and a new state object. recvPayment :: ReceiverPaymentChannel -- ^Receiver state object - -> Payment -- ^Payment to verify and register + -> FullPayment -- ^Payment to verify and register -> Either PayChanError (BitcoinAmount, ReceiverPaymentChannel) -- ^Value received plus new receiver state object -recvPayment rpc@(CReceiverPaymentChannel oldState) paymnt = +recvPayment rpc@(CReceiverPaymentChannel oldState) fp@(CFullPayment paymnt _ _ _) = let verifySenderPayment hash pk sig = HC.verifySig hash sig (getPubKey pk) in if verifyPaymentSigFromState oldState verifySenderPayment paymnt then - updatePaymentChannelState oldState paymnt >>= + updatePaymentChannelState oldState fp >>= (\newState -> Right ( S.channelValueLeft oldState - S.channelValueLeft newState , rpc { rpcState = newState }) diff --git a/src/Data/Bitcoin/PaymentChannel/Internal/Bitcoin/Script.hs b/src/Data/Bitcoin/PaymentChannel/Internal/Bitcoin/Script.hs --- a/src/Data/Bitcoin/PaymentChannel/Internal/Bitcoin/Script.hs +++ b/src/Data/Bitcoin/PaymentChannel/Internal/Bitcoin/Script.hs @@ -1,4 +1,4 @@ --- {-# OPTIONS_GHC -fwarn-incomplete-patterns -Werror #-} +{-# LANGUAGE OverloadedStrings #-} module Data.Bitcoin.PaymentChannel.Internal.Bitcoin.Script where @@ -8,11 +8,9 @@ import qualified Network.Haskoin.Internals as HI import qualified Network.Haskoin.Crypto as HC -import Network.Haskoin.Script - (Script(..), SigHash(..), ScriptOp(..), opPushData) - import qualified Data.ByteString as B + valReceiverSigHash = SigAll True -- |Generates OP_CHECKLOCKTIMEVERIFY redeemScript, which can be redeemed in two ways: @@ -23,14 +21,19 @@ let -- Note: HI.encodeInt encodes values up to and including 2^31-1 as 4 bytes -- and values 2^31 through 2^32-1 (upper limit) as 5 bytes. - encodeScriptInt = B.pack . HI.encodeInt . fromIntegral . toWord32 + encodeScriptInt = convertEmptyPush . opPushData . B.pack . + HI.encodeInt . fromIntegral . toWord32 + -- A push of an empty byte string and OP_0 are one and the same, + -- but haskoin-core deserializes into OP_0. + convertEmptyPush (OP_PUSHDATA "" OPCODE) = OP_0 + convertEmptyPush whatever = whatever serverPubKey = getPubKey serverPK clientPubKey = getPubKey clientPK in Script [OP_IF, opPushData $ serialize serverPubKey, OP_CHECKSIGVERIFY, OP_ELSE, - opPushData $ encodeScriptInt lockTime, op_CHECKLOCKTIMEVERIFY, OP_DROP, + encodeScriptInt $ lockTime, op_CHECKLOCKTIMEVERIFY, OP_DROP, OP_ENDIF, opPushData $ serialize clientPubKey, OP_CHECKSIG] diff --git a/src/Data/Bitcoin/PaymentChannel/Internal/Error.hs b/src/Data/Bitcoin/PaymentChannel/Internal/Error.hs --- a/src/Data/Bitcoin/PaymentChannel/Internal/Error.hs +++ b/src/Data/Bitcoin/PaymentChannel/Internal/Error.hs @@ -1,17 +1,31 @@ +{-# LANGUAGE DeriveGeneric #-} + module Data.Bitcoin.PaymentChannel.Internal.Error where -import Data.Bitcoin.PaymentChannel.Internal.Types (BitcoinAmount) +import Data.Bitcoin.PaymentChannel.Internal.Types +import Data.Bitcoin.PaymentChannel.Internal.Util +import GHC.Generics data PayChanError = SigVerifyFailed | BadPaymentValue BitcoinAmount | - DustOutput | - InternalError String + OutPointMismatch OutPoint | + ChangeAddrMismatch Address | + RedeemScriptMismatch Script | + DustOutput BitcoinAmount | + PartialPaymentBadValue BitcoinAmount + deriving Generic instance Show PayChanError where show SigVerifyFailed = "signature verification failed" show (BadPaymentValue valDiff) = "out-of-order payment (assigns " ++ show valDiff ++ " less value to receiver)" - show DustOutput = "dust output in payment transaction" - show (InternalError e) = "Internal error: " ++ e - + show (OutPointMismatch op) = "unexpected outpoint. expected: " ++ show op + show (ChangeAddrMismatch addr) = "unexpected change address. expected: " ++ show addr + show (RedeemScriptMismatch scr) = "unexpected redeem script. expected: " ++ + cs (serHex scr) + show (PartialPaymentBadValue expVal) = "partial payment change value mismatch." ++ + " payment 1/2 with change value " ++ show expVal ++ + " was accepted, expecting second payment change value to match that." + show (DustOutput limit) = "server dust limit of " ++ show limit ++ + " not respected by client change output" diff --git a/src/Data/Bitcoin/PaymentChannel/Internal/Payment.hs b/src/Data/Bitcoin/PaymentChannel/Internal/Payment.hs --- a/src/Data/Bitcoin/PaymentChannel/Internal/Payment.hs +++ b/src/Data/Bitcoin/PaymentChannel/Internal/Payment.hs @@ -62,7 +62,7 @@ PaymentChannelState -> BitcoinAmount -- ^ sender change value (subtract 'n' from current sender change value to get payment of value 'n') -> (HC.Hash256 -> HC.Signature) -- ^ signing function - -> Payment + -> FullPayment paymentFromState (CPaymentChannelState cp fti (CPaymentTxConfig changeAddr) _ _) = createPayment cp fti changeAddr @@ -73,18 +73,19 @@ -> HC.Address -> BitcoinAmount -- ^ sender change value (subtract 'n' from current sender change value to get payment of value 'n') -> (HC.Hash256 -> HC.Signature) -- ^ signing function - -> Payment --ClientSignedPayment + -> FullPayment createPayment cp (CFundingTxInfo hash idx val) changeAddr changeVal signFunc = let - unsignedPayment = UnsignedPayment + unsignedPayment@(UnsignedPayment op _ script _ _) = UnsignedPayment (HT.OutPoint hash idx) val (getRedeemScript cp) changeAddr changeVal sigHash = if changeVal /= 0 then HS.SigSingle True else HS.SigNone True hashToSign = getHashForSigning unsignedPayment sigHash sig = signFunc hashToSign + payment = CPayment changeVal (CPaymentSignature sig sigHash) in - CPayment changeVal (CPaymentSignature sig sigHash) - -- ClientSignedPayment unsignedPayment (CPaymentSignature sig sigHash) + CFullPayment payment op script changeAddr + verifyPaymentSig :: ChannelParameters diff --git a/src/Data/Bitcoin/PaymentChannel/Internal/Serialization.hs b/src/Data/Bitcoin/PaymentChannel/Internal/Serialization.hs --- a/src/Data/Bitcoin/PaymentChannel/Internal/Serialization.hs +++ b/src/Data/Bitcoin/PaymentChannel/Internal/Serialization.hs @@ -5,11 +5,13 @@ module Data.Bitcoin.PaymentChannel.Internal.Serialization where import Data.Bitcoin.PaymentChannel.Internal.Types -import Data.Bitcoin.PaymentChannel.Internal.Util (deserEither, toHexString) -import Data.Aeson (Value(Number), FromJSON(..), ToJSON(..), withText, withScientific) -import Data.Aeson.Types (Parser) +import Data.Bitcoin.PaymentChannel.Internal.Util +import Data.Bitcoin.PaymentChannel.Internal.Error +import qualified Network.Haskoin.Transaction as HT +import Data.Aeson +import Data.Aeson.Types (Parser, Pair) import Data.Scientific (Scientific, scientific, toBoundedInteger) -import Data.Text.Encoding (decodeLatin1, encodeUtf8) +import Data.Text.Encoding (decodeUtf8, encodeUtf8) import qualified Data.Serialize as Bin import qualified Data.Serialize.Put as BinPut import qualified Data.Serialize.Get as BinGet @@ -20,8 +22,10 @@ import Data.Word (Word64) import Data.EitherR (fmapL) import Data.Typeable - +import Debug.Trace +-- Generic PayChanError instance +instance Bin.Serialize PayChanError --- JSON deriving instance ToJSON SendPubKey @@ -38,11 +42,47 @@ fmap (parseBitcoinLocktime . fromIntegral) . parseJSONInt instance ToJSON Payment where - toJSON = toJSON . txtB64Encode + toJSON = object . toJSONObject -instance FromJSON Payment where - parseJSON = withText "Payment" txtB64Decode +toJSONObject :: Payment -> [Pair] +toJSONObject (CPayment changeVal (CPaymentSignature sig flag)) = + [ "change_value" .= changeVal + , "signature_data" .= String (serHex sig) + , "sighash_flag" .= String (serHex flag) + ] +parseJSONObject :: Object -> Parser Payment +parseJSONObject o = CPayment + <$> o .: "change_value" + <*> (CPaymentSignature <$> + (o .: "signature_data" >>= withText "SigDataHex" deserHex) <*> + (o .: "sighash_flag" >>= withText "SigHashFlagHex" deserHex)) + +instance ToJSON FullPayment where + toJSON CFullPayment { + fpPayment = payment, + fpOutPoint = (HT.OutPoint txid vout), fpRedeemScript = script, + fpChangeAddr = addr } = + object $ + toJSONObject payment ++ + [ "funding_txid" .= txid + , "funding_vout" .= vout + , "redeem_script" .= String (serHex script) + , "change_address" .= addr + ] + +instance FromJSON FullPayment where + parseJSON = withObject "FullPayment" parseFullPayment + +parseFullPayment :: Object -> Parser FullPayment +parseFullPayment o = CFullPayment + <$> parseJSONObject o + <*> (HT.OutPoint <$> + o .: "funding_txid" <*> + o .: "funding_vout") + <*> (o .: "redeem_script" >>= withText "RedeemScriptHex" deserHex) + <*> o .: "change_address" + instance ToJSON BitcoinAmount where toJSON amt = Number $ scientific (fromIntegral $ toInteger amt) 0 @@ -59,18 +99,25 @@ --- Binary +instance Bin.Serialize ChanScript where + put (ChanScript s) = + BinPut.putWord16be scriptBSLen >> + BinPut.putByteString scriptBS + where scriptBS = Bin.encode s + scriptBSLen = fromIntegral $ B.length scriptBS + get = either error ChanScript . Bin.decode <$> + (BinGet.getWord16be >>= + BinGet.getByteString . fromIntegral) + deriving instance Bin.Serialize SendPubKey deriving instance Bin.Serialize RecvPubKey instance Bin.Serialize PaymentChannelState where put (CPaymentChannelState par fti payConf valLeft sig) = - Bin.put par >> Bin.put fti >> Bin.put payConf >> Bin.put valLeft - >> BinPut.putWord8 1 >> Bin.put sig -- Keep the 0x01 Word8 for format backwards compatibility + Bin.put par >> Bin.put fti >> Bin.put payConf >> + Bin.put valLeft >> Bin.put sig get = CPaymentChannelState <$> Bin.get <*> Bin.get <*> - Bin.get <*> Bin.get <*> (BinGet.getWord8 >>= - \w -> case w of - 1 -> Bin.get - _ -> error "empty PaymentChannelState no longer supported") + Bin.get <*> Bin.get <*> Bin.get instance Bin.Serialize ChannelParameters where put (CChannelParameters pks pkr lt dustLimit) = @@ -88,21 +135,31 @@ get = CPaymentTxConfig <$> Bin.get instance Bin.Serialize Payment where - put (CPayment val sig) = Bin.put val >> Bin.put sig + put (CPayment val sig) = + Bin.put val >> Bin.put sig get = CPayment <$> Bin.get <*> Bin.get +instance Bin.Serialize FullPayment where + put (CFullPayment p op script addr) = + Bin.put p >> Bin.put op >> Bin.put (ChanScript script) >> Bin.put addr + get = CFullPayment <$> Bin.get <*> Bin.get <*> fmap getScript Bin.get <*> Bin.get + instance Bin.Serialize PaymentSignature where - put ps = Bin.put (psSig ps) >> - Bin.put (psSigHash ps) + put (CPaymentSignature sig sigHash) = + Bin.put sig >> Bin.put sigHash get = CPaymentSignature <$> Bin.get <*> Bin.get - --- Misc. instance Show Payment where show (CPayment val sig) = "" +instance Show FullPayment where + show (CFullPayment p op script addr) = + "" + -- Needed to convert from Scientific instance Bounded BitcoinAmount where minBound = BitcoinAmount 0 @@ -122,7 +179,7 @@ concatErr e = fmapL (e ++) txtB64Encode :: Bin.Serialize a => a -> T.Text -txtB64Encode = decodeLatin1 . b64Encode +txtB64Encode = decodeUtf8 . b64Encode txtB64Decode :: (Typeable a, Bin.Serialize a) => T.Text -> Parser a txtB64Decode = either fail return . b64Decode . encodeUtf8 diff --git a/src/Data/Bitcoin/PaymentChannel/Internal/State.hs b/src/Data/Bitcoin/PaymentChannel/Internal/State.hs --- a/src/Data/Bitcoin/PaymentChannel/Internal/State.hs +++ b/src/Data/Bitcoin/PaymentChannel/Internal/State.hs @@ -5,14 +5,15 @@ import Data.Bitcoin.PaymentChannel.Internal.Types import Data.Bitcoin.PaymentChannel.Internal.Error import Data.Bitcoin.PaymentChannel.Internal.Util (addressToScriptPubKeyBS) +import Data.Bitcoin.PaymentChannel.Internal.Bitcoin.Script import qualified Network.Haskoin.Transaction as HT import qualified Network.Haskoin.Crypto as HC import qualified Network.Haskoin.Script as HS pcsChannelTotalValue = ftiOutValue . pcsFundingTxInfo -pcsValueTransferred cs = pcsChannelTotalValue cs - pcsValueLeft cs -pcsChannelValueLeft = pcsValueLeft +pcsValueTransferred cs = pcsChannelTotalValue cs - pcsClientChangeVal cs +pcsChannelValueLeft = pcsClientChangeVal pcsClientPubKey = cpSenderPubKey . pcsParameters pcsServerPubKey = cpReceiverPubKey . pcsParameters pcsDustLimit = cpDustLimit . pcsParameters @@ -20,6 +21,7 @@ pcsClientChangeAddress = ptcSenderChangeAddress . pcsPaymentConfig pcsClientChangeScriptPubKey = addressToScriptPubKeyBS . pcsClientChangeAddress pcsLockTime = cpLockTime . pcsParameters +pcsPrevOut (CPaymentChannelState _ (CFundingTxInfo h i _) _ _ _) = OutPoint h i pcsChannelID :: PaymentChannelState -> HT.OutPoint pcsChannelID pcs = HT.OutPoint (ftiHash fti) (ftiOutIndex fti) @@ -37,12 +39,16 @@ pcs { pcsPaymentConfig = newPayConf } where newPayConf = pConf { ptcSenderChangeAddress = addr } --- |We subtract the specified "dust" limit from the total available value, --- in order to avoid creating a Bitcoin transaction that won't circulate +setFundingSource :: PaymentChannelState -> FundingTxInfo -> PaymentChannelState +setFundingSource pcs fti = + pcs { pcsFundingTxInfo = fti } + +-- |We subtract the specified "dust" limit from the total available value. +-- This avoids creating a Bitcoin transaction that won't circulate -- in the Bitcoin P2P network. channelValueLeft :: PaymentChannelState -> BitcoinAmount channelValueLeft pcs@(CPaymentChannelState (CChannelParameters _ _ _ dustLimit) _ _ _ _) = - pcsValueLeft pcs - dustLimit + pcsClientChangeVal pcs - dustLimit -- |Returns 'True' if all available channel value has been transferred, 'False' otherwise channelIsExhausted :: PaymentChannelState -> Bool @@ -55,17 +61,24 @@ pcsParameters = channelParameters, pcsFundingTxInfo = fundingTxInfo, pcsPaymentConfig = paymentConfig, - pcsValueLeft = ftiOutValue fundingTxInfo, + pcsClientChangeVal = ftiOutValue fundingTxInfo, pcsPaymentSignature = paySig } --- |Update state with verified payment. Check value (including dust limit). +-- |Update state with verified payment. updatePaymentChannelState :: PaymentChannelState - -> Payment + -> FullPayment -> Either PayChanError PaymentChannelState -updatePaymentChannelState (CPaymentChannelState cp fun pconf oldSenderVal _) - payment@(CPayment newSenderVal _) +updatePaymentChannelState (CPaymentChannelState cp fun@(CFundingTxInfo h i _) + pconf@(CPaymentTxConfig addr) oldSenderVal _) + (CFullPayment payment@(CPayment newSenderVal _) payOP payScript payChgAddr) + | (HT.outPointHash payOP /= h) || (HT.outPointIndex payOP /= i) = + Left $ OutPointMismatch $ OutPoint h i + | payChgAddr /= addr = + Left $ ChangeAddrMismatch addr + | payScript /= getRedeemScript cp = + Left $ RedeemScriptMismatch $ getRedeemScript cp | newSenderVal <= oldSenderVal = CPaymentChannelState cp fun pconf newSenderVal . cpSignature <$> checkDustLimit cp payment @@ -74,5 +87,5 @@ checkDustLimit :: ChannelParameters -> Payment -> Either PayChanError Payment checkDustLimit (CChannelParameters _ _ _ dustLimit) payment@(CPayment senderChangeVal _) | senderChangeVal < dustLimit = - Left DustOutput + Left $ DustOutput dustLimit | otherwise = Right payment diff --git a/src/Data/Bitcoin/PaymentChannel/Internal/Types.hs b/src/Data/Bitcoin/PaymentChannel/Internal/Types.hs --- a/src/Data/Bitcoin/PaymentChannel/Internal/Types.hs +++ b/src/Data/Bitcoin/PaymentChannel/Internal/Types.hs @@ -1,10 +1,13 @@ --- {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} module Data.Bitcoin.PaymentChannel.Internal.Types ( module Data.Bitcoin.PaymentChannel.Internal.Types , module Data.Bitcoin.PaymentChannel.Internal.Bitcoin.Amount , module Data.Bitcoin.PaymentChannel.Internal.Bitcoin.LockTime + , module Network.Haskoin.Transaction + , module Network.Haskoin.Crypto + , module Network.Haskoin.Script ) where @@ -13,12 +16,15 @@ import Data.Bitcoin.PaymentChannel.Internal.Bitcoin.Amount import Data.Bitcoin.PaymentChannel.Internal.Bitcoin.LockTime -import qualified Network.Haskoin.Transaction as HT -import qualified Network.Haskoin.Crypto as HC -import qualified Network.Haskoin.Script as HS -import Data.Typeable -import Data.Word - +import Network.Haskoin.Transaction +import Network.Haskoin.Crypto +import Network.Haskoin.Script +import qualified Network.Haskoin.Transaction as HT +import qualified Network.Haskoin.Crypto as HC +import qualified Network.Haskoin.Script as HS +import Data.Typeable +import Data.Word +import GHC.Generics defaultDustLimit = 700 :: BitcoinAmount defaultMinChanSize = defaultDustLimit * 2 @@ -33,8 +39,8 @@ -- |Retrieved by looking at the in-blockchain funding transaction pcsFundingTxInfo :: FundingTxInfo, pcsPaymentConfig :: PaymentTxConfig, - -- |Value left to send (starts at @`-` dustLimit . ftiOutValue . pcsFundingTxInfo@) - pcsValueLeft :: BitcoinAmount, + -- |Client change value + pcsClientChangeVal :: BitcoinAmount, -- |Signature over payment transaction of value 'pcsValueLeft' pcsPaymentSignature :: PaymentSignature } deriving (Eq, Show, Typeable) @@ -70,11 +76,21 @@ -- |Used to transfer value from sender to receiver. data Payment = CPayment { -- |Channel value remaining ('pcsValueLeft' of the state from which this payment was made) - cpChannelValueLeft :: BitcoinAmount, + cpClientChange :: BitcoinAmount -- |Payment signature - cpSignature :: PaymentSignature + , cpSignature :: PaymentSignature } deriving (Eq, Typeable) +-- |Contains all information required to construct the payment transaction +data FullPayment = CFullPayment { + fpPayment :: Payment + -- |The payment transaction redeems this outpoint + , fpOutPoint :: HT.OutPoint + , fpRedeemScript :: HS.Script + -- |Client change output address in the payment tx + , fpChangeAddr :: HC.Address +} deriving (Eq, Typeable) + -- |Contains payment signature plus sig hash flag byte data PaymentSignature = CPaymentSignature { psSig :: HC.Signature @@ -86,6 +102,8 @@ ,psSigHash :: HS.SigHash } deriving (Eq, Show, Typeable) +-- |Wraps a Network.Haskoin.Script.Script +newtype ChanScript = ChanScript { getScript :: HS.Script } deriving (Eq, Show) -- Never confuse sender/receiver pubkey again: let compiler check newtype SendPubKey = MkSendPubKey { diff --git a/src/Data/Bitcoin/PaymentChannel/Internal/Util.hs b/src/Data/Bitcoin/PaymentChannel/Internal/Util.hs --- a/src/Data/Bitcoin/PaymentChannel/Internal/Util.hs +++ b/src/Data/Bitcoin/PaymentChannel/Internal/Util.hs @@ -5,6 +5,7 @@ module Data.Bitcoin.PaymentChannel.Internal.Util , module Data.Bitcoin.PaymentChannel.Internal.Bitcoin.Util , module Data.Bitcoin.PaymentChannel.Internal.Bitcoin.LockTime +, cs ) where @@ -20,7 +21,11 @@ import qualified Data.ByteString.Base16 as B16 import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as C +import qualified Data.Text as T +import qualified Data.Aeson.Types as JSON import qualified Network.Haskoin.Crypto as HC +import Data.String.Conversions (cs) +import Data.Text.Encoding (decodeUtf8, encodeUtf8) mapLeft f = either (Left . f) Right @@ -34,6 +39,9 @@ toHexBS :: B.ByteString -> B.ByteString toHexBS = B16.encode +fromHexBS :: B.ByteString -> B.ByteString +fromHexBS = fst . B16.decode + fromHexString :: String -> B.ByteString fromHexString hexStr = case (B16.decode . C.pack) hexStr of @@ -61,4 +69,10 @@ toHexString leftoverBS where offset = B.length bs - B.length leftoverBS +deserHex :: (Typeable a, Bin.Serialize a) => T.Text -> JSON.Parser a +deserHex = either + (fail . ("failed to decode hex: " ++)) return . + deserEither . fromHexBS . encodeUtf8 +serHex :: Bin.Serialize a => a -> T.Text +serHex = decodeUtf8 . toHexBS . Bin.encode diff --git a/src/Data/Bitcoin/PaymentChannel/Movable.hs b/src/Data/Bitcoin/PaymentChannel/Movable.hs new file mode 100644 --- /dev/null +++ b/src/Data/Bitcoin/PaymentChannel/Movable.hs @@ -0,0 +1,190 @@ +{-| +Module : Data.Bitcoin.PaymentChannel.Movable +Description : Bitcoin payment channel library +License : PublicDomain +Maintainer : runesvend@gmail.com +Stability : experimental +Portability : POSIX + +TODO +-} + +module Data.Bitcoin.PaymentChannel.Movable where + +import Data.Bitcoin.PaymentChannel +import Data.Bitcoin.PaymentChannel.Types +import Data.Bitcoin.PaymentChannel.Internal.Types +import qualified Data.Bitcoin.PaymentChannel.Internal.State as S +import qualified Network.Haskoin.Crypto as HC +import qualified Data.Serialize as Bin +import Control.Applicative ((<|>)) + +-- |A ReceiverPaymentChannel whose received value can be redeemed while +-- keeping the channel open, by switching between two different OutPoints +-- in the FundingTxInfo. +data MovableChan = + Settled { + beginVal :: BitcoinAmount + , beginState :: ReceiverPaymentChannel + } | Unsettled { + channels :: ChannelPair + -- If payment 1/2 has been accepted, accept 2/2 with 'receiveSecondPayment pp' + , finishPay :: Maybe PartialPayment + } -- deriving (Show) + +data ChannelPair = ChannelPair { + beginVal' :: BitcoinAmount + , oldState :: ReceiverPaymentChannel + , newState :: ReceiverPaymentChannel +} + +-- |We wrap the state in which only payment 1/2 has been received in a data +-- type, in order to be able to serialize it to disk. +data PartialPayment = + NewNeedsUpdate ChannelPair BitcoinAmount + | OldNeedsUpdate ChannelPair BitcoinAmount + +instance PaymentChannel MovableChan where + valueToMe = channelValueLeft . fst . getStateForClosing + getChannelState = rpcState . fst . getStateForClosing + _setChannelState (Settled v rpc) s = Settled v (rpc { rpcState = s }) + _setChannelState (Unsettled (ChannelPair v old new) fp) s = + Unsettled (ChannelPair v (setState s old) (setState s new)) fp + where setState s rpc = rpc { rpcState = s } + +newMovableChan :: + ChannelParameters + -> FundingTxInfo + -> FullPayment + -> Either PayChanError (BitcoinAmount, MovableChan, BitcoinAmount) +newMovableChan cp fti@(CFundingTxInfo _ _ chanVal) + fullPayment@(CFullPayment _ _ _ payChgAddr) = + checkChangeAddr >>= channelFromInitialPayment cp fti desiredChangeAddr >>= + \(payAmount, rpc) -> Right (payAmount, Settled chanVal rpc, channelValueLeft rpc) + where desiredChangeAddr = getFundingAddress cp + checkChangeAddr = + if payChgAddr /= desiredChangeAddr then + Left $ ChangeAddrMismatch desiredChangeAddr + else + Right fullPayment + +getStateForClosing :: MovableChan -> (ReceiverPaymentChannel,BitcoinAmount) +getStateForClosing (Settled v rpc) = (rpc,v) +getStateForClosing (Unsettled (ChannelPair v _ newRpc) _) = (newRpc,v) + +getStateByInfo :: MovableChan -> BitcoinLockTime -> OutPoint -> Maybe (ReceiverPaymentChannel,BitcoinAmount) +getStateByInfo mc lt op = case mc of + (Settled v rpc) -> checkInfo rpc v + (Unsettled (ChannelPair v old new) _) -> checkInfo new v <|> checkInfo old v + where checkInfo rpc v = + if getChannelID rpc == op && + getExpirationDate rpc == lt then + Just (rpc,v) + else + Nothing + +moveChannel :: + MovableChan + -> (HC.Hash256 -> HC.Signature) -- ^ Function which produces a signature which verifies against 'cpReceiverPubKey' + -> HC.Address -- ^ Receiver destination address. Funds sent over the channel will be sent to this address, the rest back to the client change address (an argument to 'channelWithInitialPaymentOf'). + -> BitcoinAmount -- ^ Bitcoin transaction fee + -> Maybe (Tx, MovableChan) +moveChannel Unsettled{} _ _ _ = Nothing +moveChannel (Settled v rpc) signFunc destAddr txFee = + -- If we haven't received any value, moving the channel makes no sense + if valueToMe rpc > 0 then + Just (settleTx, Unsettled (ChannelPair v rpc newRpc) Nothing) + else + Nothing + where settleTx = getSettlementBitcoinTx rpc signFunc destAddr txFee + newRpc = CReceiverPaymentChannel $ S.setFundingSource (getChannelState rpc) fti + fti = CFundingTxInfo (txHash settleTx) + -- Client output always at index zero + 0 (senderChangeValue rpc) + +markAsSettled :: + MovableChan + -> Maybe MovableChan +markAsSettled Settled{} = Nothing +markAsSettled (Unsettled _ (Just _)) = Nothing +markAsSettled (Unsettled (ChannelPair v _ newRpc) Nothing) = + if valueToMe newRpc > 0 then + Just $ Settled v newRpc + else + Nothing + +recvSinglePayment :: + MovableChan + -> FullPayment + -> Either PayChanError (BitcoinAmount, MovableChan, BitcoinAmount) +recvSinglePayment (Settled v rpc) fp = recvPayment rpc fp >>= + \(a, newRpc) -> Right (a, Settled v newRpc, channelValueLeft newRpc) +-- Accept payment 1/2 +recvSinglePayment (Unsettled cp@(ChannelPair _ old new) Nothing) fp@(CFullPayment _ op _ _) + | S.pcsPrevOut (getChannelState old) == op = oldRecvPay cp fp + | S.pcsPrevOut (getChannelState new) == op = newRecvPay cp fp + | otherwise = Left . OutPointMismatch . S.pcsPrevOut . getChannelState $ new +-- If we've already received paymed 1/2, we receive 2/2 with this +recvSinglePayment (Unsettled _ (Just pp)) fp = receiveSecondPayment pp fp + +oldRecvPay :: + ChannelPair + -> FullPayment + -> Either PayChanError (BitcoinAmount, MovableChan, BitcoinAmount) +oldRecvPay (ChannelPair v old new) fp = recvPayment old fp >>= + -- Update old state, and leave behind a function that updates the new state + \(amt, newOld) -> Right + (amt, Unsettled (ChannelPair v newOld new) + (Just $ NewNeedsUpdate (ChannelPair v newOld new) amt), + channelValueLeft newOld) + +newRecvPay :: + ChannelPair + -> FullPayment + -> Either PayChanError (BitcoinAmount, MovableChan, BitcoinAmount) +newRecvPay (ChannelPair v old new) fp = recvPayment new fp >>= + -- Update new state, and leave behind a function that updates the old state + \(amt, newNew) -> Right + (amt, Unsettled (ChannelPair v old newNew) + (Just $ OldNeedsUpdate (ChannelPair v old newNew) amt), + channelValueLeft newNew) + +receiveSecondPayment :: + PartialPayment + -> FullPayment + -> Either PayChanError (BitcoinAmount, MovableChan, BitcoinAmount) +receiveSecondPayment (OldNeedsUpdate cp amt) fp = + checkChangeValueMatch amt fp >>= oldRecvPay cp >>= + \(amt, mc, vLeft) -> Right (amt, mc { finishPay = Nothing }, vLeft) +receiveSecondPayment (NewNeedsUpdate cp amt) fp = + checkChangeValueMatch amt fp >>= newRecvPay cp >>= + \(amt, mc, vLeft) -> Right (amt, mc { finishPay = Nothing }, vLeft) + +-- | We want to make sure that payment 1/2 and 2/2 are of equal value +checkChangeValueMatch :: BitcoinAmount -> FullPayment -> Either PayChanError FullPayment +checkChangeValueMatch firstPayVal fp@(CFullPayment (CPayment val _) _ _ _) = + if val /= firstPayVal then Left $ PartialPaymentBadValue firstPayVal else Right fp + + +instance Bin.Serialize MovableChan where + put (Settled bVal rpc) = + Bin.putWord8 0x01 >> Bin.put bVal >> Bin.put rpc + put (Unsettled cPair mPP) = + Bin.putWord8 0x02 >> Bin.put cPair >> Bin.put mPP + get = Bin.getWord8 >>= \w -> case w of + 0x01 -> Settled <$> Bin.get <*> Bin.get + 0x02 -> Unsettled <$> Bin.get <*> Bin.get + n -> fail $ "unknown start byte: " ++ show n + +instance Bin.Serialize ChannelPair where + put (ChannelPair bVal old new) = + Bin.put bVal >> Bin.put old >> Bin.put new + get = ChannelPair <$> Bin.get <*> Bin.get <*> Bin.get + +instance Bin.Serialize PartialPayment where + put (NewNeedsUpdate cp amt) = Bin.putWord8 0x01 >> Bin.put cp >> Bin.put amt + put (OldNeedsUpdate cp amt) = Bin.putWord8 0x02 >> Bin.put cp >> Bin.put amt + get = Bin.getWord8 >>= \w -> case w of + 0x01 -> NewNeedsUpdate <$> Bin.get <*> Bin.get + 0x02 -> OldNeedsUpdate <$> Bin.get <*> Bin.get + n -> fail $ "unknown start byte: " ++ show n diff --git a/src/Data/Bitcoin/PaymentChannel/Types.hs b/src/Data/Bitcoin/PaymentChannel/Types.hs --- a/src/Data/Bitcoin/PaymentChannel/Types.hs +++ b/src/Data/Bitcoin/PaymentChannel/Types.hs @@ -15,7 +15,8 @@ PaymentChannel(..), SenderPaymentChannel(..), ReceiverPaymentChannel(..), -Payment, +Payment,cpSignature, +FullPayment(..), FundingTxInfo(..), ChannelParameters(..), PayChanError(..), @@ -33,12 +34,6 @@ where import Data.Bitcoin.PaymentChannel.Internal.Types - (BitcoinAmount(..), - PaymentChannelState(..), Payment(..) - ,FundingTxInfo(..), ChannelParameters(..), - SendPubKey(..), RecvPubKey(..), IsPubKey(..), - defaultDustLimit, - BitcoinLockTime(..), fromDate, usesBlockHeight) import Data.Bitcoin.PaymentChannel.Internal.Serialization import qualified Data.Bitcoin.PaymentChannel.Internal.State as S @@ -48,6 +43,7 @@ import Data.Aeson as JSON -- (FromJSON, ToJSON) import qualified Network.Haskoin.Crypto as HC import qualified Network.Haskoin.Transaction as HT +-- import qualified Network.Haskoin.Transaction as HS -- |Get various information about an open payment channel. @@ -56,24 +52,31 @@ valueToMe :: a -> BitcoinAmount -- |Retrieve internal state object getChannelState :: a -> PaymentChannelState + getChannelID :: a -> HT.OutPoint getExpirationDate :: a -> BitcoinLockTime + getSenderPubKey :: a -> SendPubKey getNewestPayment :: a -> Payment + getNewestSig :: a -> HC.Signature -- |Return True if channel expires earlier than given expiration date expiresBefore :: BitcoinLockTime -> a -> Bool -- |For internal use _setChannelState :: a -> PaymentChannelState -> a channelValueLeft :: a -> BitcoinAmount + senderChangeValue :: a -> BitcoinAmount -- |Returns 'True' if all available channel value has been transferred, 'False' otherwise channelIsExhausted :: a -> Bool getChannelID = S.pcsChannelID . getChannelState getExpirationDate = S.pcsExpirationDate . getChannelState + getSenderPubKey = S.pcsClientPubKey . getChannelState + senderChangeValue = pcsClientChangeVal . getChannelState channelValueLeft = S.channelValueLeft . getChannelState channelIsExhausted = S.channelIsExhausted . getChannelState expiresBefore expDate chan = getExpirationDate chan < expDate getNewestPayment pcs = S.pcsGetPayment (getChannelState pcs) + getNewestSig = psSig . cpSignature . getNewestPayment -- |State object for the value sender data SenderPaymentChannel = CSenderPaymentChannel { diff --git a/src/Data/Bitcoin/PaymentChannel/Util.hs b/src/Data/Bitcoin/PaymentChannel/Util.hs --- a/src/Data/Bitcoin/PaymentChannel/Util.hs +++ b/src/Data/Bitcoin/PaymentChannel/Util.hs @@ -10,12 +10,13 @@ module Data.Bitcoin.PaymentChannel.Util ( -getFundingAddress, +getFundingAddress,getRedeemScript, setSenderChangeAddress, serialize, deserEither, BitcoinLockTime, parseBitcoinLocktime, toWord32, fromDate, parseJSONInt, +pGetSig,fpGetSig, unsafeUpdateRecvState ) @@ -23,11 +24,9 @@ import Data.Bitcoin.PaymentChannel.Internal.Types (PaymentChannelState(..), - Payment(..)) --- import Data.Bitcoin.PaymentChannel.Internal.State --- (ptcSenderChangeAddress) + Payment(..), PaymentSignature(..)) import Data.Bitcoin.PaymentChannel.Internal.Bitcoin.Script - (getP2SHFundingAddress) + (getP2SHFundingAddress, getRedeemScript) import Data.Bitcoin.PaymentChannel.Internal.Util (parseBitcoinLocktime, toWord32, deserEither, serialize) import Data.Bitcoin.PaymentChannel.Internal.State @@ -58,6 +57,10 @@ -- verified the signature, and it just needs to be stored. unsafeUpdateRecvState :: ReceiverPaymentChannel -> Payment -> ReceiverPaymentChannel unsafeUpdateRecvState (CReceiverPaymentChannel s) (CPayment val sig) = - CReceiverPaymentChannel $ s { pcsValueLeft = val, pcsPaymentSignature = sig} + CReceiverPaymentChannel $ s { pcsClientChangeVal = val, pcsPaymentSignature = sig} +fpGetSig :: FullPayment -> HC.Signature +fpGetSig = psSig . cpSignature . fpPayment +pGetSig :: Payment -> HC.Signature +pGetSig = psSig . cpSignature diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,18 +1,24 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Main where -import Data.Bitcoin.PaymentChannel -import Data.Bitcoin.PaymentChannel.Types -import Data.Bitcoin.PaymentChannel.Util + +import Data.Bitcoin.PaymentChannel +import Data.Bitcoin.PaymentChannel.Types +import Data.Bitcoin.PaymentChannel.Util import qualified Data.Bitcoin.PaymentChannel.Internal.State as S -import qualified Network.Haskoin.Transaction as HT -import qualified Network.Haskoin.Crypto as HC -import Network.Haskoin.Test +import qualified Network.Haskoin.Transaction as HT +import qualified Network.Haskoin.Crypto as HC +import qualified Network.Haskoin.Script as HS +import Network.Haskoin.Test +import qualified Data.Aeson as JSON +import qualified Data.Serialize as Bin +import Data.Typeable import Test.QuickCheck - +import Debug.Trace dUST_LIMIT = 700 :: BitcoinAmount mIN_CHANNEL_SIZE = 1400 :: BitcoinAmount @@ -43,33 +49,50 @@ (recvAmount : recvList) f +newtype ChanScript = ChanScript HS.Script deriving (Eq,Show,Bin.Serialize) + instance Arbitrary ArbChannelPair where - arbitrary = mkChanPair + arbitrary = fmap fst mkChanPair -mkChanPair :: Gen ArbChannelPair -- (Either String ArbChannelPair) +instance Arbitrary FullPayment where + arbitrary = fmap snd mkChanPair + +instance Arbitrary ChannelParameters where + arbitrary = fmap fst mkChanParams + +instance Arbitrary ChanScript where + arbitrary = ChanScript . getRedeemScript <$> arbitrary + +mkChanParams :: Gen (ChannelParameters, (HC.PrvKey, HC.PrvKey)) +mkChanParams = do + -- sender key pair + ArbitraryPubKey sendPriv sendPK <- arbitrary + -- receiver key pair + ArbitraryPubKey recvPriv recvPK <- arbitrary + -- expiration date + lockTime <- arbitrary + return (CChannelParameters + (MkSendPubKey sendPK) (MkRecvPubKey recvPK) lockTime dUST_LIMIT, + (sendPriv, recvPriv)) + +mkChanPair :: Gen (ArbChannelPair, FullPayment) mkChanPair = do - -- sender key pair - ArbitraryPubKey sendPriv sendPK <- arbitrary - -- receiver key pair - ArbitraryPubKey recvPriv recvPK <- arbitrary - -- expiration date - lockTime <- arbitrary + (cp, (sendPriv, recvPriv)) <- mkChanParams fti <- arbitrary - let cp = CChannelParameters - (MkSendPubKey sendPK) (MkRecvPubKey recvPK) lockTime dUST_LIMIT -- value of first payment initPayAmount <- arbitrary -- fromIntegral <$> choose (0, chanAmount) - + -- create states let (initPayActualAmount,paymnt,sendChan) = channelWithInitialPaymentOf - cp fti (flip HC.signMsg sendPriv) (HC.pubKeyAddr sendPK) initPayAmount + cp fti (flip HC.signMsg sendPriv) (getFundingAddress cp) initPayAmount let eitherRecvChan = channelFromInitialPayment - cp fti (HC.pubKeyAddr sendPK) paymnt - + cp fti (getFundingAddress cp) paymnt case eitherRecvChan of Left e -> error (show e) - Right (initRecvAmount,recvChan) -> return $ ArbChannelPair - sendChan recvChan [initPayActualAmount] [initRecvAmount] - (flip HC.signMsg recvPriv) + Right (initRecvAmount,recvChan) -> return + (ArbChannelPair + sendChan recvChan [initPayActualAmount] [initRecvAmount] + (flip HC.signMsg recvPriv), + paymnt) instance Arbitrary BitcoinLockTime where arbitrary = fmap parseBitcoinLocktime arbitrary @@ -112,12 +135,44 @@ checkGoodClientValue clientValueIsGood && statesMatch && recvSendAmountMatch -testChanPair :: ArbChannelPair -> [BitcoinAmount] -> Bool -testChanPair arbChanPair paymentAmountList = + +jsonSerDeser :: (Show a, Eq a, JSON.FromJSON a, JSON.ToJSON a) => a -> Bool +jsonSerDeser fp = + maybe False checkEquals decodedObj + where json = JSON.encode fp + decodedObj = JSON.decode json + checkEquals serDeserVal = + if serDeserVal /= fp then + error ("Ser/deser mismatch.\nOriginal: " ++ show fp ++ "\nCopy: " ++ show decodedObj) + else + True + +binSerDeser :: (Typeable a, Show a, Eq a, Bin.Serialize a) => a -> Bool +binSerDeser fp = + checkEquals decodeRes + where bs = Bin.encode fp + decodeRes = deserEither bs + checkEquals serDeserRes = case serDeserRes of + Left e -> error $ "Serialize/deserialize error: " ++ show e + Right res -> if res /= fp then + error ("Ser/deser mismatch.\nOriginal: " ++ show fp ++ "\nCopy: " ++ show res) + else + True + +testPaymentSession :: ArbChannelPair -> [BitcoinAmount] -> Bool +testPaymentSession arbChanPair paymentAmountList = checkChanPair (runChanPair arbChanPair paymentAmountList) +testPaymentJSON = jsonSerDeser :: FullPayment -> Bool +testPaymentBin = binSerDeser :: FullPayment -> Bool +testScriptBin = binSerDeser :: ChanScript -> Bool + main :: IO () -main = quickCheckWith stdArgs testChanPair +main = do + quickCheckWith stdArgs testPaymentSession + quickCheckWith stdArgs testPaymentJSON + quickCheckWith stdArgs testPaymentBin +-- quickCheckWith stdArgs testScriptBin