packages feed

bitcoin-payment-channel 0.3.0.1 → 0.4.0.0

raw patch · 13 files changed

+504/−133 lines, 13 filesdep +string-conversionsdep −base58string

Dependencies added: string-conversions

Dependencies removed: base58string

Files

bitcoin-payment-channel.cabal view
@@ -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,
src/Data/Bitcoin/PaymentChannel.hs view
@@ -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 })
src/Data/Bitcoin/PaymentChannel/Internal/Bitcoin/Script.hs view
@@ -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]
src/Data/Bitcoin/PaymentChannel/Internal/Error.hs view
@@ -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"
src/Data/Bitcoin/PaymentChannel/Internal/Payment.hs view
@@ -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
src/Data/Bitcoin/PaymentChannel/Internal/Serialization.hs view
@@ -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) =         "<Payment: valLeft=" ++ show val ++         ", sig=" ++ toHexString (Bin.encode sig) ++ ">" +instance Show FullPayment where+    show (CFullPayment p op script addr) =+        "<FullPayment: payment = " ++ show p ++ " " +++        show (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
src/Data/Bitcoin/PaymentChannel/Internal/State.hs view
@@ -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
src/Data/Bitcoin/PaymentChannel/Internal/Types.hs view
@@ -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 {
src/Data/Bitcoin/PaymentChannel/Internal/Util.hs view
@@ -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
+ src/Data/Bitcoin/PaymentChannel/Movable.hs view
@@ -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
src/Data/Bitcoin/PaymentChannel/Types.hs view
@@ -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 {
src/Data/Bitcoin/PaymentChannel/Util.hs view
@@ -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
test/Main.hs view
@@ -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