packages feed

bitcoin-payment-channel 0.2.0.0 → 0.2.1.0

raw patch · 13 files changed

+198/−106 lines, 13 filesdep ~haskoin-corePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: haskoin-core

API changes (from Hackage documentation)

+ Data.Bitcoin.PaymentChannel.Types: InternalError :: String -> PayChanError
+ Data.Bitcoin.PaymentChannel.Types: MkRecvPubKey :: PubKey -> RecvPubKey
+ Data.Bitcoin.PaymentChannel.Types: MkSendPubKey :: PubKey -> SendPubKey
+ Data.Bitcoin.PaymentChannel.Types: [getReceiverPK] :: RecvPubKey -> PubKey
+ Data.Bitcoin.PaymentChannel.Types: [getSenderPK] :: SendPubKey -> PubKey
+ Data.Bitcoin.PaymentChannel.Types: class IsPubKey a
+ Data.Bitcoin.PaymentChannel.Types: expiresBefore :: PaymentChannel a => BitcoinLockTime -> a -> Bool
+ Data.Bitcoin.PaymentChannel.Types: getNewestPayment :: PaymentChannel a => a -> Payment
+ Data.Bitcoin.PaymentChannel.Types: getPubKey :: IsPubKey a => a -> PubKey
+ Data.Bitcoin.PaymentChannel.Types: newtype RecvPubKey
+ Data.Bitcoin.PaymentChannel.Types: newtype SendPubKey
+ Data.Bitcoin.PaymentChannel.Types: usesBlockHeight :: BitcoinLockTime -> Bool
+ Data.Bitcoin.PaymentChannel.Util: parseJSONInt :: Scientific -> Parser Integer
+ Data.Bitcoin.PaymentChannel.Util: unsafeUpdateRecvState :: ReceiverPaymentChannel -> Payment -> ReceiverPaymentChannel
- Data.Bitcoin.PaymentChannel: getSettlementBitcoinTx :: ReceiverPaymentChannel -> (Hash256 -> Signature) -> Address -> BitcoinAmount -> Either PayChanError Tx
+ Data.Bitcoin.PaymentChannel: getSettlementBitcoinTx :: ReceiverPaymentChannel -> (Hash256 -> Signature) -> Address -> BitcoinAmount -> Tx
- Data.Bitcoin.PaymentChannel.Types: CChannelParameters :: PubKey -> PubKey -> BitcoinLockTime -> ChannelParameters
+ Data.Bitcoin.PaymentChannel.Types: CChannelParameters :: SendPubKey -> RecvPubKey -> BitcoinLockTime -> ChannelParameters
- Data.Bitcoin.PaymentChannel.Types: [cpReceiverPubKey] :: ChannelParameters -> PubKey
+ Data.Bitcoin.PaymentChannel.Types: [cpReceiverPubKey] :: ChannelParameters -> RecvPubKey
- Data.Bitcoin.PaymentChannel.Types: [cpSenderPubKey] :: ChannelParameters -> PubKey
+ Data.Bitcoin.PaymentChannel.Types: [cpSenderPubKey] :: ChannelParameters -> SendPubKey
- Data.Bitcoin.PaymentChannel.Types: class PaymentChannel a where getChannelID = pcsChannelID . getChannelState getExpirationDate = pcsExpirationDate . getChannelState channelValueLeft = channelValueLeft . getChannelState channelIsExhausted = channelIsExhausted . getChannelState
+ Data.Bitcoin.PaymentChannel.Types: class PaymentChannel a where getChannelID = pcsChannelID . getChannelState getExpirationDate = pcsExpirationDate . getChannelState channelValueLeft = channelValueLeft . getChannelState channelIsExhausted = channelIsExhausted . getChannelState expiresBefore expDate chan = getExpirationDate chan < expDate getNewestPayment pcs = case pcsGetPayment (getChannelState pcs) of { Just payment -> payment Nothing -> error "BUG: PaymentChannel interface shouldn't allow payment-less PaymentChannel" }
- Data.Bitcoin.PaymentChannel.Util: deserEither :: Binary a => ByteString -> Either String a
+ Data.Bitcoin.PaymentChannel.Util: deserEither :: forall m a. (Typeable a, Binary a) => ByteString -> Either String a

Files

bitcoin-payment-channel.cabal view
@@ -1,5 +1,5 @@ name:                 bitcoin-payment-channel-version:              0.2.0.0+version:              0.2.1.0 synopsis:             Library for working with Bitcoin payment channels description:     A Bitcoin payment channel allows secure and instant transfer of bitcoins from one@@ -47,10 +47,10 @@                         Data.Bitcoin.PaymentChannel.Internal.Util,                         Data.Bitcoin.PaymentChannel.Internal.Version ---  ghc-options:          -Wall+  ghc-options:          -W    build-depends:        base >= 4.7 && < 5,-                        haskoin-core >= 0.3.0 && < 1.0.0,+                        haskoin-core >= 0.3.1 && < 1.0.0,                         bytestring, text, base16-bytestring, base58string, hexstring,                         base64-bytestring,                         time,
src/Data/Bitcoin/PaymentChannel.hs view
@@ -104,7 +104,7 @@ import qualified Data.Bitcoin.PaymentChannel.Internal.State as S     (channelValueLeft) import Data.Bitcoin.PaymentChannel.Internal.Payment-    (createPayment, verifyPayment)+    (createPayment, verifyPaymentSig) import Data.Bitcoin.PaymentChannel.Internal.Settlement     (getSignedSettlementTx, getSettlementTxHashForSigning) import Data.Bitcoin.PaymentChannel.Internal.Refund@@ -194,8 +194,8 @@     -> Payment -- ^Payment to verify and register     -> Either PayChanError (BitcoinAmount, ReceiverPaymentChannel) -- ^Value received plus new receiver state object recvPayment rpc@(CReceiverPaymentChannel oldState) paymnt =-    let verifyFunc hash pk sig = HC.verifySig hash sig pk in-    if verifyPayment oldState paymnt verifyFunc then+    let verifySenderPayment hash pk sig = HC.verifySig hash sig (getPubKey pk) in+    if verifyPaymentSig oldState paymnt verifySenderPayment then         updatePaymentChannelState oldState paymnt >>=         (\newState -> Right (             S.channelValueLeft oldState - S.channelValueLeft newState@@ -216,9 +216,13 @@     -> (HC.Hash256 -> HC.Signature) -- ^ Function which produces a signature, over a hash, which verifies against 'cpReceiverPubKey'     -> HC.Address     -> BitcoinAmount -- ^Bitcoin transaction fee-    -> Either PayChanError HT.Tx -- ^Settling Bitcoin transaction+    -> HT.Tx -- ^Settling Bitcoin transaction getSettlementBitcoinTx (CReceiverPaymentChannel cs) signFunc recvAddr txFee =-    getSignedSettlementTx cs recvAddr txFee serverSig+    nothingThrowInternal $ getSignedSettlementTx cs recvAddr txFee serverSig         where serverSig = signFunc (getSettlementTxHashForSigning cs recvAddr txFee)+              nothingThrowInternal Nothing =  error $+                  "tried to produce settlement transaction without any payments in state." +++                  " this should not be possible via the library interface."+              nothingThrowInternal (Just tx) = tx  
src/Data/Bitcoin/PaymentChannel/Internal/Error.hs view
@@ -6,7 +6,8 @@     BadSignature |     BadPaymentValue BitcoinAmount   |     NoValueTransferred |-    DustOutput+    DustOutput |+    InternalError String  instance Show PayChanError where     show BadSignature = "signature verification failed"@@ -15,4 +16,5 @@     show DustOutput = "dust output in payment transaction"     show NoValueTransferred = "cannot create payment Bitcoin transaction: no\     \ value has been transferred yet"+    show (InternalError e) = "Internal error: " ++ e 
src/Data/Bitcoin/PaymentChannel/Internal/Payment.hs view
@@ -49,18 +49,17 @@     PaymentChannelState     -> BitcoinAmount -- ^New sender value (newValueLeft)     -> (HC.Hash256, HS.SigHash)  -- ^Hash of payment transaction with a single output paying to senderPK-getPaymentTxHashForSigning st@(CPaymentChannelState-    cp@(CChannelParameters senderPK rcvrPK lt) _ _ _ _) newValueLeft =+getPaymentTxHashForSigning st@(CPaymentChannelState cp _ _ _ _) newValueLeft =         (HS.txSigHash tx (getRedeemScript cp) 0 sigHash, sigHash)             where (tx,sigHash) = getPaymentTxForSigning st newValueLeft  ---Payment build/verify----verifyPayment ::+verifyPaymentSig ::     PaymentChannelState     -> Payment-    -> (HC.Hash256 -> HC.PubKey -> HC.Signature -> Bool)+    -> (HC.Hash256 -> SendPubKey -> HC.Signature -> Bool)     -> Bool-verifyPayment pcs+verifyPaymentSig pcs     (CPayment newSenderVal (CPaymentSignature sig sigHash)) verifyFunc =         let (hash,_) = case sigHash of --SigHash in signature overrides newSenderVal                 HS.SigSingle True   -> getPaymentTxHashForSigning pcs newSenderVal
src/Data/Bitcoin/PaymentChannel/Internal/Script.hs view
@@ -32,14 +32,14 @@ sigHashToByte = fromIntegral . ord . head . C.unpack . serialize  -- |Generates OP_CHECKLOCKTIMEVERIFY redeemScript-paymentChannelRedeemScript :: HC.PubKey -> HC.PubKey -> Word32 -> Script+paymentChannelRedeemScript :: SendPubKey -> RecvPubKey -> Word32 -> Script paymentChannelRedeemScript clientPK serverPK lockTime = Script      [OP_IF,-         opPushData (serialize serverPK), OP_CHECKSIGVERIFY,+         opPushData $ serialize (getPubKey serverPK), OP_CHECKSIGVERIFY,      OP_ELSE,          encodeScriptInt lockTime, op_CHECKLOCKTIMEVERIFY, OP_DROP,      OP_ENDIF,-     opPushData (serialize clientPK), OP_CHECKSIG]+     opPushData $ serialize (getPubKey clientPK), OP_CHECKSIG]          where encodeScriptInt i = opPushData $ B.pack $ HI.encodeInt (fromIntegral i)             -- 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.
src/Data/Bitcoin/PaymentChannel/Internal/Serialization.hs view
@@ -1,58 +1,46 @@-{-# LANGUAGE  OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}  module Data.Bitcoin.PaymentChannel.Internal.Serialization where -import Data.Bitcoin.PaymentChannel.Internal.Types-import Data.Bitcoin.PaymentChannel.Internal.Util-    (BitcoinAmount(..), toWord64, deserEither, toHexString)+import           Data.Bitcoin.PaymentChannel.Internal.Types+import           Data.Bitcoin.PaymentChannel.Internal.Util+                            (BitcoinAmount(..), toWord64, deserEither, toHexString,+                             parseBitcoinLocktime, BitcoinLockTime(..), toWord32) -import            Data.Aeson (Value(Number), FromJSON(..), ToJSON(..),+import           Data.Aeson (Value(Number), FromJSON(..), ToJSON(..),                               withText, withScientific)-import            Data.Aeson.Types (Parser)-import            Data.Scientific (Scientific, scientific, toBoundedInteger)-import            Data.Text.Encoding       (decodeLatin1, encodeUtf8)-import            Data.ByteString.Lazy (toStrict, fromStrict)-import qualified  Data.Binary as Bin-import qualified  Data.Binary.Put as BinPut-import qualified  Data.Binary.Get as BinGet-import qualified  Data.ByteString.Base64.URL as B64+import           Data.Aeson.Types (Parser)+import           Data.Scientific (Scientific, scientific, toBoundedInteger)+import           Data.Text.Encoding       (decodeLatin1, encodeUtf8)+import           Data.ByteString.Lazy (toStrict, fromStrict)+import qualified Data.Binary as Bin+import qualified Data.Binary.Put as BinPut+import qualified Data.Binary.Get as BinGet+import qualified Data.ByteString.Base64.URL as B64 import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T+import           Data.Word (Word64) import           Data.EitherR (fmapL)+import           Data.Typeable  -instance Show Payment where-    show (CPayment val sig) =-        "<Payment: valLeft=" ++ show val ++-        ", sig=" ++ toHexString (toStrict $ Bin.encode sig) ++ ">" --------JSON-----------padToMod4 :: B.ByteString -> B.ByteString-padToMod4 bs =-    let-        lastGroupSize = B.length bs `mod` 4-        numPadChars = if lastGroupSize > 0 then 4 - lastGroupSize else 0-    in-        B.concat [bs, B.replicate numPadChars 61] -- 61: '=' ASCII--b64Encode :: Bin.Binary a => a -> B.ByteString-b64Encode = B64.encode . toStrict . Bin.encode--b64Decode :: Bin.Binary a => B.ByteString -> Either String a-b64Decode b64 =-    concatErr "failed to deserialize parsed base64 data: " . deserEither =<<-    (concatErr "failed to parse base64 data: ") (b64Decode b64)-        where-            b64Decode = B64.decode . padToMod4-            concatErr e = fmapL (e ++)+---- JSON+deriving instance ToJSON SendPubKey+deriving instance FromJSON SendPubKey+deriving instance ToJSON RecvPubKey+deriving instance FromJSON RecvPubKey -txtB64Encode :: Bin.Binary a => a -> T.Text-txtB64Encode = decodeLatin1 . b64Encode+instance ToJSON BitcoinLockTime where+    toJSON blt = Number $ scientific+        (fromIntegral $ toWord32 blt) 0 -txtB64Decode :: Bin.Binary a => T.Text -> Parser a-txtB64Decode = either fail return . b64Decode . encodeUtf8+instance FromJSON BitcoinLockTime where+    parseJSON = withScientific "BitcoinLockTime" $+        fmap (parseBitcoinLocktime . fromIntegral) . parseJSONInt  instance ToJSON Payment where     toJSON = toJSON . txtB64Encode@@ -74,19 +62,11 @@ instance FromJSON PaymentChannelState where     parseJSON = withText "PaychanState" txtB64Decode --- Needed to convert from Scientific-instance Bounded BitcoinAmount where-    minBound = CMoneyAmount 0-    maxBound = CMoneyAmount $ round $ 21e6 * 1e8 -parseJSONInt :: Scientific -> Parser Integer-parseJSONInt s =-    case toBoundedInteger s of-        Just (CMoneyAmount i) -> return i-        Nothing -> fail $ "failed to decode JSON number to integer. data: " ++ show s-+--- Binary+deriving instance Bin.Binary SendPubKey+deriving instance Bin.Binary RecvPubKey -------BINARY-------- instance Bin.Binary PaymentChannelState where     put (CPaymentChannelState par fti payConf valLeft (Just sig)) =         Bin.put par >> Bin.put fti >> Bin.put payConf >> Bin.put valLeft@@ -124,3 +104,53 @@         >> Bin.put (psSigHash ps)     get = CPaymentSignature <$> Bin.get <*> Bin.get ++--- Misc.+instance Show Payment where+    show (CPayment val sig) =+        "<Payment: valLeft=" ++ show val +++        ", sig=" ++ toHexString (toStrict $ Bin.encode sig) ++ ">"++    -- Needed to convert from Scientific+instance Bounded BitcoinAmount where+    minBound = CMoneyAmount 0+    maxBound = CMoneyAmount $ round $ 21e6 * 1e8+++--- Util+b64Encode :: Bin.Binary a => a -> B.ByteString+b64Encode = B64.encode . toStrict . Bin.encode++b64Decode :: (Typeable a, Bin.Binary a) => B.ByteString -> Either String a+b64Decode b64 =+    concatErr "failed to deserialize parsed base64 data: " . deserEither . BL.fromStrict =<<+    (concatErr "failed to parse base64 data: ") (b64Decode b64)+        where+            b64Decode = B64.decode . padToMod4+            concatErr e = fmapL (e ++)++txtB64Encode :: Bin.Binary a => a -> T.Text+txtB64Encode = decodeLatin1 . b64Encode++txtB64Decode :: (Typeable a, Bin.Binary a) => T.Text -> Parser a+txtB64Decode = either fail return . b64Decode . encodeUtf8++parseJSONInt :: Scientific -> Parser Integer+parseJSONInt s =+    case toBoundedInteger s of+        Just (CMoneyAmount i) -> return i+        Nothing -> fail $ "failed to decode JSON number to integer. data: " ++ show s++parseJSONWord :: Scientific -> Parser Word64+parseJSONWord s =+    case toBoundedInteger s of+        Just w -> return w+        Nothing -> fail $ "failed to decode JSON number to Word64. data: " ++ show s++padToMod4 :: B.ByteString -> B.ByteString+padToMod4 bs =+    let+        lastGroupSize = B.length bs `mod` 4+        numPadChars = if lastGroupSize > 0 then 4 - lastGroupSize else 0+    in+        B.concat [bs, B.replicate numPadChars 61] -- 61: '=' ASCII
src/Data/Bitcoin/PaymentChannel/Internal/Settlement.hs view
@@ -43,7 +43,7 @@     -> HC.Address       -- ^Receiver/server change address     -> BitcoinAmount    -- ^Bitcoin tx fee     -> HC.Signature     -- ^Signature over 'getSettlementTxHashForSigning' which verifies against serverPubKey-    -> Either PayChanError FinalTx+    -> Maybe FinalTx getSignedSettlementTx pcs@(CPaymentChannelState     cp@(CChannelParameters senderPK rcvrPK lt) _ _ _ (Just clientSig)) recvAddr txFee serverRawSig =         let@@ -51,7 +51,7 @@             serverSig = CPaymentSignature serverRawSig recvSigHash             inputScript = getInputScript cp $ paymentTxScriptSig clientSig serverSig         in-            Right $ replaceScriptInput (serialize inputScript) tx-getSignedSettlementTx (CPaymentChannelState _ _ _ _ Nothing) _ _ _ = Left NoValueTransferred+            Just $ replaceScriptInput (serialize inputScript) tx+getSignedSettlementTx (CPaymentChannelState _ _ _ _ Nothing) _ _ _ = Nothing  
src/Data/Bitcoin/PaymentChannel/Internal/State.hs view
@@ -24,6 +24,9 @@ pcsChannelID pcs = HT.OutPoint (ftiHash fti) (ftiOutIndex fti)     where fti = pcsFundingTxInfo pcs +pcsGetPayment :: PaymentChannelState -> Maybe Payment+pcsGetPayment (CPaymentChannelState _ _ _ val maybeSig) = CPayment val <$> maybeSig+ -- |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
src/Data/Bitcoin/PaymentChannel/Internal/Types.hs view
@@ -1,3 +1,5 @@+-- {-# LANGUAGE DeriveDataTypeable #-}+ module Data.Bitcoin.PaymentChannel.Internal.Types where  import Data.Bitcoin.PaymentChannel.Internal.Util@@ -11,6 +13,7 @@ import qualified  Data.Binary as Bin import qualified  Data.Binary.Put as BinPut import qualified  Data.Binary.Get as BinGet+import            Data.Typeable  dUST_LIMIT = 700 :: BitcoinAmount mIN_CHANNEL_SIZE = dUST_LIMIT * 2@@ -30,17 +33,17 @@     -- |Value left to send (starts at @ftiOutValue . pcsFundingTxInfo@)     pcsValueLeft            ::  BitcoinAmount,     -- |Signature over payment transaction of value 'pcsValueLeft'-    --  unless no payment has been made yet+    --  unless no payment has been registered yet     pcsPaymentSignature     ::  Maybe PaymentSignature-} deriving (Eq, Show)+} deriving (Eq, Show, Typeable) --- |Defines sender, receiver, and expiration date of the channel+-- |Defines channel: sender, receiver, and expiration date data ChannelParameters = CChannelParameters {-    cpSenderPubKey      ::  HC.PubKey,-    cpReceiverPubKey    ::  HC.PubKey,+    cpSenderPubKey      ::  SendPubKey,+    cpReceiverPubKey    ::  RecvPubKey,     -- |Channel expiration date/time     cpLockTime          ::  BitcoinLockTime-} deriving (Eq, Show)+} deriving (Eq, Show, Typeable)  -- |Holds information about the Bitcoin transaction used to fund -- the channel@@ -48,13 +51,13 @@     ftiHash         ::  HT.TxHash,      -- ^ Hash of funding transaction.     ftiOutIndex     ::  Word32,         -- ^ Index/"vout" of funding output     ftiOutValue     ::  BitcoinAmount   -- ^ Value of funding output (channel max value)-} deriving (Eq, Show)+} deriving (Eq, Show, Typeable)  -- |Holds information about how to construct the payment transaction data PaymentTxConfig = CPaymentTxConfig {     -- |Value sender change address     ptcSenderChangeAddress  ::  HC.Address-} deriving (Eq, Show)+} deriving (Eq, Show, Typeable)  -- |Used to transfer value from sender to receiver. data Payment = CPayment {@@ -62,7 +65,7 @@     cpChannelValueLeft ::  BitcoinAmount,     -- |Payment signature     cpSignature        ::  PaymentSignature-} deriving (Eq)+} deriving (Eq, Typeable)  -- |Contains payment signature plus sig hash flag byte data PaymentSignature = CPaymentSignature {@@ -73,6 +76,22 @@     --  everything to the receiver. This is necessary so that no settling     --  transaction containing an output below the "dust limit" is produced.     ,psSigHash  ::  HS.SigHash+} deriving (Eq, Show, Typeable)+++-- Never confuse sender/receiver pubkey again: let compiler check+newtype SendPubKey = MkSendPubKey {+    getSenderPK        ::  HC.PubKey } deriving (Eq, Show) +newtype RecvPubKey = MkRecvPubKey {+    getReceiverPK        ::  HC.PubKey+} deriving (Eq, Show) +class IsPubKey a where+    getPubKey :: a -> HC.PubKey++instance IsPubKey SendPubKey where+    getPubKey = getSenderPK+instance IsPubKey RecvPubKey where+    getPubKey = getReceiverPK
src/Data/Bitcoin/PaymentChannel/Internal/Util.hs view
@@ -1,16 +1,17 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}  module Data.Bitcoin.PaymentChannel.Internal.Util where  import Data.String (fromString) import qualified Data.Serialize as Ser (Serialize, encode, get, put)-import qualified Data.Serialize.Put as SerPut (putWord64be)-import qualified Data.Serialize.Get as SerGet (getWord64be)+import qualified Data.Serialize.Put as SerPut+import qualified Data.Serialize.Get as SerGet import qualified Data.Binary as Bin import qualified Data.Binary.Put as BinPut import qualified Data.Binary.Get as BinGet import Data.Binary.Put (putWord32le)-import Data.Binary.Get (getWord32le, runGetOrFail)+import Data.Binary.Get (getWord32le) import Data.Word import Data.Time.Clock import Data.Time.Clock.POSIX@@ -21,6 +22,8 @@ import qualified Network.Haskoin.Transaction as HT import qualified Network.Haskoin.Script as HS import qualified Network.Haskoin.Crypto as HC+import           Data.Typeable+-- import           Data.Text.p  mapLeft f  = either (Left . f) Right mapRight f = either Left (Right . f)@@ -63,8 +66,8 @@     get = CMoneyAmount . fromIntegral <$> BinGet.getWord64le  instance Ser.Serialize BitcoinAmount where-    put = SerPut.putWord64be . toWord64-    get = CMoneyAmount . fromIntegral <$> SerGet.getWord64be+    put = SerPut.putWord64le . toWord64+    get = CMoneyAmount . fromIntegral <$> SerGet.getWord64le   -- | Converts a pay-to-pubkey-hash address string to Script.@@ -99,19 +102,27 @@ deserialize :: Bin.Binary a => B.ByteString -> a deserialize = Bin.decode . BL.fromStrict -deserEither :: Bin.Binary a => B.ByteString -> Either String a-deserEither bs =-    case runGetOrFail Bin.get (BL.fromStrict bs) of-        Left (_,_,e) -> Left e-        Right (_,_,res) -> Right res+deserEither :: forall m a. (Typeable a, Bin.Binary a) => BL.ByteString -> Either String a+deserEither bs = do+    let eitherRes = Bin.decodeOrFail bs+    case eitherRes of+        Left (leftoverBS,offset,e)    -> Left $+            "Type: " ++ show (typeOf (undefined :: a)) +++            ". Error: " ++ e +++            ". Data consumed (" ++ show offset ++ " bytes): " +++            toHexString (BL.toStrict $ BL.take offset bs) +++            ". Unconsumed data: (" ++ show ( BL.length bs - fromIntegral offset ) ++ " bytes): " +++            toHexString (BL.toStrict leftoverBS)+        Right (_,_,val) -> Right val + ----------BITCOIN-----------  replaceScriptInput :: B.ByteString -> HT.Tx -> HT.Tx replaceScriptInput scriptIn (HT.Tx v (txIn:_) txOut lt)  =     HT.Tx v [newTxIn] txOut lt         where newTxIn = txIn { HT.scriptInput = scriptIn }-replaceScriptInput scriptIn (HT.Tx v [] txOut lt) =+replaceScriptInput scriptIn (HT.Tx _ [] _ _) =     error "cannot replace scriptInput without any inputs"  removeOutputs :: HT.Tx -> HT.Tx@@ -124,8 +135,10 @@ -- |Data type representing a Bitcoin LockTime, which specifies a point in time. --  Derive a 'BitcoinLockTime' from a 'Data.Time.Clock.UTCTime' using 'fromDate'. data BitcoinLockTime =+    -- |A value of "n" represents the point in time at which Bitcoin block number "n" appears     LockTimeBlockHeight Word32 |-    LockTimeDate UTCTime deriving (Eq)+    -- |Specifies a point in time using a timestamp with 1-second accuraccy+    LockTimeDate UTCTime deriving (Eq, Ord, Typeable)  instance Show BitcoinLockTime where     show (LockTimeBlockHeight blockNum) = "block number " ++ show blockNum@@ -136,6 +149,7 @@ parseBitcoinLocktime i     | i <   500000000 = LockTimeBlockHeight i     | i >=  500000000 = LockTimeDate $ posixSecondsToUTCTime (fromIntegral i)+    | otherwise       = error "GHC bug?"  -- | Convert to Bitcoin format ('Word32') toWord32 :: BitcoinLockTime -> Word32@@ -147,6 +161,9 @@ fromDate :: UTCTime -> BitcoinLockTime fromDate = LockTimeDate +usesBlockHeight :: BitcoinLockTime -> Bool+usesBlockHeight (LockTimeBlockHeight _) = True+usesBlockHeight _ = False   instance Bin.Binary BitcoinLockTime where
src/Data/Bitcoin/PaymentChannel/Types.hs view
@@ -20,9 +20,10 @@ ChannelParameters(..), PayChanError(..), PaymentChannelState,-+SendPubKey(..),RecvPubKey(..),IsPubKey(..), BitcoinAmount, toWord64, BitcoinLockTime(..), fromDate,+usesBlockHeight,  -- Util b64Encode,@@ -35,16 +36,14 @@ import Data.Bitcoin.PaymentChannel.Internal.Types     (PaymentChannelState(..), Payment(..)     ,FundingTxInfo(..), ChannelParameters(..),-    PaymentSignature(..),+    PaymentSignature(..), SendPubKey(..), RecvPubKey(..), IsPubKey(..),     dUST_LIMIT, mIN_CHANNEL_SIZE) import Data.Bitcoin.PaymentChannel.Internal.Serialization --     () import Data.Bitcoin.PaymentChannel.Internal.Util     (BitcoinAmount(..), toWord64,-    BitcoinLockTime(..), fromDate)-import qualified Data.Bitcoin.PaymentChannel.Internal.State as S (pcsChannelID, pcsChannelTotalValue,-                                                   setClientChangeAddress,-                                                   channelValueLeft, channelIsExhausted, pcsExpirationDate)+    BitcoinLockTime(..), fromDate, usesBlockHeight)+import qualified Data.Bitcoin.PaymentChannel.Internal.State as S import Data.Bitcoin.PaymentChannel.Internal.Error (PayChanError(..)) -- import Data.Bitcoin.PaymentChannel.Internal.Types () import qualified  Data.Binary as Bin@@ -61,6 +60,9 @@     getChannelState     :: a -> PaymentChannelState     getChannelID        :: a -> HT.OutPoint     getExpirationDate   :: a -> BitcoinLockTime+    getNewestPayment    :: a -> Payment+    -- |Return True if channel expires earlier than given expiration date+    expiresBefore       :: BitcoinLockTime -> a -> Bool     -- |For internal use     _setChannelState    :: a -> PaymentChannelState -> a @@ -73,7 +75,12 @@      channelValueLeft   = S.channelValueLeft . getChannelState     channelIsExhausted = S.channelIsExhausted . getChannelState+    expiresBefore expDate chan = getExpirationDate chan < expDate ++    getNewestPayment pcs = case S.pcsGetPayment (getChannelState pcs) of+            Just payment -> payment+            Nothing      -> error "BUG: PaymentChannel interface shouldn't allow payment-less PaymentChannel"  -- |State object for the value sender data SenderPaymentChannel = CSenderPaymentChannel {
src/Data/Bitcoin/PaymentChannel/Util.hs view
@@ -14,20 +14,27 @@ setSenderChangeAddress,  serialize, serialize',-BitcoinLockTime, parseBitcoinLocktime, toWord32, fromDate, deserEither+BitcoinLockTime, parseBitcoinLocktime, toWord32, fromDate, deserEither,+parseJSONInt,++unsafeUpdateRecvState ) where  import Data.Bitcoin.PaymentChannel.Internal.Types-    (PaymentChannelState(..), PaymentTxConfig(..))+    (PaymentChannelState(..), PaymentTxConfig(..),+    Payment(..)) -- import Data.Bitcoin.PaymentChannel.Internal.State --     (ptcSenderChangeAddress) import Data.Bitcoin.PaymentChannel.Internal.Script     (getP2SHFundingAddress) import Data.Bitcoin.PaymentChannel.Internal.Util-    (BitcoinLockTime, parseBitcoinLocktime, toWord32, fromDate, deserEither, serialize, serialize')+    (BitcoinLockTime, parseBitcoinLocktime, toWord32, fromDate, deserEither,+     serialize, serialize') import Data.Bitcoin.PaymentChannel.Internal.State     (setClientChangeAddress)+import Data.Bitcoin.PaymentChannel.Internal.Serialization+    (parseJSONInt)  import Data.Bitcoin.PaymentChannel.Types --     (ChannelParameters, FundingTxInfo)@@ -46,6 +53,10 @@ setSenderChangeAddress pch addr =     _setChannelState pch (setClientChangeAddress (getChannelState pch) addr) --+-- |Update internal state without signature verification.+-- Useful for database-type services where a logic layer has already+--  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 = Just sig} 
test/Main.hs view
@@ -42,7 +42,7 @@         ArbitraryPubKey recvPriv recvPK <- arbitrary         -- expiration date         lockTime <- arbitrary-        let cp = CChannelParameters sendPK recvPK lockTime+        let cp = CChannelParameters (MkSendPubKey sendPK) (MkRecvPubKey recvPK) lockTime          fti <- arbitrary