bitcoin-payment-channel (empty) → 0.1.0.0
raw patch · 14 files changed
+994/−0 lines, 14 filesdep +basedep +base16-bytestringdep +base58stringsetup-changed
Dependencies added: base, base16-bytestring, base58string, binary, bytestring, cereal, haskoin-core, hexstring, text, time
Files
- Setup.hs +2/−0
- bitcoin-payment-channel.cabal +55/−0
- src/Data/Bitcoin/PaymentChannel.hs +214/−0
- src/Data/Bitcoin/PaymentChannel/Internal/Error.hs +13/−0
- src/Data/Bitcoin/PaymentChannel/Internal/Payment.hs +93/−0
- src/Data/Bitcoin/PaymentChannel/Internal/Refund.hs +39/−0
- src/Data/Bitcoin/PaymentChannel/Internal/Script.hs +82/−0
- src/Data/Bitcoin/PaymentChannel/Internal/Settlement.hs +54/−0
- src/Data/Bitcoin/PaymentChannel/Internal/State.hs +41/−0
- src/Data/Bitcoin/PaymentChannel/Internal/Types.hs +128/−0
- src/Data/Bitcoin/PaymentChannel/Internal/Util.hs +141/−0
- src/Data/Bitcoin/PaymentChannel/Internal/Version.hs +8/−0
- src/Data/Bitcoin/PaymentChannel/Types.hs +91/−0
- src/Data/Bitcoin/PaymentChannel/Util.hs +33/−0
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bitcoin-payment-channel.cabal view
@@ -0,0 +1,55 @@+name: bitcoin-payment-channel+version: 0.1.0.0+synopsis: Library for working with Bitcoin payment channels+description:+ A Bitcoin payment channel allows two parties two send value to each other very rapidly.+ The speed of the value transfer is limited primarily by network latency, and payments+ cannot be double spent, as the receiver of funds is defined during channel setup.+ The channel setup procedure is trustless, in that the funding party is able to retrieve the funds,+ after a chosen expiration date, in case the receiving party goes missing.++ This library implements a type of payment channel (CHECKLOCKTIMEVERIFY-style) where channel setup+ is safe from transaction ID malleability, and value transfer is uni-directional (one party+ sends and the other party receives).++author: Rune K. Svendsen <runesvend@gmail.com>+maintainer: Rune K. Svendsen <runesvend@gmail.com>+license: PublicDomain+stability: experimental+homepage: https://github.com/runeksvendsen/bitcoin-payment-channel+bug-reports: https://github.com/runeksvendsen/bitcoin-payment-channel/issues+category: Bitcoin, Finance, Network+build-type: Simple+cabal-version: >=1.10++source-repository head+ type: git+ location: git://github.com/runeksvendsen/bitcoin-payment-channel.git++library+ exposed-modules: Data.Bitcoin.PaymentChannel,+ Data.Bitcoin.PaymentChannel.Types,+ Data.Bitcoin.PaymentChannel.Util++ other-modules:+ Data.Bitcoin.PaymentChannel.Internal.Error+ Data.Bitcoin.PaymentChannel.Internal.Payment,+ Data.Bitcoin.PaymentChannel.Internal.Refund,+ Data.Bitcoin.PaymentChannel.Internal.Script,+ Data.Bitcoin.PaymentChannel.Internal.Settlement,+ Data.Bitcoin.PaymentChannel.Internal.State,+ Data.Bitcoin.PaymentChannel.Internal.Types,+ Data.Bitcoin.PaymentChannel.Internal.Util,+ Data.Bitcoin.PaymentChannel.Internal.Version++ ghc-options: -fwarn-incomplete-patterns++ build-depends: base >= 4.7 && < 5,+ bytestring, text, base16-bytestring, base58string, hexstring,+ time,+ cereal, binary,+ haskoin-core++ hs-source-dirs: src++ default-language: Haskell2010
+ src/Data/Bitcoin/PaymentChannel.hs view
@@ -0,0 +1,214 @@+{-|+Module : Data.Bitcoin.PaymentChannel+Description : Bitcoin payment channel library+Copyright : (c) Rune K. Svendsen, 2016+License : PublicDomain+Maintainer : runesvend@gmail.com+Stability : experimental+Portability : POSIX++In order to set up a payment channel between a sender and a receiver, the two parties must+ first agree on three parameters for the channel:++ (1) sender public key+ (2) receiver public key+ (3) channel expiration date++ These parameters+ are contained in 'ChannelParameters', from which a channel funding+ address can be derived using+ 'getFundingAddress'. The transaction which pays to this address is the channel funding+ transaction, and information about it is contained in a 'FundingTxInfo'.+ So, the channel funding transaction will contain an output which pays to the address returned by+ 'getFundingAddress', and once this transaction is created and in+ the blockchain, a 'SenderPaymentChannel' and+ 'ReceiverPaymentChannel' instance can be created, after first creating the 'FundingTxInfo' instance.+ 'FundingTxInfo' contains three pieces of information about the funding transaction:++ (1) hash/transaction ID+ (2) index/vout of the funding output (paying to 'getFundingAddress' address),+ (3) value of the funding output (paying to 'getFundingAddress' address)++With 'ChannelParameters' and 'FundingTxInfo',+ the sender can create a new 'SenderPaymentChannel', plus+ the first channel payment, using 'channelWithInitialPaymentOf'. 'channelWithInitialPaymentOf'+ takes two additional arguments:++ (1) a signing function which, given a hash, produces a signature that verifies against+ 'cpSenderPubKey' in 'ChannelParameters'+ (2) the value of the first channel payment++ The sender will want to use @flip 'Network.Haskoin.Crypto.signMsg' senderPrivKey@ as the signing+ function, where @senderPrivKey@ is the private key from which 'cpSenderPubKey' is derived.+ 'channelWithInitialPaymentOf' will return the first channel 'Payment' as well as+ the new 'SenderPaymentChannel' state. The new state is stored, and the 'Payment'+ transferred to the receiver.++The receiver will now create its own channel state object, 'ReceiverPaymentChannel', using+ 'channelFromInitialPayment'.+ 'channelFromInitialPayment' takes the same 'ChannelParameters' and 'FundingTxInfo'+ as was provided by the sender, and, in addition, the receiver signing function+ (used to produce the settlement transaction+ that closes the payment channel), and the first channel 'Payment', received from the sender.+ The receiver will want to use @flip 'Network.Haskoin.Crypto.signMsg' receiverPrivKey@ as the signing function,+ where @<receiverPrivKey>@ is the private key from which 'cpReceiverPubKey' is derived.++Now the payment channel is open and ready for transmitting value. A new 'Payment' is created by+ the sender with 'sendPayment', which yields a new payment, that increases the total value transmitted+ to the receiver by the specified amount, and an updated 'Data.Bitcoin.PaymentChannel.Types.SenderPaymentChannel' state.+ The receiver will verify and register this 'Payment' on its side using 'recvPayment', which, on success,+ returns the value received with this payment plus the updated+ 'ReceiverPaymentChannel' state object.++Payments can flow from the sender to receiver until either the channel is exhausted, or getting+ close to expiration (see important note below). In either case the receiver will use 'getSettlementBitcoinTx' to create the settlement+ Bitcoin transaction, and publish this transaction to the Bitcoin network. The settlement Bitcoin+ transaction pays the total value transmitted over the channel to the receiver and the rest back+ to the sender.++__/IMPORTANT:/__ /Channel setup is risk free because the sender can derive a refund Bitcoin transaction/+ /using 'getRefundBitcoinTx', which returns the bitcoins used to fund the channel back to the sender./+ /This refund transaction, however, is not valid until the expiration date specified in 'ChannelParameters',/+ /but it is paramount that the value receiver gets a settlement transaction included in a block/+ /before the refund transaction becomes valid. Due to the fact that Bitcoin network time is allowed/+ /to drift up to two hours from actual time, and the fact that finding new Bitcoin blocks does not occur/+ /according to any schedule, it would be wise for the receiver to publish a settlement transaction at least/+ /4 hours before the specified channel expiration time, and possibly earlier, if the receiver wants to/+ /be cautious./++-}++module Data.Bitcoin.PaymentChannel+(+ channelWithInitialPaymentOf,+ sendPayment,++ channelFromInitialPayment,+ recvPayment,++ getSettlementBitcoinTx,+ getRefundBitcoinTx,++ getFundingAddress+)+where++import Data.Bitcoin.PaymentChannel.Internal.Error+ (PayChanError(..))+import Data.Bitcoin.PaymentChannel.Internal.Types+ (PaymentTxConfig(..), pcsValueLeft, cpChannelValueLeft)+import Data.Bitcoin.PaymentChannel.Internal.State+ (newPaymentChannelState, updatePaymentChannelState)+import Data.Bitcoin.PaymentChannel.Internal.Payment+ (createPayment, verifyPayment)+import Data.Bitcoin.PaymentChannel.Internal.Settlement+ (getSignedSettlementTx, getSettlementTxHashForSigning)+import Data.Bitcoin.PaymentChannel.Internal.Refund+ (refundTxAddSignature, getRefundTxHashForSigning)+import Data.Bitcoin.PaymentChannel.Internal.Util+ (bitcoinPayPKBS, mapRight)++import Data.Bitcoin.PaymentChannel.Util (getFundingAddress)+import Data.Bitcoin.PaymentChannel.Types++import qualified Network.Haskoin.Crypto as HC+import qualified Network.Haskoin.Transaction as HT+++-- |Create a new 'SenderPaymentChannel'.+-- A 'SenderPaymentChannel' object is created by supplying information about+-- the channel and the funding transaction, as well as the value of the first payment.+-- Returns a new 'SenderPaymentChannel' state object and the first channel payment.+channelWithInitialPaymentOf ::+ ChannelParameters -- ^ Specifies channel sender and receiver, plus channel expiration date+ -> FundingTxInfo -- ^ Holds information about the transaction used to fund the channel+ -> (HC.Hash256 -> HC.Signature) -- ^ See 'spcSignFunc'+ -> BitcoinAmount -- ^ Value of initial payment. Must be greater than or equal to 'minimumInitialPayment'+ -> (Payment, SenderPaymentChannel) -- ^Initial payment and new sender state object+channelWithInitialPaymentOf+ cp@(CChannelParameters sendPK recvPK _)+ fundInf@(CFundingTxInfo hash idx chanVal) signFunc amount =+ let pConf = CPaymentTxConfig (bitcoinPayPKBS sendPK) (bitcoinPayPKBS recvPK) in+ sendPayment+ (CSenderPaymentChannel (newPaymentChannelState cp fundInf pConf) signFunc)+ amount++-- |Create new payment of specified value.+sendPayment ::+ SenderPaymentChannel -- ^Sender state object+ -> BitcoinAmount -- ^ Amount to send (the actual payment amount is capped so that it doesn't overflow the maximum channel value)+ -> (Payment, SenderPaymentChannel) -- ^ Payment and updated sender state object+sendPayment (CSenderPaymentChannel cs signFunc) amountToSend =+ let+ valSent = min (pcsValueLeft cs) amountToSend+ newSenderValue = pcsValueLeft cs - valSent+ payment = createPayment cs newSenderValue signFunc+ in+ case updatePaymentChannelState cs payment of+ Right newCS ->+ (payment+ ,CSenderPaymentChannel newCS signFunc)+ Left _ -> error "BUG #3: sendPayment should not be able to rewind payments"++-- |Produces a Bitcoin transaction which sends all channel funds back to the sender.+-- Will not be accepted by the Bitcoin network until the expiration time specified in+-- 'ChannelParameters'. Receiver beware of Bitcoin network time drift and the+-- unpreditable nature of finding new blocks.+getRefundBitcoinTx ::+ SenderPaymentChannel -- ^Sender state object+ -> BitcoinAmount -- ^Refund transaction fee+ -> HT.Tx -- ^Refund Bitcoin transaction+getRefundBitcoinTx (CSenderPaymentChannel cs signFunc) txFee =+ refundTxAddSignature cs txFee $ signFunc $ getRefundTxHashForSigning cs txFee+++-- |Create new 'ReceiverPaymentChannel'.+-- A channel is initialized with various information+-- about the payment channel, as well as the first channel payment+-- produced by the sender.+channelFromInitialPayment ::+ ChannelParameters -- ^ Specifies channel sender and receiver, plus channel expiration date+ -> FundingTxInfo -- ^ Holds information about the transaction used to fund the channel+ -> (HC.Hash256 -> HC.Signature) -- ^ Function which produces a signature, over a hash, which verifies against 'cpReceiverPubKey'+ -> Payment -- ^Initial channel payment+ -> Either PayChanError ReceiverPaymentChannel -- ^Receiver state object+channelFromInitialPayment cp@(CChannelParameters sendPK recvPK _)+ fundInf signFunc paymnt =+ let+ verifyFunc hash pk sig = HC.verifySig hash sig pk+ pConf = CPaymentTxConfig (bitcoinPayPKBS sendPK) (bitcoinPayPKBS recvPK)+ eitherNewState = flip recvPayment paymnt $ CReceiverPaymentChannel+ (newPaymentChannelState cp fundInf pConf) verifyFunc signFunc+ in+ mapRight snd eitherNewState++-- |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+-- the amount received with this 'Payment' and a new state object.+recvPayment ::+ 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 verifyFunc _) paymnt =+ if verifyPayment cs paymnt verifyFunc then+ updatePaymentChannelState cs paymnt >>=+ (\newState -> Right (pcsValueLeft cs - cpChannelValueLeft paymnt, rpc { rpcState = newState }))+ else+ Left BadSignature+++-- |The value transmitted over the channel is settled when this transaction is in the Blockchain.+-- The receiver will want to make sure a transaction produced by this function+-- is included in a Bitcoin block before the refund transaction becomes valid (see 'getRefundBitcoinTx').+-- The sender can only close the channel before expiration by requesting this transaction+-- from the receiver and publishing it to the Bitcoin network.+-- Returns NoValueTransferred if no payment has been received yet.+getSettlementBitcoinTx ::+ ReceiverPaymentChannel -- ^Receiver state object+ -> BitcoinAmount -- ^Bitcoin transaction fee+ -> Either PayChanError HT.Tx -- ^Settling Bitcoin transaction+getSettlementBitcoinTx (CReceiverPaymentChannel cs verifyFunc signFunc) txFee =+ getSignedSettlementTx cs txFee serverSig+ where serverSig = signFunc (getSettlementTxHashForSigning cs txFee)++
+ src/Data/Bitcoin/PaymentChannel/Internal/Error.hs view
@@ -0,0 +1,13 @@+module Data.Bitcoin.PaymentChannel.Internal.Error where++data PayChanError =+ BadSignature |+ BadPayment |+ NoValueTransferred++instance Show PayChanError where+ show BadSignature = "signature failed verification"+ show BadPayment = "payment amount to receiver less than previous payment"+ show NoValueTransferred = "cannot create payment Bitcoin transaction: no\+ \ value has been transferred yet"+
+ src/Data/Bitcoin/PaymentChannel/Internal/Payment.hs view
@@ -0,0 +1,93 @@++module Data.Bitcoin.PaymentChannel.Internal.Payment where++import Data.Bitcoin.PaymentChannel.Internal.Types+import Data.Bitcoin.PaymentChannel.Internal.State+import Data.Bitcoin.PaymentChannel.Internal.Script+import Data.Bitcoin.PaymentChannel.Internal.Util+import Data.Bitcoin.PaymentChannel.Internal.Error++import qualified Network.Haskoin.Transaction as HT+import qualified Network.Haskoin.Internals as HI+import qualified Network.Haskoin.Crypto as HC+import qualified Network.Haskoin.Script as HS+import Data.Word (Word32, Word64, Word8)+import Data.Maybe (fromJust, isJust)+import qualified Data.ByteString as B+++buildEmptyPaymentTx :: FundingTxInfo -> HT.Tx+buildEmptyPaymentTx (CFundingTxInfo hash idx _) =+ HT.Tx 1 --version 1+ -- Redeems payment channel output from blockchain Tx+ [HT.TxIn+ (HT.OutPoint hash idx)+ B.empty+ maxBound]+ []+ 0++paymentTxAddOutput :: HT.TxOut -> HT.Tx -> (HT.Tx, HS.SigHash)+paymentTxAddOutput addOut tx@(HT.Tx _ _ outs _)+ | HT.outValue addOut >= dUST_LIMIT =+ (tx { HT.txOut = outs ++ [addOut] }, HS.SigSingle True)+ | otherwise =+ (tx, HS.SigNone True)++getPaymentTxForSigning ::+ PaymentChannelState+ -> BitcoinAmount -- ^New sender value (newValueLeft)+ -> (HT.Tx, HS.SigHash)+getPaymentTxForSigning st@(CPaymentChannelState _ fti+ (CPaymentTxConfig sendChg _) chanValLeft _) newValueLeft =+ paymentTxAddOutput senderOut $ buildEmptyPaymentTx fti+ where senderOut = HT.TxOut (toWord64 newValueLeft) sendChg++getPaymentTxHashForSigning ::+ 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 =+ (HS.txSigHash tx (getRedeemScript cp) 0 sigHash, sigHash)+ where (tx,sigHash) = getPaymentTxForSigning st newValueLeft++verifyPayment ::+ PaymentChannelState+ -> Payment+ -> (HC.Hash256 -> HC.PubKey -> HC.Signature -> Bool)+ -> Bool+verifyPayment pcs+ (CPayment newSenderVal (CPaymentSignature sig sigHash)) verifyFunc =+ let (hash,_) = case sigHash of --SigHash in signature overrides newSenderVal+ HS.SigSingle True -> getPaymentTxHashForSigning pcs newSenderVal+ --sender has relinquished remaining channel value+ HS.SigNone True -> getPaymentTxHashForSigning pcs 0+ unknownSigHash -> (dummyHash256,sigHash) --will fail verification+ in+ verifyFunc hash (pcsClientPubKey pcs) sig++createPayment ::+ PaymentChannelState+ -> BitcoinAmount -- ^ newSenderVal+ -> (HC.Hash256 -> HC.Signature) -- ^ signing function+ -> Payment+createPayment pcs@(CPaymentChannelState _ _ _ currSenderVal _)+ newSenderVal signFunc =+ let+ (hash,sigHash) = getPaymentTxHashForSigning pcs newSenderVal+ sig = signFunc hash+ pSig = CPaymentSignature sig sigHash+ in+ case sigHash of+ HS.SigSingle _ -> CPayment newSenderVal pSig+ --sender has reliquished the remaining channel value,+ -- due to it being below the "dust" limit.+ HS.SigNone _ -> CPayment 0 pSig+ HS.SigAll _ -> error "BUG: unsupported SigHash"+ HS.SigUnknown _ _ -> error "BUG: unsupported SigHash"+++++
+ src/Data/Bitcoin/PaymentChannel/Internal/Refund.hs view
@@ -0,0 +1,39 @@+module Data.Bitcoin.PaymentChannel.Internal.Refund where++import Data.Bitcoin.PaymentChannel.Internal.Types+import Data.Bitcoin.PaymentChannel.Internal.State+import Data.Bitcoin.PaymentChannel.Internal.Script+import Data.Bitcoin.PaymentChannel.Internal.Payment+import Data.Bitcoin.PaymentChannel.Internal.Util++import qualified Network.Haskoin.Transaction as HT+import qualified Network.Haskoin.Crypto as HC+import qualified Network.Haskoin.Script as HS++getUnsignedRefundTx :: PaymentChannelState -> BitcoinAmount -> HT.Tx+getUnsignedRefundTx st txFee = -- @CPaymentChannelState =+ let+ (baseTx,_) = getPaymentTxForSigning st 0 --create empty payment tx, which redeems funding tx+ refundOut = HT.TxOut (toWord64 $ pcsChannelTotalValue st - txFee) (pcsClientChange st)+ in+ baseTx { HT.txOut = [refundOut] }++getRefundTxHashForSigning ::+ PaymentChannelState+ -> BitcoinAmount -- ^Bitcoin transaction fee+ -> HC.Hash256+getRefundTxHashForSigning pcs@(CPaymentChannelState cp _ _ _ _) newValueLeft =+ HS.txSigHash tx (getRedeemScript cp) 0 (HS.SigAll False)+ where tx = getUnsignedRefundTx pcs newValueLeft++refundTxAddSignature ::+ PaymentChannelState+ -> BitcoinAmount -- ^Bitcoin tx fee+ -> HC.Signature -- ^Signature over 'getUnsignedRefundTx' which verifies against clientPubKey+ -> FinalTx+refundTxAddSignature pcs@(CPaymentChannelState cp _ _ _ _) txFee clientRawSig =+ let+ inputScript = getInputScript cp $ refundTxScriptSig clientRawSig+ in+ replaceScriptInput (serialize inputScript) $ getUnsignedRefundTx pcs txFee+
+ src/Data/Bitcoin/PaymentChannel/Internal/Script.hs view
@@ -0,0 +1,82 @@+-- {-# OPTIONS_GHC -fwarn-incomplete-patterns -Werror #-}++module Data.Bitcoin.PaymentChannel.Internal.Script where++import Data.Bitcoin.PaymentChannel.Internal.Types+import Data.Bitcoin.PaymentChannel.Internal.Util++import qualified Network.Haskoin.Internals as HI+import qualified Network.Haskoin.Util as HU+import qualified Network.Haskoin.Crypto as HC+import Network.Haskoin.Script++import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as C+import qualified Data.ByteString.Lazy as BL+import qualified Data.Binary as Bin+import Data.Word+import Data.Char as CH++valReceiverSigHash = SigAll True++getSigHashFlag :: BitcoinAmount -> SigHash+getSigHashFlag valueToSender =+ if valueToSender == 0 then+ SigNone True+ else+ SigSingle True++sigHashToByte :: SigHash -> Word8+sigHashToByte = fromIntegral . ord . head . C.unpack . serialize++-- |Generates OP_CHECKLOCKTIMEVERIFY redeemScript+paymentChannelRedeemScript :: HC.PubKey -> HC.PubKey -> Word32 -> Script+paymentChannelRedeemScript clientPK serverPK lockTime = Script+ [OP_IF,+ opPushData (serialize serverPK), OP_CHECKSIGVERIFY,+ OP_ELSE,+ encodeScriptInt lockTime, op_CHECKLOCKTIMEVERIFY, OP_DROP,+ OP_ENDIF,+ opPushData (serialize 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.++-- |scriptSig fulfilling a payment channel redeemScript+paymentTxScriptSig :: PaymentSignature -> PaymentSignature -> Script --ScriptSig+paymentTxScriptSig clientSig serverSig = Script+ [opPushData $ serialize clientSig, --sig including SigHash byte+ opPushData $ serialize serverSig, --sig including SigHash byte+ OP_1]++-- |scriptSig used for the valueSender refund transaction+refundTxScriptSig :: HC.Signature -> Script+refundTxScriptSig clientSig = Script+ [opPushData (B.append (serialize clientSig) hashTypeByte),+ OP_0]+ where hashTypeByte = serialize (SigAll False)++-----Util-----++op_CHECKLOCKTIMEVERIFY = OP_NOP2++scriptToP2SHAddress :: Script -> HC.Address+scriptToP2SHAddress = HC.ScriptAddress . HC.hash160 . HC.getHash256 . HC.hash256 . serialize+++getP2SHFundingAddress :: ChannelParameters -> HC.Address+getP2SHFundingAddress = scriptToP2SHAddress . getRedeemScript++getRedeemScript :: ChannelParameters -> Script --RedeemScript+getRedeemScript (CChannelParameters senderPK recvrPK lockTime) =+ paymentChannelRedeemScript senderPK recvrPK (toWord32 lockTime)++getRedeemScriptBS :: ChannelParameters -> B.ByteString+getRedeemScriptBS = serialize . getRedeemScript++getInputScript :: ChannelParameters -> Script -> Script+getInputScript cp scriptSig =+ Script $ scriptOps scriptSig ++ redeemScript+ where+ redeemScript = [opPushData $ getRedeemScriptBS cp]+
+ src/Data/Bitcoin/PaymentChannel/Internal/Settlement.hs view
@@ -0,0 +1,54 @@+module Data.Bitcoin.PaymentChannel.Internal.Settlement where++import Data.Bitcoin.PaymentChannel.Internal.Types+import Data.Bitcoin.PaymentChannel.Internal.Payment+import Data.Bitcoin.PaymentChannel.Internal.State+import Data.Bitcoin.PaymentChannel.Internal.Script+import Data.Bitcoin.PaymentChannel.Internal.Util+import Data.Bitcoin.PaymentChannel.Internal.Error++import qualified Network.Haskoin.Transaction as HT+import qualified Network.Haskoin.Internals as HI+import qualified Network.Haskoin.Crypto as HC+import qualified Network.Haskoin.Script as HS+++getSettlementTxForSigning ::+ PaymentChannelState+ -> BitcoinAmount -- ^Bitcoin transaction fee for final payment transaction+ -> (HT.Tx, HS.SigHash) -- ^ Transaction plus valueReceiver SigHash+getSettlementTxForSigning st@(CPaymentChannelState _ fti@(CFundingTxInfo _ _ channelTotalValue)+ (CPaymentTxConfig sendChg recvChg) senderVal (Just (CPaymentSignature sig sigHash))) txFee =+ let+ (baseTx,_) = getPaymentTxForSigning st senderVal+ adjTx = if sigHash == HS.SigNone True then removeOutputs baseTx else baseTx+ receiverAmount = channelTotalValue - senderVal - txFee -- may be less than zero+ recvOut = HT.TxOut (toWord64 receiverAmount) recvChg+ in+ paymentTxAddOutput recvOut adjTx+getSettlementTxForSigning _ _ = error "no payment sig available"++getSettlementTxHashForSigning ::+ PaymentChannelState+ -> BitcoinAmount -- ^Bitcoin transaction fee+ -> HC.Hash256+getSettlementTxHashForSigning pcs@(CPaymentChannelState cp _ _ _ _) txFee =+ HS.txSigHash tx (getRedeemScript cp) 0 sigHash+ where (tx,sigHash) = getSettlementTxForSigning pcs txFee++getSignedSettlementTx ::+ PaymentChannelState+ -> BitcoinAmount -- ^Bitcoin tx fee+ -> HC.Signature -- ^Signature over 'getSettlementTxHashForSigning' which verifies against serverPubKey+ -> Either PayChanError FinalTx+getSignedSettlementTx pcs@(CPaymentChannelState+ cp@(CChannelParameters senderPK rcvrPK lt) _ _ _ (Just clientSig)) txFee serverRawSig =+ let+ (tx,recvSigHash) = getSettlementTxForSigning pcs txFee+ serverSig = CPaymentSignature serverRawSig recvSigHash+ inputScript = getInputScript cp $ paymentTxScriptSig clientSig serverSig+ in+ Right $ replaceScriptInput (serialize inputScript) tx+getSignedSettlementTx (CPaymentChannelState _ _ _ _ Nothing) _ _ = Left NoValueTransferred++
+ src/Data/Bitcoin/PaymentChannel/Internal/State.hs view
@@ -0,0 +1,41 @@+-- {-# OPTIONS_GHC -fwarn-incomplete-patterns -Werror #-}++module Data.Bitcoin.PaymentChannel.Internal.State where++import Data.Bitcoin.PaymentChannel.Internal.Types+import Data.Bitcoin.PaymentChannel.Internal.Error++import qualified Network.Haskoin.Transaction as HT++pcsChannelTotalValue = ftiOutValue . pcsFundingTxInfo+pcsValueTransferred cs = pcsChannelTotalValue cs - pcsValueLeft cs+pcsChannelValueLeft = pcsValueLeft+pcsClientPubKey = cpSenderPubKey . pcsParameters+pcsServerPubKey = cpReceiverPubKey . pcsParameters+pcsClientChange = ptcSenderChangeScript . pcsPaymentConfig+pcsServerChange = ptcReceiverChangeScript . pcsPaymentConfig+pcsLockTime = cpLockTime . pcsParameters+pcsChannelID = ftiHash . pcsFundingTxInfo+++-- pcsChannelIsExhausted cs = maybe False (\pSig -> psSigHash pSig == ) (pcsPaymentSignature cs)++newPaymentChannelState channelParameters fundingTxInfo paymentConfig =+ CPaymentChannelState {+ pcsParameters = channelParameters,+ pcsFundingTxInfo = fundingTxInfo,+ pcsPaymentConfig = paymentConfig,+ pcsValueLeft = ftiOutValue fundingTxInfo,+ pcsPaymentSignature = Nothing+ }++-- |Update state with verified payment+updatePaymentChannelState ::+ PaymentChannelState+ -> Payment+ -> Either PayChanError PaymentChannelState+updatePaymentChannelState pcs@(CPaymentChannelState par fun pconf oldSenderVal oldSig)+ (CPayment newSenderVal newSig)+ | newSenderVal <= oldSenderVal =+ Right $ CPaymentChannelState par fun pconf newSenderVal (Just newSig)+ | otherwise = Left BadPayment
+ src/Data/Bitcoin/PaymentChannel/Internal/Types.hs view
@@ -0,0 +1,128 @@+module Data.Bitcoin.PaymentChannel.Internal.Types where++import Data.Bitcoin.PaymentChannel.Internal.Util+import Data.Bitcoin.PaymentChannel.Internal.Version++import qualified Network.Haskoin.Transaction as HT+import qualified Network.Haskoin.Crypto as HC+import qualified Network.Haskoin.Script as HS+import qualified Data.ByteString as B+import Data.Word (Word32, Word64, Word8)+import qualified Data.Binary as Bin+import qualified Data.Binary.Put as BinPut+import qualified Data.Binary.Get as BinGet++dUST_LIMIT = 700 :: Word64+mIN_CHANNEL_SIZE = dUST_LIMIT * 2+pROTOCOL_VERSION = CVersion 2 0++newtype UnsignedPaymentTx = CUnsignedPaymentTx { unsignedTx :: HT.Tx } deriving Show+type FinalTx = HT.Tx++-- |Shared state object used by both value sender and value receiver.+data PaymentChannelState = CPaymentChannelState {+ pcsParameters :: ChannelParameters,+ pcsFundingTxInfo :: FundingTxInfo,+ pcsPaymentConfig :: PaymentTxConfig,+ -- |Value left to send+ pcsValueLeft :: BitcoinAmount,+ -- |Signature over payment transaction of value 'pcsValueLeft'+ -- unless no payment has been made yet+ pcsPaymentSignature :: Maybe PaymentSignature+} deriving (Eq, Show)++-- |Holds information about the channel+data ChannelParameters = CChannelParameters {+ cpSenderPubKey :: HC.PubKey,+ cpReceiverPubKey :: HC.PubKey,+ -- |Channel expiration date/time+ cpLockTime :: BitcoinLockTime+} deriving (Eq, Show)++-- |Holds information about the Bitcoin transaction used to fund+-- the channel+data FundingTxInfo = CFundingTxInfo {+ 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)++-- |Holds information about how to construct the payment transaction+data PaymentTxConfig = CPaymentTxConfig {+ -- |Value sender change scriptPubKey in Bitcoin payment transaction+ ptcSenderChangeScript :: B.ByteString,+ -- |Value receiver destination scriptPubKey in Bitcoin payment transaction+ ptcReceiverChangeScript :: B.ByteString+} deriving (Eq, Show)++-- |Used to transfer value from sender to receiver.+data Payment = CPayment {+ -- |Channel value remaining ('pcsValueLeft' of the state from which this payment was made)+ cpChannelValueLeft :: BitcoinAmount,+ -- |Payment signature+ cpSignature :: PaymentSignature+}++-- |Contains payment signature plus sig hash flag byte+data PaymentSignature = CPaymentSignature {+ psSig :: HC.Signature+ ,psSigHash :: HS.SigHash+} deriving (Eq, Show)++------SERIALIZATION--------++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+ >> BinPut.putWord8 1 >> Bin.put sig+ put (CPaymentChannelState par fti payConf valLeft Nothing) =+ Bin.put par >> Bin.put fti >> Bin.put payConf >> Bin.put valLeft+ >> BinPut.putWord8 0+ get = CPaymentChannelState <$> Bin.get <*> Bin.get <*>+ Bin.get <*> Bin.get <*> (BinGet.getWord8 >>=+ \w -> case w of+ 1 -> fmap Just Bin.get+ _ -> return Nothing)++instance Bin.Binary ChannelParameters where+ put (CChannelParameters pks pkr lt) =+ Bin.put pks >> Bin.put pkr >> Bin.put lt+ get = CChannelParameters <$> Bin.get <*> Bin.get <*> Bin.get++instance Bin.Binary FundingTxInfo where+ put (CFundingTxInfo h idx val) =+ Bin.put h >> BinPut.putWord32be idx >> Bin.put val+ get = CFundingTxInfo <$> Bin.get <*> BinGet.getWord32be <*> Bin.get++instance Bin.Binary PaymentTxConfig where+ put (CPaymentTxConfig sendScript recvScript) =+ Bin.put sendScript >> Bin.put recvScript+ get = CPaymentTxConfig <$> Bin.get <*> Bin.get++instance Bin.Binary PaymentSignature where+ put ps = Bin.put (psSig ps)+ >> Bin.put (psSigHash ps)+ get = CPaymentSignature <$> Bin.get <*> Bin.get++instance Bin.Binary Payment where+ put (CPayment val sig) = Bin.put val >> Bin.put sig+ get = CPayment <$> Bin.get <*> Bin.get+++-- 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+-- }++instance Show Payment where+ show (CPayment val sig) =+ "<Payment: valLeft=" ++ show val ++ ">"
+ src/Data/Bitcoin/PaymentChannel/Internal/Util.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++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.Binary as Bin+import Data.Binary.Put (putWord32le)+import Data.Binary.Get (getWord32le, runGetOrFail)+import Data.Word+import Data.Time.Clock+import Data.Time.Clock.POSIX+import qualified Data.ByteString.Base16 as B16+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Char8 as C+import qualified Network.Haskoin.Transaction as HT+import qualified Network.Haskoin.Script as HS+import qualified Network.Haskoin.Crypto as HC++mapLeft f = either (Left . f) Right+mapRight f = either Left (Right . f)++dummyHash256 = fromString "3d96c573baf8f782e5f5f33dc8ce3c5bae654cbc888e9a3bbb8185a75febfd76" :: HC.Hash256++testHey = toHexString $ serialize $ HT.TxHash dummyHash256++toHexString :: B.ByteString -> String+toHexString = C.unpack . B16.encode++toHexBS :: B.ByteString -> B.ByteString+toHexBS = B16.encode++fromHexString :: String -> B.ByteString+fromHexString hexStr =+ case (B16.decode . C.pack) hexStr of+ (bs,e) ->+ if B.length e /= 0 then B.empty else bs+++-- |Represents a bitcoin amount as number of satoshis.+-- 1 satoshi = 1e-8 bitcoins.+-- Integer operations will never over- or underflow with this type.+-- Convert to a Word64 using 'toWord64', which caps the final amount.+newtype BitcoinAmount = CMoneyAmount Integer+ deriving (Eq, Ord, Num, Enum, Real, Integral, Bin.Binary)+instance Show BitcoinAmount where+ show ma = show (fromIntegral $ toWord64 ma) ++ " satoshis"++-- | Convert to 'Word64', with zero as floor, UINT64_MAX as ceiling+toWord64 :: BitcoinAmount -> Word64+toWord64 (CMoneyAmount i) = fromIntegral $+ max 0 cappedValue+ where+ cappedValue = min i $ fromIntegral (maxBound :: Word64)++instance Ser.Serialize BitcoinAmount where+ put = SerPut.putWord64be . toWord64+ get = CMoneyAmount . fromIntegral <$> SerGet.getWord64be+++-- | Converts a pay-to-pubkey-hash address string to Script.+-- | Eg. \"1PDGytNA7EJ5XrJdTGKv11VAUFxKnsfwke\" into+-- | \"Script [OP_DUP, OP_HASH160, OP_PUSHDATA f3a5194fbf4b3556838e0f773b613a876737a2c6,+-- | OP_EQUALVERIFY, OP_CHECKSIG]\"+p2PKAddressToScript :: String -> Maybe HS.Script+p2PKAddressToScript addrStr =+ HS.encodeOutput . HS.PayPKHash <$> HC.base58ToAddr (C.pack addrStr)++-- | Converts a pay-to-script-hash address string to Script.+-- | Eg. \"2PDGytNA7EJ5XrJdTGKv11VAUFxKnsfwke\"+p2SHAddressToScript :: String -> Maybe HS.Script+p2SHAddressToScript addrStr =+ HS.encodeOutput . HS.PayScriptHash <$> HC.base58ToAddr (C.pack addrStr)++serialize' :: Ser.Serialize a => a -> B.ByteString+serialize' = Ser.encode++serialize :: Bin.Binary a => a -> B.ByteString+serialize = BL.toStrict . Bin.encode++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++----------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) =+ error "cannot replace scriptInput without any inputs"++removeOutputs :: HT.Tx -> HT.Tx+removeOutputs tx = tx { HT.txOut = [] }++appendOutput :: HT.Tx -> HT.TxOut -> HT.Tx+appendOutput tx@HT.Tx{ HT.txOut = oldOuts } txOut =+ tx { HT.txOut = oldOuts ++ [txOut] }++-- |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 =+ LockTimeBlockHeight Word32 |+ LockTimeDate UTCTime deriving (Eq, Show)++-- | Convert from Bitcoin format ('Word32')+parseBitcoinLocktime :: Word32 -> BitcoinLockTime+parseBitcoinLocktime i+ | i < 500000000 = LockTimeBlockHeight i+ | i >= 500000000 = LockTimeDate $ posixSecondsToUTCTime (fromIntegral i)+ | otherwise = error "BUG"++-- | Convert to Bitcoin format ('Word32')+toWord32 :: BitcoinLockTime -> Word32+toWord32 (LockTimeBlockHeight i) = i+toWord32 (LockTimeDate date) =+ fromIntegral . round . utcTimeToPOSIXSeconds $ date++-- | Convert a 'Data.Time.Clock.UTCTime' to a 'BitcoinLockTime'+fromDate :: UTCTime -> BitcoinLockTime+fromDate = LockTimeDate++++instance Bin.Binary BitcoinLockTime where+ put = putWord32le . toWord32+ get = parseBitcoinLocktime <$> getWord32le+++bitcoinPayPK :: HC.PubKey -> HS.Script+bitcoinPayPK pk = HS.encodeOutput $ HS.PayPKHash $ HC.pubKeyAddr pk+bitcoinPayPKBS = serialize . bitcoinPayPK
+ src/Data/Bitcoin/PaymentChannel/Internal/Version.hs view
@@ -0,0 +1,8 @@+module Data.Bitcoin.PaymentChannel.Internal.Version where++import Data.Int++data Version = CVersion {+ versionMajor :: Int32,+ versionMinor :: Int32+} deriving Show
+ src/Data/Bitcoin/PaymentChannel/Types.hs view
@@ -0,0 +1,91 @@+{-|+Module : Data.Bitcoin.PaymentChannel.Types+Copyright : (c) Rune K. Svendsen, 2016+License : PublicDomain+Maintainer : runesvend@gmail.com++Types used with the interface provided by "Data.Bitcoin.PaymentChannel".++-}++module Data.Bitcoin.PaymentChannel.Types+(+SenderPaymentChannel(..),+ReceiverPaymentChannel(..),+Payment,+FundingTxInfo(..),+ChannelParameters(..),+PayChanError,++BitcoinAmount, toWord64,+PaymentChannel(..),+BitcoinLockTime, fromDate+)+where++import Data.Bitcoin.PaymentChannel.Internal.Types+ (PaymentChannelState(..), Payment+ ,FundingTxInfo(..), ChannelParameters(..))+import Data.Bitcoin.PaymentChannel.Internal.Util+ (BitcoinAmount, toWord64,+ BitcoinLockTime, fromDate)+import Data.Bitcoin.PaymentChannel.Internal.State (pcsChannelID, pcsChannelTotalValue)+import Data.Bitcoin.PaymentChannel.Internal.Error (PayChanError(..))++import qualified Network.Haskoin.Crypto as HC+import qualified Network.Haskoin.Transaction as HT+++-- |State object for the value sender+data SenderPaymentChannel = CSenderPaymentChannel {+ -- |Internal state object+ spcState :: PaymentChannelState,+ -- |Used to sign payments from sender.+ -- This function, when given a 'HC.Hash256', produces a signature that+ -- verifies against 'cpSenderPubKey'.+ spcSignFunc :: HC.Hash256 -> HC.Signature+}++-- |State object for the value receiver+data 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+}++-- |Get various information about an open payment channel.+class PaymentChannel a where+ -- |Get value sent to receiver/left for sender+ valueToMe :: a -> BitcoinAmount+ -- |Retrieve internal channel state+ 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++ getChannelID = pcsChannelID . getChannelState+ channelIsExhausted pch = pcsValueLeft (getChannelState pch) == 0 --TODO: payment sigHash == SigSingle++instance PaymentChannel SenderPaymentChannel where+ valueToMe (CSenderPaymentChannel s _) =+ pcsValueLeft s+ getChannelState = spcState++instance PaymentChannel ReceiverPaymentChannel where+ valueToMe (CReceiverPaymentChannel s _ _) =+ pcsChannelTotalValue s - pcsValueLeft s+ getChannelState = rpcState+++instance Show SenderPaymentChannel where+ show (CSenderPaymentChannel s _) =+ "<SenderPaymentChannel:\n\t" ++ show s ++ ">"++instance Show ReceiverPaymentChannel where+ show (CReceiverPaymentChannel s _ _) =+ "<ReceiverPaymentChannel:\n\t" ++ show s ++ ">"
+ src/Data/Bitcoin/PaymentChannel/Util.hs view
@@ -0,0 +1,33 @@+{-|+Module : Data.Bitcoin.PaymentChannel.Types+Copyright : (c) Rune K. Svendsen, 2016+License : PublicDomain+Maintainer : runesvend@gmail.com++Utility functions for "Data.Bitcoin.PaymentChannel".++-}++module Data.Bitcoin.PaymentChannel.Util+(+getFundingAddress,++BitcoinLockTime, parseBitcoinLocktime, toWord32, fromDate+)+where++import Data.Bitcoin.PaymentChannel.Internal.Script+ (getP2SHFundingAddress)+import Data.Bitcoin.PaymentChannel.Internal.Util+ (BitcoinLockTime, parseBitcoinLocktime, toWord32, fromDate)++-- Only used to make Haddock display the right link+import Data.Bitcoin.PaymentChannel.Types+ (ChannelParameters, FundingTxInfo)++-- | Derive a Bitcoin address, for funding a payment channel, from+-- 'ChannelParameters'.+-- The transaction which pays to this address is the channel funding transaction,+-- and information about this transaction is contained in+-- 'FundingTxInfo'.+getFundingAddress = getP2SHFundingAddress