bitcoin-payment-channel 0.4.0.1 → 0.5.0.0

raw patch · 14 files changed

+315/−400 lines, 14 filesdep +taggeddep +test-frameworkdep +test-framework-quickcheck2PVP ok

version bump matches the API change (PVP)

Dependencies added: tagged, test-framework, test-framework-quickcheck2

API changes (from Hackage documentation)

Files

• bitcoin-payment-channel.cabal +11/−13
• src/Data/Bitcoin/PaymentChannel.hs +72/−34
• src/Data/Bitcoin/PaymentChannel/Internal/Bitcoin/LockTime.hs +1/−1
• src/Data/Bitcoin/PaymentChannel/Internal/Bitcoin/Script.hs +1/−1
• src/Data/Bitcoin/PaymentChannel/Internal/Error.hs +6/−1
• src/Data/Bitcoin/PaymentChannel/Internal/Payment.hs +4/−4
• src/Data/Bitcoin/PaymentChannel/Internal/Refund.hs +3/−3
• src/Data/Bitcoin/PaymentChannel/Internal/Serialization.hs +12/−7
• src/Data/Bitcoin/PaymentChannel/Internal/Settlement.hs +3/−3
• src/Data/Bitcoin/PaymentChannel/Internal/State.hs +33/−17
• src/Data/Bitcoin/PaymentChannel/Internal/Types.hs +27/−17
• src/Data/Bitcoin/PaymentChannel/Movable.hs +0/−190
• src/Data/Bitcoin/PaymentChannel/Types.hs +26/−24
• test/Main.hs +116/−85

@@ -1,5 +1,5 @@ name:                 bitcoin-payment-channel-version:              0.4.0.1+version:              0.5.0.0 synopsis:             Library for working with Bitcoin payment channels description:     A Bitcoin payment channel allows secure and instant transfer of bitcoins from one@@ -34,7 +34,6 @@   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 @@ -51,6 +50,7 @@                         Data.Bitcoin.PaymentChannel.Internal.Util    ghc-options:          -W+  default-language:     Haskell2010    build-depends:        base                >= 4.7    && < 5,                         haskoin-core        >= 0.4.0  && < 0.5.0,@@ -64,16 +64,18 @@                         time                >= 1.5.0  && < 1.7.0,                         aeson               >= 0.11.0 && < 0.12.0,                         scientific          >= 0.3.0  && < 0.4.0,-                        string-conversions  >= 0.4    && < 0.5+                        string-conversions  >= 0.4    && < 0.5,+                        tagged              >= 0.8    && < 1.0    hs-source-dirs:       src -  default-language:     Haskell2010 -executable Test-  main-is:              Main.hs--  ghc-options:          -W+test-suite test-bitcoin-payment-channel+  type: exitcode-stdio-1.0+  main-is: Main.hs+  default-language:     Haskell2010+  hs-source-dirs: test+  ghc-options:    -W    build-depends:        base         >= 4.7   && < 5,                         haskoin-core >= 0.4.0 && < 1.0.0,@@ -84,9 +86,5 @@                         time,                         cereal, aeson, -                        QuickCheck,+                        QuickCheck, test-framework, test-framework-quickcheck2,                         bitcoin-payment-channel--  hs-source-dirs:       test--  default-language:     Haskell2010

@@ -93,6 +93,7 @@      channelFromInitialPayment,     recvPayment,+    recvPaymentForClose,      getSettlementBitcoinTx,     getRefundBitcoinTx,@@ -102,9 +103,10 @@ where  import Data.Bitcoin.PaymentChannel.Internal.Types-    (PaymentTxConfig(..), Payment(..), FullPayment(..), pcsClientChangeVal)+    (PaymentTxConfig(..), Payment(..), FullPayment(..), Config,+    pcsConfig, pcsClientChangeVal, pcsParameters) import Data.Bitcoin.PaymentChannel.Internal.State-    (newPaymentChannelState, updatePaymentChannelState)+    (newPaymentChannelState, updatePaymentChannelState, isPastLockTimeDate) import qualified Data.Bitcoin.PaymentChannel.Internal.State as S import Data.Bitcoin.PaymentChannel.Internal.Payment     (createPayment, paymentFromState, verifyPaymentSigFromState)@@ -116,8 +118,10 @@ import Data.Bitcoin.PaymentChannel.Util (getFundingAddress) import Data.Bitcoin.PaymentChannel.Types -import qualified  Network.Haskoin.Crypto as HC-import qualified  Network.Haskoin.Transaction as HT+import qualified  Network.Haskoin.Crypto        as HC+import qualified  Network.Haskoin.Transaction   as HT+import            Data.Time.Clock                 (UTCTime(..))+import            Data.Time.Calendar              (Day(..))   -- |Create a new 'SenderPaymentChannel'.@@ -125,25 +129,26 @@ -- the channel and the funding transaction, as well as the value of the first payment. -- Returns a new 'SenderPaymentChannel' state object and the first channel payment. channelWithInitialPaymentOf ::-    ChannelParameters               -- ^ Specifies channel sender and receiver, channel expiration date and "dust limit"-    -> FundingTxInfo                -- ^ Holds information about the transaction used to fund the channel-    -> (HC.Hash256 -> HC.Signature) -- ^Used to sign payments from sender. When given a 'HC.Hash256', produces a signature that verifies against sender PubKey.+       Config                       -- ^ Various configuration options. 'defaultConfig' contains sensible defaults.+    -> ChannelParameters            -- ^ Specifies channel sender and receiver, channel expiration date and "dust limit"+    -> FundingTxInfo                -- ^ Holds information about the Bitcoin transaction used to fund the channel+    -> (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                -- ^ Value of initial payment. Can be zero.     -> (BitcoinAmount, FullPayment, SenderPaymentChannel) -- ^Initial payment amount (may be capped), initial payment, and new sender state object-channelWithInitialPaymentOf cp fundInf signFunc sendAddr amount =+channelWithInitialPaymentOf cfg cp fundInf signFunc sendAddr amount =     let pConf = CPaymentTxConfig sendAddr         (CFullPayment (CPayment _ tmpSig) _ _ _) =             createPayment cp fundInf sendAddr amount signFunc     in         flip sendPayment amount $ CSenderPaymentChannel-            (newPaymentChannelState cp fundInf pConf tmpSig) signFunc+            (newPaymentChannelState cfg cp fundInf pConf tmpSig) signFunc  -- |Create new payment of specified value. 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, FullPayment, SenderPaymentChannel)  -- ^ Actual amount sent, payment, and updated sender state object+    SenderPaymentChannel                -- ^ Sender state object+    -> BitcoinAmount                    -- ^ Amount to send (the actual payment amount is capped)+    -> (BitcoinAmount, FullPayment, SenderPaymentChannel)  -- ^ Actual amount actually sent, payment, and updated sender state object sendPayment (CSenderPaymentChannel cs signFunc) amountToSend =     let         valSent = pcsClientChangeVal cs - newSenderValue@@ -175,39 +180,72 @@ -- about the payment channel, as well as the first channel payment -- produced by the sender. channelFromInitialPayment ::-    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-    -> FullPayment -- ^Initial channel payment+       UTCTime              -- ^ Current time. Needed for payment verification.+    -> Config               -- ^ Various configuration options. 'defaultConfig' contains sensible defaults.+    -> ChannelParameters    -- ^ Specifies channel sender and receiver, plus channel expiration date+    -> FundingTxInfo        -- ^ Holds information about the Bitcoin transaction used to fund the channel+    -> FullPayment          -- ^ Initial channel payment     -> Either PayChanError (BitcoinAmount, ReceiverPaymentChannel) -- ^Error or: value_received plus state object-channelFromInitialPayment cp fundInf sendAddr fp@(CFullPayment (CPayment _ sig) _ _ _) =+channelFromInitialPayment now cfg cp fundInf fp@(CFullPayment (CPayment _ sig) _ _ sendAddr) =         let             pConf = CPaymentTxConfig sendAddr         in-            flip recvPayment fp $ CReceiverPaymentChannel+            flip (recvPayment now) fp $ CReceiverPaymentChannel                 -- Create a new state with the unverified signature; then verify the same signature in 'recvPayment'-                (newPaymentChannelState cp fundInf pConf sig)+                (newPaymentChannelState cfg cp fundInf pConf sig)  -- |Register, on the receiving side, a payment made by 'sendPayment' on the sending side. -- Returns error if either the signature or payment amount is invalid, and otherwise -- the amount received with this 'Payment' and a new state object. recvPayment ::-    ReceiverPaymentChannel -- ^Receiver state object-    -> FullPayment -- ^Payment to verify and register+       UTCTime                  -- ^Current time. Needed for payment verification.+    -> ReceiverPaymentChannel   -- ^Receiver state object+    -> FullPayment              -- ^Payment to verify and register     -> Either PayChanError (BitcoinAmount, ReceiverPaymentChannel) -- ^Value received plus new receiver state object-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 fp >>=-            (\newState -> Right (-                S.channelValueLeft oldState - S.channelValueLeft newState-                , rpc { rpcState = newState })-            )-        else-            Left SigVerifyFailed+recvPayment currentTime rpc@(CReceiverPaymentChannel oldState) fp@(CFullPayment paymnt _ _ _)  =+    updatePaymentChannelState oldState fp >>=+    checkExpiration >>=+    verifyPaymentSignature paymnt >>=+    (\newState -> Right (+        S.channelValueLeft oldState - S.channelValueLeft newState+        , rpc { rpcState = newState })+    )+    where checkExpiration s =+            if isPastLockTimeDate currentTime (pcsConfig oldState) (pcsParameters oldState) then+                Left ChannelExpired+            else+                Right s +verifyPaymentSignature ::+    Payment                 -- ^Payment whose signature to verify+    -> PaymentChannelState  -- ^State object+    -> Either PayChanError PaymentChannelState+verifyPaymentSignature paymnt state =+    if verifyPaymentSigFromState state verifySenderPayment paymnt then+        Right state+    else+        Left SigVerifyFailed+    where verifySenderPayment hash pk sig = HC.verifySig hash sig (getPubKey pk)++-- |Same as 'recvPayment' but accept only a payment of zero value+--  with a new client change address. Used to produce the settlement+--  transaction that returns unsent funds to the client.+recvPaymentForClose ::+    ReceiverPaymentChannel  -- ^Receiver state object+    -> FullPayment          -- ^Payment to verify and register+    -> Either PayChanError ReceiverPaymentChannel -- ^ Receiver state object+recvPaymentForClose (CReceiverPaymentChannel state) fp =+    recvPayment futureTimeStamp newAddressState fp >>=+        \(amtRecv, newState) -> case amtRecv of+            0 -> Right newState+            _ -> Left ClosingPaymentBadValue+    where newAddressState = CReceiverPaymentChannel $+            S.setClientChangeAddress state (fpChangeAddr fp)+          -- When receiving a payment of zero value, which only modifies the+          -- client change address, we don't care about verifying that the channel+          -- hasn't expired yet (which it may well have, since the client wants its+          -- money back)+          futureTimeStamp = UTCTime (ModifiedJulianDay 94183) 0     -- 100 years into the future from now  -- |The value transmitted over the channel is settled when this transaction is in the Blockchain. -- The receiver will want to make sure a transaction produced by this function

@@ -32,7 +32,7 @@     | i >=  500000000 = LockTimeDate $ posixSecondsToUTCTime (fromIntegral i)     | otherwise       = error "GHC bug?" --- | Convert to Bitcoin format ('Word32')+-- | Convert to Bitcoin format (uint32 UNIX timestamp) toWord32 :: BitcoinLockTime -> Word32 toWord32 (LockTimeBlockHeight i) = i toWord32 (LockTimeDate date) =

@@ -65,7 +65,7 @@ getP2SHFundingAddress = scriptToP2SHAddress . getRedeemScript  getRedeemScript :: ChannelParameters -> Script-getRedeemScript (CChannelParameters senderPK recvrPK lockTime _) =+getRedeemScript (CChannelParameters senderPK recvrPK lockTime) =     paymentChannelRedeemScript senderPK recvrPK lockTime  getRedeemScriptBS :: ChannelParameters -> B.ByteString

@@ -13,7 +13,9 @@     ChangeAddrMismatch Address |     RedeemScriptMismatch Script |     DustOutput BitcoinAmount |-    PartialPaymentBadValue BitcoinAmount+    PartialPaymentBadValue BitcoinAmount |+    ClosingPaymentBadValue |+    ChannelExpired         deriving Generic  instance Show PayChanError where@@ -29,3 +31,6 @@         " 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"+    show ClosingPaymentBadValue = "payment not of zero value." +++        " cannot receive value in closing payment."+    show ChannelExpired = "channel too close to expiration date"

@@ -27,8 +27,8 @@   }  fromState :: PaymentChannelState -> UnsignedPayment-fromState (CPaymentChannelState cp (CFundingTxInfo hash idx fundingVal)-          (CPaymentTxConfig changeAddr) changeValue _) =+fromState (CPaymentChannelState _ cp (CFundingTxInfo hash idx fundingVal)+          (CPaymentTxConfig changeAddr) _ changeValue _) =     UnsignedPayment         (HT.OutPoint hash idx) fundingVal         (getRedeemScript cp)   changeAddr changeValue@@ -63,7 +63,7 @@     -> BitcoinAmount                -- ^ sender change value (subtract 'n' from current sender change value to get payment of value 'n')     -> (HC.Hash256 -> HC.Signature) -- ^ signing function     -> FullPayment-paymentFromState (CPaymentChannelState cp fti (CPaymentTxConfig changeAddr) _ _) =+paymentFromState (CPaymentChannelState _ cp fti (CPaymentTxConfig changeAddr) _ _ _) =     createPayment cp fti changeAddr  -- |Create payment, pure.@@ -114,7 +114,7 @@     -> (HC.Hash256 -> SendPubKey -> HC.Signature -> Bool)     -> Payment     -> Bool-verifyPaymentSigFromState (CPaymentChannelState cp fti (CPaymentTxConfig changeAddr) _ _) =+verifyPaymentSigFromState (CPaymentChannelState _ cp fti (CPaymentTxConfig changeAddr) _ _ _) =     verifyPaymentSig cp fti changeAddr (cpSenderPubKey cp) ---Payment create/verify--- 

@@ -11,7 +11,7 @@ import qualified Network.Haskoin.Script as HS  getUnsignedRefundTx :: PaymentChannelState -> BitcoinAmount -> HT.Tx-getUnsignedRefundTx st txFee = -- @CPaymentChannelState =+getUnsignedRefundTx st txFee =     let         baseTx = toUnsignedBitcoinTx $ fromState st --create empty payment tx, which redeems funding tx         refundOut = HT.TxOut@@ -34,7 +34,7 @@     PaymentChannelState     -> BitcoinAmount -- ^Bitcoin transaction fee     -> HC.Hash256-getRefundTxHashForSigning pcs@(CPaymentChannelState cp _ _ _ _) newValueLeft =+getRefundTxHashForSigning pcs@(CPaymentChannelState _ cp _ _ _ _ _) newValueLeft =         HS.txSigHash tx (getRedeemScript cp) 0 (HS.SigAll False)             where tx = getUnsignedRefundTx pcs newValueLeft @@ -43,7 +43,7 @@     -> BitcoinAmount      -- ^Bitcoin tx fee     -> HC.Signature     -- ^Signature over 'getUnsignedRefundTx' which verifies against clientPubKey     -> FinalTx-refundTxAddSignature pcs@(CPaymentChannelState cp _ _ _ _) txFee clientRawSig =+refundTxAddSignature pcs@(CPaymentChannelState _ cp _ _ _ _ _) txFee clientRawSig =         let             inputScript = getP2SHInputScript cp $ refundTxScriptSig clientRawSig         in

@@ -22,7 +22,7 @@ import           Data.Word (Word64) import           Data.EitherR (fmapL) import           Data.Typeable-import           Debug.Trace+import qualified Data.Tagged as Tag  -- Generic PayChanError instance instance Bin.Serialize PayChanError@@ -113,16 +113,16 @@ 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 >>+    put (CPaymentChannelState cfg par fti payConf payCount valLeft sig) =+        Bin.put cfg >> Bin.put par >> Bin.put fti >> Bin.put payConf >> Bin.put payCount >>         Bin.put valLeft >> Bin.put sig     get = CPaymentChannelState <$> Bin.get <*> Bin.get <*>-        Bin.get <*> Bin.get <*> Bin.get+        Bin.get <*> Bin.get <*> Bin.get <*> Bin.get <*> Bin.get  instance Bin.Serialize ChannelParameters where-    put (CChannelParameters pks pkr lt dustLimit) =-        Bin.put pks >> Bin.put pkr >> Bin.put lt >> Bin.put dustLimit-    get = CChannelParameters <$> Bin.get <*> Bin.get <*> Bin.get <*> Bin.get+    put (CChannelParameters pks pkr lt) =+        Bin.put pks >> Bin.put pkr >> Bin.put lt+    get = CChannelParameters <$> Bin.get <*> Bin.get <*> Bin.get  instance Bin.Serialize FundingTxInfo where     put (CFundingTxInfo h idx val) =@@ -133,6 +133,11 @@     put (CPaymentTxConfig sendAddr) =         Bin.put sendAddr     get = CPaymentTxConfig <$> Bin.get++instance Bin.Serialize Config where+    put (Config dl sp) =+        Bin.put dl >> Bin.put (Tag.unTagged sp)+    get = Config <$> Bin.get <*> fmap Tag.Tagged Bin.get  instance Bin.Serialize Payment where     put (CPayment val sig) =

@@ -14,7 +14,7 @@ serverSigHash = HS.SigAll False  csFromState :: PaymentChannelState -> ClientSignedPayment-csFromState cs@(CPaymentChannelState _ _ _ _ clientSig) =+csFromState cs@(CPaymentChannelState _ _ _ _ _ _ clientSig) =     ClientSignedPayment (fromState cs) clientSig  toUnsignedSettlementTx :: ClientSignedPayment -> HC.Address -> BitcoinAmount -> HT.Tx@@ -48,7 +48,7 @@     -> HC.Address    -- ^Receiver destination address     -> BitcoinAmount -- ^Bitcoin transaction fee     -> HC.Hash256-settlementSigningTxHashFromState cs@(CPaymentChannelState cp _ _ _ _) =+settlementSigningTxHashFromState cs@(CPaymentChannelState _ cp _ _ _ _ _) =     getSettlementTxHashForSigning (csFromState cs) cp  getSignedSettlementTx ::@@ -73,6 +73,6 @@     -> HC.Address       -- ^Receiver/server funds destination address     -> BitcoinAmount    -- ^Bitcoin tx fee     -> HT.Tx-signedSettlementTxFromState cs@(CPaymentChannelState cp _ _ _ _) signFunc recvAddr txFee =+signedSettlementTxFromState cs@(CPaymentChannelState _ cp _ _ _ _ _) signFunc recvAddr txFee =     getSignedSettlementTx (csFromState cs) cp recvAddr txFee serverSig         where serverSig = signFunc (settlementSigningTxHashFromState cs recvAddr txFee)

@@ -10,32 +10,34 @@ import qualified Network.Haskoin.Transaction as HT import qualified Network.Haskoin.Crypto as HC import qualified Network.Haskoin.Script as HS+import           Data.Time.Clock + pcsChannelTotalValue = ftiOutValue . pcsFundingTxInfo pcsValueTransferred cs = pcsChannelTotalValue cs - pcsClientChangeVal cs pcsChannelValueLeft = pcsClientChangeVal pcsClientPubKey = cpSenderPubKey . pcsParameters pcsServerPubKey = cpReceiverPubKey . pcsParameters-pcsDustLimit = cpDustLimit . pcsParameters+pcsDustLimit = cDustLimit . pcsConfig pcsExpirationDate = cpLockTime . pcsParameters pcsClientChangeAddress = ptcSenderChangeAddress . pcsPaymentConfig pcsClientChangeScriptPubKey = addressToScriptPubKeyBS . pcsClientChangeAddress pcsLockTime = cpLockTime . pcsParameters-pcsPrevOut (CPaymentChannelState _ (CFundingTxInfo h i _) _ _ _) = OutPoint h i+pcsPrevOut (CPaymentChannelState _ _ (CFundingTxInfo h i _) _ _ _ _) = OutPoint h i -pcsChannelID :: PaymentChannelState -> HT.OutPoint-pcsChannelID pcs = HT.OutPoint (ftiHash fti) (ftiOutIndex fti)+pcsChannelFundingSource :: PaymentChannelState -> HT.OutPoint+pcsChannelFundingSource pcs = HT.OutPoint (ftiHash fti) (ftiOutIndex fti)     where fti = pcsFundingTxInfo pcs  pcsGetPayment :: PaymentChannelState -> Payment-pcsGetPayment (CPaymentChannelState _ _ _ val sig) = CPayment val sig+pcsGetPayment (CPaymentChannelState _ _ _ _ _ val sig) = CPayment val sig  -- |Set new client/sender change address. -- Use this function if the client wishes to change its change address. -- First set the new change address using this function, then accept the payment which -- uses this new change address. setClientChangeAddress :: PaymentChannelState -> HC.Address -> PaymentChannelState-setClientChangeAddress pcs@(CPaymentChannelState _ _ pConf _ _) addr =+setClientChangeAddress pcs@(CPaymentChannelState _ _ _ pConf _ _ _) addr =     pcs { pcsPaymentConfig = newPayConf }         where newPayConf = pConf { ptcSenderChangeAddress = addr } @@ -47,7 +49,7 @@ --  This avoids creating a Bitcoin transaction that won't circulate --  in the Bitcoin P2P network. channelValueLeft :: PaymentChannelState -> BitcoinAmount-channelValueLeft pcs@(CPaymentChannelState (CChannelParameters _ _ _ dustLimit) _ _ _ _)   =+channelValueLeft pcs@(CPaymentChannelState (Config dustLimit _) _ _ _ _ _ _)   =     pcsClientChangeVal pcs - dustLimit  -- |Returns 'True' if all available channel value has been transferred, 'False' otherwise@@ -56,22 +58,25 @@     psSigHash (pcsPaymentSignature pcs) == HS.SigNone True ||         channelValueLeft pcs == 0 -newPaymentChannelState channelParameters fundingTxInfo paymentConfig paySig =+newPaymentChannelState cfg channelParameters fundingTxInfo paymentConfig paySig =     CPaymentChannelState {+        pcsConfig               = cfg,         pcsParameters           = channelParameters,         pcsFundingTxInfo        = fundingTxInfo,         pcsPaymentConfig        = paymentConfig,-        pcsClientChangeVal            = ftiOutValue fundingTxInfo,+        pcsPaymentCount         = 0,+        pcsClientChangeVal      = ftiOutValue fundingTxInfo,         pcsPaymentSignature     = paySig     } + -- |Update state with verified payment. updatePaymentChannelState  ::     PaymentChannelState     -> FullPayment     -> Either PayChanError PaymentChannelState-updatePaymentChannelState (CPaymentChannelState cp fun@(CFundingTxInfo h i _)-                          pconf@(CPaymentTxConfig addr) oldSenderVal _)+updatePaymentChannelState (CPaymentChannelState cfg cp fun@(CFundingTxInfo h i _)+                          pconf@(CPaymentTxConfig addr) payCount oldSenderVal _)     (CFullPayment payment@(CPayment newSenderVal _) payOP payScript payChgAddr)         | (HT.outPointHash payOP /= h) || (HT.outPointIndex payOP /= i) =             Left $ OutPointMismatch $ OutPoint h i@@ -79,13 +84,24 @@             Left $ ChangeAddrMismatch addr         | payScript /= getRedeemScript cp =             Left $ RedeemScriptMismatch $ getRedeemScript cp-        | newSenderVal <= oldSenderVal =-            CPaymentChannelState cp fun pconf newSenderVal . cpSignature <$>-                checkDustLimit cp payment-        | otherwise = Left $ BadPaymentValue (newSenderVal - oldSenderVal)+        | newSenderVal > oldSenderVal =+            Left $ BadPaymentValue (newSenderVal - oldSenderVal)+        | otherwise =+            CPaymentChannelState cfg cp fun pconf (payCount+1) newSenderVal . cpSignature <$>+                checkDustLimit cfg payment -checkDustLimit :: ChannelParameters -> Payment -> Either PayChanError Payment-checkDustLimit (CChannelParameters _ _ _ dustLimit) payment@(CPayment senderChangeVal _)+checkDustLimit :: Config -> Payment -> Either PayChanError Payment+checkDustLimit (Config dustLimit _) payment@(CPayment senderChangeVal _)     | senderChangeVal < dustLimit =         Left $ DustOutput dustLimit     | otherwise = Right payment++isPastLockTimeDate :: UTCTime -> Config -> ChannelParameters -> Bool+isPastLockTimeDate currentTime (Config _ settlePeriodHrs) (CChannelParameters _ _ (LockTimeDate expTime)) =+    currentTime > (settlePeriod `addUTCTime` expTime)+        where settlePeriod = -1 * fromIntegral (toSeconds settlePeriodHrs) :: NominalDiffTime+isPastLockTimeDate _ _ (CChannelParameters _ _ (LockTimeBlockHeight _)) =+    True+    -- We don't have the current Bitcoin block so we regard the channel as expired,+    -- in order to make we don't accept block count-based locktimes for now.+

@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveGeneric, DataKinds #-}  module Data.Bitcoin.PaymentChannel.Internal.Types (@@ -24,21 +24,27 @@ import qualified Network.Haskoin.Script as HS import           Data.Typeable import           Data.Word-import           GHC.Generics+import qualified Data.Tagged as Tag ++defaultConfig = Config defaultDustLimit defaultSettlementPeriod+ defaultDustLimit = 700 :: BitcoinAmount-defaultMinChanSize = defaultDustLimit * 2+defaultSettlementPeriod = 10 :: Hour  newtype UnsignedPaymentTx = CUnsignedPaymentTx { unsignedTx :: HT.Tx } deriving Show type FinalTx = HT.Tx  -- |Shared state object used by both value sender and value receiver. data PaymentChannelState = CPaymentChannelState {+    -- |Holds various optional configuration options+    pcsConfig               ::  Config,     -- |Defined by the sender and receiver     pcsParameters           ::  ChannelParameters,     -- |Retrieved by looking at the in-blockchain funding transaction     pcsFundingTxInfo        ::  FundingTxInfo,     pcsPaymentConfig        ::  PaymentTxConfig,+    pcsPaymentCount         ::  Word64,     -- |Client change value     pcsClientChangeVal      ::  BitcoinAmount,     -- |Signature over payment transaction of value 'pcsValueLeft'@@ -50,13 +56,7 @@     cpSenderPubKey      ::  SendPubKey,     cpReceiverPubKey    ::  RecvPubKey,     -- |Channel expiration date/time-    cpLockTime          ::  BitcoinLockTime,-    -- |Use a per-channel dust limit, such that when the remaining channel value-    --  hits this limit (rather than zero), we say the channel is exhausted.-    --  This avoids the relatively complex SigSingle/SigNone logic, and reduces-    --  a payment to just a ANYONECANPAY|SigSingle signature with a corresponding-    --  change output, which is set to the channel funding address.-    cpDustLimit         ::  BitcoinAmount+    cpLockTime          ::  BitcoinLockTime } deriving (Eq, Show, Typeable)  -- |Holds information about the Bitcoin transaction used to fund@@ -73,7 +73,17 @@     ptcSenderChangeAddress  ::  HC.Address } deriving (Eq, Show, Typeable) --- |Used to transfer value from sender to receiver.+-- |Miscellaneous configuration options+data Config = Config {+    -- | Refuse to accept/produce payments with a client change value less than this amount.+    cDustLimit          :: BitcoinAmount+    -- | This many hours before the channel expiration date, consider the channel closed.+    --  This gives the receiver time to publish the settlement transaction, before the+    --  refund transaction becomes valid.+  , cSettlementPeriod   :: Hour+} deriving (Eq, Show, Typeable)++-- |Contains the bare minimum of information to transfer value from sender to receiver. data Payment = CPayment {     -- |Channel value remaining ('pcsValueLeft' of the state from which this payment was made)     cpClientChange :: BitcoinAmount@@ -94,18 +104,14 @@ -- |Contains payment signature plus sig hash flag byte data PaymentSignature = CPaymentSignature {     psSig       ::  HC.Signature-    -- |SigHash flag. Denotes whether the sender still wants its change output-    --  included in the settling transaction. In case of (SigNone True), the-    --  value sender has given up the rest of the channel value, leaving-    --  everything to the receiver. This is necessary so that no settling-    --  transaction containing an output below the "dust limit" is produced.+    -- |SigHash flag. Always "SigSingle True".     ,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+-- Never confuse sender/receiver pubkey newtype SendPubKey = MkSendPubKey {     getSenderPK        ::  HC.PubKey } deriving (Eq, Show)@@ -121,3 +127,7 @@     getPubKey = getSenderPK instance IsPubKey RecvPubKey where     getPubKey = getReceiverPK++type Hour = Tag.Tagged "Hour" Word32+toSeconds :: Hour -> Integer+toSeconds = fromIntegral . (* 3600) . Tag.unTagged

@@ -1,190 +0,0 @@-{-|-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

@@ -12,50 +12,49 @@  module Data.Bitcoin.PaymentChannel.Types (-PaymentChannel(..),-SenderPaymentChannel(..),-ReceiverPaymentChannel(..),-Payment,cpSignature,-FullPayment(..),-FundingTxInfo(..),-ChannelParameters(..),-PayChanError(..),-PaymentChannelState,-SendPubKey(..),RecvPubKey(..),IsPubKey(..),-BitcoinAmount,-BitcoinLockTime(..), fromDate,-usesBlockHeight,---- Util-b64Encode,--- Constants-defaultDustLimit,+    PaymentChannel(..),+    SenderPaymentChannel(..),+    ReceiverPaymentChannel(..),+    Config(..),defaultConfig,+    Payment,cpSignature,+    FullPayment(..),+    FundingTxInfo(..),+    ChannelParameters(..),+    PayChanError(..),+    PaymentChannelState,+    SendPubKey(..),RecvPubKey(..),IsPubKey(..),+    BitcoinAmount,+    BitcoinLockTime(..), fromDate,+    usesBlockHeight ) where  import Data.Bitcoin.PaymentChannel.Internal.Types-import Data.Bitcoin.PaymentChannel.Internal.Serialization+import Data.Bitcoin.PaymentChannel.Internal.Serialization ()  import qualified Data.Bitcoin.PaymentChannel.Internal.State as S+import qualified Data.Bitcoin.PaymentChannel.Internal.Bitcoin.Script as Script import Data.Bitcoin.PaymentChannel.Internal.Error (PayChanError(..))  import qualified  Data.Serialize as Bin 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+import            Data.Word (Word64)   -- |Get various information about an open payment channel. class PaymentChannel a where-    -- |Get value sent to receiver/left for sender+    -- |Get amount received by receiver/left for sender     valueToMe           :: a -> BitcoinAmount     -- |Retrieve internal state object     getChannelState     :: a -> PaymentChannelState--    getChannelID        :: a -> HT.OutPoint+    getChannelFunding   :: a -> HT.OutPoint     getExpirationDate   :: a -> BitcoinLockTime     getSenderPubKey     :: a -> SendPubKey+    getFundingAmount    :: a -> BitcoinAmount+    getPaymentCount     :: a -> Word64+    fundingAddress      :: a -> HC.Address     getNewestPayment    :: a -> Payment     getNewestSig        :: a -> HC.Signature     -- |Return True if channel expires earlier than given expiration date@@ -68,9 +67,12 @@     -- |Returns 'True' if all available channel value has been transferred, 'False' otherwise     channelIsExhausted  :: a -> Bool -    getChannelID       = S.pcsChannelID . getChannelState+    getChannelFunding       = S.pcsChannelFundingSource . getChannelState     getExpirationDate  = S.pcsExpirationDate . getChannelState     getSenderPubKey    = S.pcsClientPubKey . getChannelState+    getFundingAmount   = S.pcsChannelTotalValue . getChannelState+    getPaymentCount    = pcsPaymentCount . getChannelState+    fundingAddress  = Script.getP2SHFundingAddress . pcsParameters . getChannelState     senderChangeValue  = pcsClientChangeVal . getChannelState     channelValueLeft   = S.channelValueLeft . getChannelState     channelIsExhausted = S.channelIsExhausted . getChannelState

@@ -17,16 +17,120 @@ import qualified Data.Serialize     as Bin import           Data.Typeable +import           Data.Time.Clock                 (UTCTime(..))+import           Data.Time.Calendar              (Day(..))+ import Test.QuickCheck-import Debug.Trace+import Test.Framework (Test, testGroup, defaultMain)+import Test.Framework.Providers.QuickCheck2 (testProperty) -dUST_LIMIT = 700 :: BitcoinAmount-mIN_CHANNEL_SIZE = 1400 :: BitcoinAmount+-- |We don't bother testing timestamps for now+nowishTimestamp :: UTCTime+nowishTimestamp = UTCTime (ModifiedJulianDay 57683) 0     -- 2016-10-22 -testAddrTestnet = "2N414xMNQaiaHCT5D7JamPz7hJEc9RG7469" :: HC.Address-testAddrLivenet = "14wjVnwHwMAXDr6h5Fw38shCWUB6RSEa63" :: HC.Address+mIN_CHANNEL_SIZE :: BitcoinAmount+mIN_CHANNEL_SIZE = cDustLimit defaultConfig * 2 +testAddrTestnet :: HC.Address+testAddrTestnet = "2N414xMNQaiaHCT5D7JamPz7hJEc9RG7469"+testAddrLivenet :: HC.Address+testAddrLivenet = "14wjVnwHwMAXDr6h5Fw38shCWUB6RSEa63" ++main :: IO ()+main = defaultMain tests++tests :: [Test]+tests =+    [ testGroup "Payment"+        [ testProperty "Sender value in settlement tx" $+            testPaymentSession checkSenderValue+        , testProperty "Receiver value in settlement tx" $+            testPaymentSession checkReceiverValue+        , testProperty "Sender/receiver state match" $+            testPaymentSession checkSendRecvStateMatch+        , testProperty "Sent amount == received amount" $+            testPaymentSession checkRecvSendAmount+        ]+    , testGroup "Serialization"+        [ testProperty "FullPayment JSON"   (jsonSerDeser :: FullPayment -> Bool)+        , testProperty "FullPayment Binary" testPaymentBin+        -- Fails: https://github.com/haskoin/haskoin/issues/287+        -- , testProperty "ChanScript ser/deser" testScriptBin+        ]+    ]++testPaymentJSON :: FullPayment -> Bool+testPaymentJSON = jsonSerDeser+testPaymentBin :: FullPayment -> Bool+testPaymentBin = binSerDeser+testScriptBin :: ChanScript -> Bool -- Fails: https://github.com/haskoin/haskoin/issues/287+testScriptBin = binSerDeser++checkSenderValue :: (ArbChannelPair, [BitcoinAmount]) -> Bool+checkSenderValue (ArbChannelPair _ recvChan amountSent _ recvSignFunc, _) = do+    let settleTx = getSettlementBitcoinTx recvChan recvSignFunc testAddrLivenet 0+    let clientChangeAmount = HT.outValue . head . HT.txOut $ settleTx+    -- Check that the client change amount in the settlement transaction equals the+    --  channel funding amount minus the sum of all payment amounts.+    let fundAmountMinusPaySum = S.pcsChannelTotalValue (getChannelState recvChan) -+            fromIntegral (sum amountSent)+    fromIntegral clientChangeAmount == fundAmountMinusPaySum++checkReceiverValue :: (ArbChannelPair, [BitcoinAmount]) -> Bool+checkReceiverValue (ArbChannelPair _ recvChan amountSent _ recvSignFunc, _) = do+    let settleTx = getSettlementBitcoinTx recvChan recvSignFunc testAddrLivenet 0+    let receiverAmount = HT.outValue (HT.txOut settleTx !! 1)+    -- Check receiver amount in settlement transaction with zero fee equals sum+    -- of all payments.+    (fromIntegral receiverAmount :: BitcoinAmount) == fromIntegral (sum amountSent)++checkSendRecvStateMatch :: (ArbChannelPair, [BitcoinAmount]) -> Bool+checkSendRecvStateMatch (ArbChannelPair sendChan recvChan _ _ _, _) =+    getChannelState sendChan == getChannelState recvChan++checkRecvSendAmount :: (ArbChannelPair, [BitcoinAmount]) -> Bool+checkRecvSendAmount (ArbChannelPair _ _ amountSent amountRecvd _, _) =+    amountSent == amountRecvd++testPaymentSession ::+    ((ArbChannelPair, [BitcoinAmount]) -> Bool)+    -> ArbChannelPair+    -> [BitcoinAmount]+    -> Bool+testPaymentSession testFunc arbChanPair paymentAmountList =+    testFunc (runChanPair arbChanPair paymentAmountList)++runChanPair :: ArbChannelPair -> [BitcoinAmount] -> (ArbChannelPair, [BitcoinAmount])+runChanPair chanPair paymentAmountList =+    (foldl doPayment chanPair paymentAmountList, 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++++ data ArbChannelPair = ArbChannelPair     SenderPaymentChannel ReceiverPaymentChannel [BitcoinAmount] [BitcoinAmount] (HC.Hash256 -> HC.Signature) @@ -39,7 +143,7 @@ doPayment (ArbChannelPair spc rpc sendList recvList f) amount =     let         (amountSent, pmn, newSpc) = sendPayment spc amount-        eitherRpc = recvPayment rpc pmn+        eitherRpc = recvPayment nowishTimestamp rpc pmn     in         case eitherRpc of             Left e -> error (show e)@@ -69,10 +173,10 @@     ArbitraryPubKey sendPriv sendPK <- arbitrary     -- receiver key pair     ArbitraryPubKey recvPriv recvPK <- arbitrary-    -- expiration date-    lockTime <- arbitrary+    -- TODO: We use an expiration date far off into the future for now+    let lockTime = parseBitcoinLocktime 2524651200     return (CChannelParameters-                (MkSendPubKey sendPK) (MkRecvPubKey recvPK) lockTime dUST_LIMIT,+                (MkSendPubKey sendPK) (MkRecvPubKey recvPK) lockTime,            (sendPriv, recvPriv))  mkChanPair :: Gen (ArbChannelPair, FullPayment)@@ -80,12 +184,11 @@         (cp, (sendPriv, recvPriv)) <- mkChanParams         fti <- arbitrary         -- value of first payment-        initPayAmount <- arbitrary -- fromIntegral <$> choose (0, chanAmount)+        initPayAmount <- arbitrary         -- create states-        let (initPayActualAmount,paymnt,sendChan) = channelWithInitialPaymentOf+        let (initPayActualAmount,paymnt,sendChan) = channelWithInitialPaymentOf defaultConfig                 cp fti (flip HC.signMsg sendPriv) (getFundingAddress cp) initPayAmount-        let eitherRecvChan = channelFromInitialPayment-                cp fti (getFundingAddress cp) paymnt+        let eitherRecvChan = channelFromInitialPayment nowishTimestamp defaultConfig cp fti paymnt         case eitherRecvChan of             Left e -> error (show e)             Right (initRecvAmount,recvChan) -> return@@ -94,9 +197,6 @@                         (flip HC.signMsg recvPriv),                     paymnt) -instance Arbitrary BitcoinLockTime where-    arbitrary = fmap parseBitcoinLocktime arbitrary- instance Arbitrary FundingTxInfo where     arbitrary = do         ArbitraryTxHash h <- arbitrary@@ -108,72 +208,3 @@  instance Arbitrary BitcoinAmount where     arbitrary = fromIntegral <$> choose (0, round $ 21e6 * 1e8 :: Integer)--runChanPair :: ArbChannelPair -> [BitcoinAmount] -> (ArbChannelPair, [BitcoinAmount])-runChanPair chanPair paymentAmountList =-    (foldl doPayment chanPair paymentAmountList, paymentAmountList)--checkChanPair :: (ArbChannelPair, [BitcoinAmount]) -> Bool-checkChanPair (ArbChannelPair sendChan recvChan amountSent amountRecvd recvSignFunc, _) = do-    let settleTx = getSettlementBitcoinTx recvChan recvSignFunc testAddrLivenet 0-    let clientChangeAmount = HT.outValue . head . HT.txOut $ settleTx-    -- Check that the client change amount in the settlement transaction equals the-    --  channel funding amount minus the sum of all payment amounts.-    let fundAmountMinusPaySum = S.pcsChannelTotalValue (getChannelState recvChan) --            fromIntegral (sum amountSent)-    let clientValueIsGood = fromIntegral clientChangeAmount == fundAmountMinusPaySum :: Bool-    -- Debug print-    let checkGoodClientValue goodCV = if not goodCV then-                error $ "Bad client change value. Actual: " ++ show clientChangeAmount ++-                        " should be " ++ show fundAmountMinusPaySum-            else-                goodCV-    -- Check that sender/receiver (client/server) agree on channel state-    let statesMatch = getChannelState recvChan == getChannelState sendChan-    -- Send/recv value lists match-    let recvSendAmountMatch = amountSent == amountRecvd-    checkGoodClientValue clientValueIsGood && statesMatch && recvSendAmountMatch----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 = do-    quickCheckWith stdArgs testPaymentSession-    quickCheckWith stdArgs testPaymentJSON-    quickCheckWith stdArgs testPaymentBin---     quickCheckWith stdArgs testScriptBin----