packages feed

bitcoin-payment-channel 0.1.1.2 → 0.1.1.3

raw patch · 9 files changed

+86/−64 lines, 9 files

Files

bitcoin-payment-channel.cabal view
@@ -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
src/Data/Bitcoin/PaymentChannel.hs view
@@ -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
src/Data/Bitcoin/PaymentChannel/Internal/Error.hs view
@@ -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"
src/Data/Bitcoin/PaymentChannel/Internal/Serialization.hs view
@@ -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
src/Data/Bitcoin/PaymentChannel/Internal/State.hs view
@@ -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
src/Data/Bitcoin/PaymentChannel/Internal/Types.hs view
@@ -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--- }
src/Data/Bitcoin/PaymentChannel/Internal/Util.hs view
@@ -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
src/Data/Bitcoin/PaymentChannel/Types.hs view
@@ -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 }
test/Main.hs view
@@ -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