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.1.1.2 +version: 0.1.1.3 synopsis: Library for working with Bitcoin payment channels description: A Bitcoin payment channel allows secure and instant transfer of bitcoins from one 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 @@ -101,6 +101,8 @@ (PaymentTxConfig(..), pcsValueLeft, cpChannelValueLeft) import Data.Bitcoin.PaymentChannel.Internal.State (newPaymentChannelState, updatePaymentChannelState) +import qualified Data.Bitcoin.PaymentChannel.Internal.State as S + (channelValueLeft) import Data.Bitcoin.PaymentChannel.Internal.Payment (createPayment, verifyPayment) import Data.Bitcoin.PaymentChannel.Internal.Settlement @@ -175,15 +177,14 @@ -> FundingTxInfo -- ^ Holds information about the transaction used to fund the channel -> HC.Address -- ^ Value sender/client change address -> Payment -- ^Initial channel payment - -> Either PayChanError ReceiverPaymentChannel -- ^Receiver state object + -> Either PayChanError (BitcoinAmount, ReceiverPaymentChannel) -- ^Error or: value_received plus state object channelFromInitialPayment cp@(CChannelParameters sendPK recvPK _) fundInf sendAddr paymnt = let pConf = CPaymentTxConfig sendAddr - eitherNewState = flip recvPayment paymnt $ CReceiverPaymentChannel - (newPaymentChannelState cp fundInf pConf) in - mapRight snd eitherNewState + flip recvPayment paymnt $ CReceiverPaymentChannel + (newPaymentChannelState cp fundInf pConf) -- |Register, on the receiving side, a payment made by 'sendPayment' on the sending side. -- Returns error if either the signature or payment amount is invalid, and otherwise @@ -192,11 +193,14 @@ ReceiverPaymentChannel -- ^Receiver state object -> Payment -- ^Payment to verify and register -> Either PayChanError (BitcoinAmount, ReceiverPaymentChannel) -- ^Value received plus new receiver state object -recvPayment rpc@(CReceiverPaymentChannel cs) paymnt = +recvPayment rpc@(CReceiverPaymentChannel oldState) paymnt = let verifyFunc hash pk sig = HC.verifySig hash sig pk in - if verifyPayment cs paymnt verifyFunc then - updatePaymentChannelState cs paymnt >>= - (\newState -> Right (pcsValueLeft cs - cpChannelValueLeft paymnt, rpc { rpcState = newState })) + if verifyPayment oldState paymnt verifyFunc then + updatePaymentChannelState oldState paymnt >>= + (\newState -> Right ( + S.channelValueLeft oldState - S.channelValueLeft newState + , rpc { rpcState = newState }) + ) else Left BadSignature 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 @@ -1,13 +1,18 @@ module Data.Bitcoin.PaymentChannel.Internal.Error where +import Data.Bitcoin.PaymentChannel.Internal.Util (BitcoinAmount) + data PayChanError = BadSignature | - BadPayment | - NoValueTransferred + BadPaymentValue BitcoinAmount | + NoValueTransferred | + DustOutput instance Show PayChanError where - show BadSignature = "signature failed verification" - show BadPayment = "payment amount to receiver less than previous payment" + show BadSignature = "signature verification failed" + show (BadPaymentValue valDiff) = + "out-of-order payment (assigns " ++ show valDiff ++ " less value to server)" + show DustOutput = "dust output in payment transaction" show NoValueTransferred = "cannot create payment Bitcoin transaction: no\ \ value has been transferred yet" 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,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + module Data.Bitcoin.PaymentChannel.Internal.Serialization where import Data.Bitcoin.PaymentChannel.Internal.Types @@ -13,7 +15,8 @@ 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 as B64 +import qualified Data.ByteString.Base64.URL as B64 +import qualified Data.ByteString as B import Debug.Trace @@ -25,18 +28,28 @@ ", 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 + instance ToJSON Payment where - toJSON = toJSON . decodeLatin1 . B64.encode . toStrict . Bin.encode + toJSON = toJSON . decodeLatin1 . b64Encode instance FromJSON Payment where parseJSON = withText "Payment" $ \b64 -> - failOnLeftWith "failed to deserialize binary data: " =<< - (\h -> show (toHexString h) `trace` binaryDeser h) =<< - failOnLeftWith "failed to parse base64 data: " =<< b64Decode b64 + failOnLeftWith "failed to deserialize binary data: " . deserEither =<< + (failOnLeftWith "failed to parse base64 data: " . b64Decode) b64 where - b64Decode = return . B64.decode . encodeUtf8 - binaryDeser = return . deserEither + b64Decode = B64.decode . padToMod4 . encodeUtf8 failOnLeftWith e = either (fail . (e ++)) return instance ToJSON BitcoinAmount where 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 @@ -4,10 +4,11 @@ import Data.Bitcoin.PaymentChannel.Internal.Types import Data.Bitcoin.PaymentChannel.Internal.Error -import Data.Bitcoin.PaymentChannel.Internal.Util (addressToScriptPubKeyBS) +import Data.Bitcoin.PaymentChannel.Internal.Util (addressToScriptPubKeyBS, BitcoinAmount) 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 @@ -28,8 +29,19 @@ pcs { pcsPaymentConfig = newPayConf } where newPayConf = pConf { ptcSenderChangeAddress = addr } +-- | +channelValueLeft :: PaymentChannelState -> BitcoinAmount +channelValueLeft pcs = + if channelIsExhausted pcs then 0 else pcsValueLeft pcs --- pcsChannelIsExhausted cs = maybe False (\pSig -> psSigHash pSig == ) (pcsPaymentSignature cs) +-- |Returns 'True' if all available channel value has been transferred, 'False' otherwise +channelIsExhausted :: PaymentChannelState -> Bool +channelIsExhausted pcs = + case pcsPaymentSignature pcs of + Nothing -> False + -- Channel can be auto-closed when sender has given up all value + -- which requires a SigNone signature + Just paySig -> psSigHash paySig == HS.SigNone True newPaymentChannelState channelParameters fundingTxInfo paymentConfig = CPaymentChannelState { @@ -46,7 +58,14 @@ -> Payment -> Either PayChanError PaymentChannelState updatePaymentChannelState pcs@(CPaymentChannelState par fun pconf oldSenderVal oldSig) - (CPayment newSenderVal newSig) + payment@(CPayment newSenderVal newSig) | newSenderVal <= oldSenderVal = - Right $ CPaymentChannelState par fun pconf newSenderVal (Just newSig) - | otherwise = Left BadPayment + fmap (Just . cpSignature) (checkDustLimit payment) >>= + return . (CPaymentChannelState par fun pconf newSenderVal) -- (Just newSig) + | otherwise = Left $ BadPaymentValue (newSenderVal - oldSenderVal) + +checkDustLimit :: Payment -> Either PayChanError Payment +checkDustLimit payment@(CPayment senderChangeVal sig) + | senderChangeVal < dUST_LIMIT = + if psSigHash sig /= HS.SigNone True then Left DustOutput else Right payment + | otherwise = Right payment 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 @@ -52,10 +52,8 @@ -- |Holds information about how to construct the payment transaction data PaymentTxConfig = CPaymentTxConfig { - -- |Value sender change scriptPubKey in Bitcoin payment transaction + -- |Value sender change address ptcSenderChangeAddress :: HC.Address - -- |Value receiver destination scriptPubKey in Bitcoin payment transaction --- ptcReceiverChangeScript :: B.ByteString } deriving (Eq, Show) -- |Used to transfer value from sender to receiver. @@ -77,19 +75,4 @@ ,psSigHash :: HS.SigHash } deriving (Eq, Show) - - --- Universally unique payment. --- Contains the necessary information to identify the channel --- over which the payment was sent, the signature (including SigHash flag) --- and amount (for verification), as well as the protocol version. --- data ChannelPayment = CChannelPayment { --- -- |Payment protocol version (currently 2.x) --- cpVersion :: Version, --- -- |Channel ID is the regular Bitcoin double-SHA256 hash of the funding transaction --- cpChannelID :: HT.TxHash, --- cpPayment :: Payment, --- -- |Optional info field --- cpInfo :: Maybe BS.ByteString --- } 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 @@ -49,7 +49,7 @@ newtype BitcoinAmount = CMoneyAmount Integer deriving (Eq, Ord, Num, Enum, Real, Integral) instance Show BitcoinAmount where - show ma = show (fromIntegral $ toWord64 ma) ++ " satoshis" + show ma = show (fromIntegral $ toWord64 ma) ++ " satoshi" -- | Convert to 'Word64', with zero as floor, UINT64_MAX as ceiling toWord64 :: BitcoinAmount -> Word64 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 @@ -24,6 +24,8 @@ BitcoinAmount, toWord64, BitcoinLockTime, fromDate, +-- Util +b64Encode, -- Constants dUST_LIMIT, mIN_CHANNEL_SIZE @@ -33,40 +35,42 @@ import Data.Bitcoin.PaymentChannel.Internal.Types (PaymentChannelState(..), Payment(..) ,FundingTxInfo(..), ChannelParameters(..), + PaymentSignature(..), dUST_LIMIT, mIN_CHANNEL_SIZE) import Data.Bitcoin.PaymentChannel.Internal.Serialization -- () import Data.Bitcoin.PaymentChannel.Internal.Util (BitcoinAmount(..), toWord64, BitcoinLockTime, fromDate) -import Data.Bitcoin.PaymentChannel.Internal.State (pcsChannelID, pcsChannelTotalValue, - setClientChangeAddress) +import qualified Data.Bitcoin.PaymentChannel.Internal.State as S (pcsChannelID, pcsChannelTotalValue, + setClientChangeAddress, + channelValueLeft, channelIsExhausted) import Data.Bitcoin.PaymentChannel.Internal.Error (PayChanError(..)) - +-- import Data.Bitcoin.PaymentChannel.Internal.Types () import qualified Data.Binary as Bin import qualified Network.Haskoin.Crypto as HC import qualified Network.Haskoin.Transaction as HT +import qualified Network.Haskoin.Script as HS -- |Get various information about an open payment channel. class PaymentChannel a where -- |Get value sent to receiver/left for sender valueToMe :: a -> BitcoinAmount - channelValueLeft :: a -> BitcoinAmount -- |Retrieve internal state object getChannelState :: a -> PaymentChannelState -- |Get channel ID getChannelID :: a -> HT.TxHash - -- |Returns 'True' if all available channel value has been transferred, 'False' otherwise - channelIsExhausted :: a -> Bool -- |For internal use _setChannelState :: a -> PaymentChannelState -> a - channelValueLeft = pcsValueLeft . getChannelState - getChannelID = pcsChannelID . getChannelState - channelIsExhausted pch = pcsValueLeft (getChannelState pch) == 0 --TODO: payment sigHash == SigSingle - + channelValueLeft :: a -> BitcoinAmount + -- |Returns 'True' if all available channel value has been transferred, 'False' otherwise + channelIsExhausted :: a -> Bool + getChannelID = S.pcsChannelID . getChannelState + channelValueLeft = S.channelValueLeft . getChannelState + channelIsExhausted = S.channelIsExhausted . getChannelState -- |State object for the value sender data SenderPaymentChannel = CSenderPaymentChannel { @@ -82,22 +86,16 @@ newtype ReceiverPaymentChannel = CReceiverPaymentChannel { -- |Internal state object rpcState :: PaymentChannelState - -- |Used to verify signatures from value sender. --- rpcVerifyFunc :: HC.Hash256 -> HC.PubKey -> HC.Signature -> Bool - -- |Function which produces a signature that verifies against 'cpReceiverPubKey'. - -- Used to produce the Bitcoin transaction that closes the channel. --- rpcSignFunc :: HC.Hash256 -> HC.Signature } deriving (Eq, Bin.Binary) instance PaymentChannel SenderPaymentChannel where - valueToMe (CSenderPaymentChannel s _) = - pcsValueLeft s + valueToMe = channelValueLeft getChannelState = spcState _setChannelState spc s = spc { spcState = s } instance PaymentChannel ReceiverPaymentChannel where - valueToMe (CReceiverPaymentChannel s) = - pcsChannelTotalValue s - pcsValueLeft s + valueToMe rpc@(CReceiverPaymentChannel s) = + S.pcsChannelTotalValue s - channelValueLeft rpc getChannelState = rpcState _setChannelState rpc s = rpc { rpcState = s } diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -58,7 +58,7 @@ case eitherRecvChan of Left e -> error (show e) --return $ Left (show e) - Right recvChan -> return $ ArbChannelPair sendChan recvChan + Right (val,recvChan) -> return $ ArbChannelPair sendChan recvChan instance Arbitrary BitcoinLockTime where arbitrary = fmap parseBitcoinLocktime arbitrary