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 +3/−3
- src/Data/Bitcoin/PaymentChannel.hs +9/−5
- src/Data/Bitcoin/PaymentChannel/Internal/Error.hs +3/−1
- src/Data/Bitcoin/PaymentChannel/Internal/Payment.hs +4/−5
- src/Data/Bitcoin/PaymentChannel/Internal/Script.hs +3/−3
- src/Data/Bitcoin/PaymentChannel/Internal/Serialization.hs +83/−53
- src/Data/Bitcoin/PaymentChannel/Internal/Settlement.hs +3/−3
- src/Data/Bitcoin/PaymentChannel/Internal/State.hs +3/−0
- src/Data/Bitcoin/PaymentChannel/Internal/Types.hs +28/−9
- src/Data/Bitcoin/PaymentChannel/Internal/Util.hs +29/−12
- src/Data/Bitcoin/PaymentChannel/Types.hs +13/−6
- src/Data/Bitcoin/PaymentChannel/Util.hs +16/−5
- test/Main.hs +1/−1
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