diff --git a/bitcoin-payment-channel.cabal b/bitcoin-payment-channel.cabal --- a/bitcoin-payment-channel.cabal +++ b/bitcoin-payment-channel.cabal @@ -1,5 +1,5 @@ name: bitcoin-payment-channel -version: 0.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, diff --git a/src/Data/Bitcoin/PaymentChannel.hs b/src/Data/Bitcoin/PaymentChannel.hs --- a/src/Data/Bitcoin/PaymentChannel.hs +++ b/src/Data/Bitcoin/PaymentChannel.hs @@ -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 diff --git a/src/Data/Bitcoin/PaymentChannel/Internal/Error.hs b/src/Data/Bitcoin/PaymentChannel/Internal/Error.hs --- a/src/Data/Bitcoin/PaymentChannel/Internal/Error.hs +++ b/src/Data/Bitcoin/PaymentChannel/Internal/Error.hs @@ -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 diff --git a/src/Data/Bitcoin/PaymentChannel/Internal/Payment.hs b/src/Data/Bitcoin/PaymentChannel/Internal/Payment.hs --- a/src/Data/Bitcoin/PaymentChannel/Internal/Payment.hs +++ b/src/Data/Bitcoin/PaymentChannel/Internal/Payment.hs @@ -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 diff --git a/src/Data/Bitcoin/PaymentChannel/Internal/Script.hs b/src/Data/Bitcoin/PaymentChannel/Internal/Script.hs --- a/src/Data/Bitcoin/PaymentChannel/Internal/Script.hs +++ b/src/Data/Bitcoin/PaymentChannel/Internal/Script.hs @@ -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. diff --git a/src/Data/Bitcoin/PaymentChannel/Internal/Serialization.hs b/src/Data/Bitcoin/PaymentChannel/Internal/Serialization.hs --- a/src/Data/Bitcoin/PaymentChannel/Internal/Serialization.hs +++ b/src/Data/Bitcoin/PaymentChannel/Internal/Serialization.hs @@ -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) = - "" --------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) = + "" + + -- 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 diff --git a/src/Data/Bitcoin/PaymentChannel/Internal/Settlement.hs b/src/Data/Bitcoin/PaymentChannel/Internal/Settlement.hs --- a/src/Data/Bitcoin/PaymentChannel/Internal/Settlement.hs +++ b/src/Data/Bitcoin/PaymentChannel/Internal/Settlement.hs @@ -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 diff --git a/src/Data/Bitcoin/PaymentChannel/Internal/State.hs b/src/Data/Bitcoin/PaymentChannel/Internal/State.hs --- a/src/Data/Bitcoin/PaymentChannel/Internal/State.hs +++ b/src/Data/Bitcoin/PaymentChannel/Internal/State.hs @@ -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 diff --git a/src/Data/Bitcoin/PaymentChannel/Internal/Types.hs b/src/Data/Bitcoin/PaymentChannel/Internal/Types.hs --- a/src/Data/Bitcoin/PaymentChannel/Internal/Types.hs +++ b/src/Data/Bitcoin/PaymentChannel/Internal/Types.hs @@ -1,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 diff --git a/src/Data/Bitcoin/PaymentChannel/Internal/Util.hs b/src/Data/Bitcoin/PaymentChannel/Internal/Util.hs --- a/src/Data/Bitcoin/PaymentChannel/Internal/Util.hs +++ b/src/Data/Bitcoin/PaymentChannel/Internal/Util.hs @@ -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 diff --git a/src/Data/Bitcoin/PaymentChannel/Types.hs b/src/Data/Bitcoin/PaymentChannel/Types.hs --- a/src/Data/Bitcoin/PaymentChannel/Types.hs +++ b/src/Data/Bitcoin/PaymentChannel/Types.hs @@ -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 { diff --git a/src/Data/Bitcoin/PaymentChannel/Util.hs b/src/Data/Bitcoin/PaymentChannel/Util.hs --- a/src/Data/Bitcoin/PaymentChannel/Util.hs +++ b/src/Data/Bitcoin/PaymentChannel/Util.hs @@ -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} diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -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