Copyright | (c) Rune K. Svendsen 2016 |
---|---|
License | PublicDomain |
Maintainer | runesvend@gmail.com |
Safe Haskell | None |
Language | Haskell2010 |
Types used with the interface provided by PaymentChannel.
- data FundingTxInfo = CFundingTxInfo {
- ftiHash :: TxHash
- ftiOutIndex :: Word32
- ftiOutValue :: NonDustyAmount
- data ChanParams = ChanParams {
- cpSenderPubKey :: SendPubKey
- cpReceiverPubKey :: RecvPubKey
- cpLockTime :: LockTimeDate
- class HasSignedPayChanState a => PaymentChannel a where
- class PaymentChannel a => PayChan a
- class PaymentChannel a => PaymentChannelRecv a where
- data SharedSecret :: *
- class HasSharedSecret a where
- fundingAddress :: HasPayChanState a => a -> Address
- clientChangeAddress :: HasPayChanState a => a -> Address
- getFundingAmount :: HasPayChanState a => a -> BtcAmount
- data ClientPayChanI sigData = MkClientPayChan {}
- type ServerPayChan = ServerPayChanI ()
- data ServerPayChanG kd sd
- data PayChanStatus
- data MetadataI kd = Metadata {
- mdKeyData :: kd
- mdPayCount :: Word64
- mdSettledValue :: [SettleInfo]
- mdUnsettledValue :: BtcAmount
- mdChannelStatus :: PayChanStatus
- data OpenError
- = PickOutError (PickOutError ChanParams)
- | ResourcePaymentMismatch Tx TxHash
- | FundingTxError ParseError
- | FundingTxDustOut BtcAmount
- | IncorrectInitialPaymentValue (ExpectFail BtcAmount)
- | InsufficientDuration Hour
- getChannelStatus :: ServerPayChanG kd sd -> PayChanStatus
- setChannelStatus :: PayChanStatus -> ServerPayChanG kd sd -> ServerPayChanG kd sd
- markAsBusy :: ServerPayChanG kd sd -> ServerPayChanG kd sd
- isReadyForPayment :: ServerPayChanG kd sd -> Bool
- data ServerSettings = ServerSettings {
- serverConfDustLimit :: BtcAmount
- serverConfSettlePeriod :: Hour
- serverConfMinDuration :: Hour
- serverConfOpenPrice :: BtcAmount
- newtype Hour = MkHour {}
- type ServerPayChanX = ServerPayChanI ExtPub
- mkExtendedDerivRpc :: RootPub -> ServerPayChanI kd -> Maybe ServerPayChanX
- data UserParams = UserParams {
- upPubKey :: SendPubKey
- upLockTime :: LockTimeDate
- deriveRecvPub :: HasUserParams up => RootPub -> up -> (ChanParams, External ChildPub)
- type SignedPayment = Payment BtcSig
- data ClosedServerChanI kd
- type ClosedServerChan = ClosedServerChanI ()
- type ClosedServerChanX = ClosedServerChanI ExtPub
- getClosedState :: ClosedServerChanI kd -> ServerPayChanI kd
- cscClosingPayment :: ClosedServerChanI kd -> SignedPayment
- type SettleTx = BtcTx P2SH ChanParams PaymentScriptSig
- data PayChanError
- = SigVerifyFailed
- | LockTimeParseError LockTimeParseError
- | BadSigHashFlag SigHash SigHash
- | BadPaymentValue BtcAmount
- | PaymentError (TxMismatch ChanParams)
- | ChannelExpired
- | StatusError HTTPError
- | RBPCPError ParseError
- | OpenError OpenError
- class IsPayChanError e where
- class HasFee a where
- newtype Constant = Constant BtcAmount
- type TxByteSize = Word
- newtype SatoshisPerByte = SatoshisPerByte BtcAmount
- newtype MaxFee a b = MaxFee (a, b)
- newtype Capped val = Capped val
- class PaymentValueSpec val where
- newtype Capped val = Capped val
- newtype SendPubKey = MkSendPubKey {}
- newtype RecvPubKey = MkRecvPubKey {}
- class Serialize a => IsPubKey a where
- class HasSendPubKey a where
- class HasRecvPubKey a where
- module Bitcoin.SpendCond.Util
- fromDate :: UTCTime -> Maybe LockTimeDate
- getChanState :: HasSignedPayChanState a => a -> PayChanState BtcSig
- clientChangeVal :: SigSinglePair t r a -> BtcAmount
- toHaskoinTx :: SignatureScript r ss t => BtcTx t r ss -> Tx
Shared senderreceiver typesfunctions
data FundingTxInfo Source #
Holds information about the Bitcoin transaction used to fund the channel
CFundingTxInfo | |
|
data ChanParams Source #
Defines channel: sender, receiver, and expiration date
ChanParams | |
|
Eq ChanParams Source # | |
Show ChanParams Source # | |
Generic ChanParams Source # | |
ToJSON ChanParams Source # | |
FromJSON ChanParams Source # | |
Serialize ChanParams Source # | |
NFData ChanParams Source # | |
HasLockTimeDate ChanParams Source # | |
HasRecvPubKey ChanParams Source # | |
HasSendPubKey ChanParams Source # | |
DerivationSeed ChanParams Source # | |
HasUserParams ChanParams Source # | |
type Rep ChanParams Source # | |
class HasSignedPayChanState a => PaymentChannel a where Source #
Get various information about an open payment channel.
valueToMe :: a -> BtcAmount Source #
Get amount received by receiver/left for sender
channelValueLeft :: a -> BtcAmount Source #
Remaining channel value
getStatePayment :: a -> SignedPayment Source #
For internal use
PaymentChannel ClientPayChan Source # | |
PaymentChannel (ServerPayChanI s) Source # | |
class PaymentChannel a => PayChan a Source #
Short-hand
class PaymentChannel a => PaymentChannelRecv a where Source #
Payment channel state objects with metadata information
clientTotalValueSent :: a -> BtcAmount Source #
Get total amount (both settled and unsettled) sent by client
PaymentChannelRecv (ServerPayChanI (MetadataI a)) Source # | |
data SharedSecret :: * #
fundingAddress :: HasPayChanState a => a -> Address Source #
clientChangeAddress :: HasPayChanState a => a -> Address Source #
getFundingAmount :: HasPayChanState a => a -> BtcAmount Source #
Sender
data ClientPayChanI sigData Source #
State object for the value sender
Show ClientPayChan Source # | |
HasSigData ClientPayChanI Source # | |
SetClientChangeAddr ClientPayChanI Source # | |
HasSharedSecret ClientPayChan Source # | |
PaymentChannel ClientPayChan Source # | |
Eq sigData => Eq (ClientPayChanI sigData) Source # | |
Generic (ClientPayChanI sigData) Source # | |
NFData sigData => NFData (ClientPayChanI sigData) Source # | |
HasRecvPubKey (ClientPayChanI a) Source # | |
HasSendPubKey (ClientPayChanI a) Source # | |
type Rep (ClientPayChanI sigData) Source # | |
Receiver
type ServerPayChan = ServerPayChanI () Source #
ServerPayChan without receiver key metadata
data ServerPayChanG kd sd Source #
State object for the value receiver. "kd" is used to store information about the receiver key(s) used for this state object.
ToJSON d => ToJSON (ServerPayChanI d) Source # | |
FromJSON d => FromJSON (ServerPayChanI d) Source # | |
HasSigData (ServerPayChanG kd) Source # | |
SetClientChangeAddr (ServerPayChanG kd) Source # | |
PaymentChannelRecv (ServerPayChanI (MetadataI a)) Source # | |
PaymentChannel (ServerPayChanI s) Source # | |
(Eq kd, Eq sd) => Eq (ServerPayChanG kd sd) Source # | |
(Show kd, Show sd) => Show (ServerPayChanG kd sd) Source # | |
Generic (ServerPayChanG kd sd) Source # | |
(Serialize kd, Serialize sd) => Serialize (ServerPayChanG kd sd) Source # | |
(NFData kd, NFData sd) => NFData (ServerPayChanG kd sd) Source # | |
HasLockTimeDate (ServerPayChanG kd sd) Source # | |
HasRecvPubKey (ServerPayChanG kd sd) Source # | |
HasSendPubKey (ServerPayChanG kd sd) Source # | |
HasSharedSecret (ServerPayChanG sd s) Source # | |
type Rep (ServerPayChanG kd sd) Source # | |
data PayChanStatus Source #
ReadyForPayment | |
PaymentInProgress | |
SettlementInProgress | |
ChannelClosed SignedPayment | The closing channel payment |
Metadata | |
|
Eq kd => Eq (MetadataI kd) Source # | |
Show kd => Show (MetadataI kd) Source # | |
Generic (MetadataI kd) Source # | |
ToJSON a => ToJSON (MetadataI a) Source # | |
FromJSON a => FromJSON (MetadataI a) Source # | |
Serialize a => Serialize (MetadataI a) Source # | |
NFData kd => NFData (MetadataI kd) Source # | |
PaymentChannelRecv (ServerPayChanI (MetadataI a)) Source # | |
type Rep (MetadataI kd) Source # | |
PickOutError (PickOutError ChanParams) | Incorrect output specified |
ResourcePaymentMismatch Tx TxHash | |
FundingTxError ParseError | |
FundingTxDustOut BtcAmount | |
IncorrectInitialPaymentValue (ExpectFail BtcAmount) | |
InsufficientDuration Hour |
getChannelStatus :: ServerPayChanG kd sd -> PayChanStatus Source #
setChannelStatus :: PayChanStatus -> ServerPayChanG kd sd -> ServerPayChanG kd sd Source #
markAsBusy :: ServerPayChanG kd sd -> ServerPayChanG kd sd Source #
isReadyForPayment :: ServerPayChanG kd sd -> Bool Source #
data ServerSettings Source #
Various server-defined settings
ServerSettings | |
|
Receiver state (with pubkey metadata)
type ServerPayChanX = ServerPayChanI ExtPub Source #
ServerPayChan with BIP32, "extended key" index as metadata
mkExtendedDerivRpc :: RootPub -> ServerPayChanI kd -> Maybe ServerPayChanX Source #
Add an ExtPub
to a ServerPayChan
that has been created with a server
pubkey derived using deriveRecvPub
data UserParams Source #
UserParams | |
|
DerivationSeed UserParams Source # | |
HasUserParams UserParams Source # | |
deriveRecvPub :: HasUserParams up => RootPub -> up -> (ChanParams, External ChildPub) Source #
Deterministically derive a server public key from client pubkey+expiration date
Payment
type SignedPayment = Payment BtcSig Source #
Receiver settlement
data ClosedServerChanI kd Source #
Eq kd => Eq (ClosedServerChanI kd) Source # | |
Show kd => Show (ClosedServerChanI kd) Source # | |
Generic (ClosedServerChanI kd) Source # | |
Serialize kd => Serialize (ClosedServerChanI kd) Source # | |
NFData kd => NFData (ClosedServerChanI kd) Source # | |
type Rep (ClosedServerChanI kd) Source # | |
type ClosedServerChan = ClosedServerChanI () Source #
getClosedState :: ClosedServerChanI kd -> ServerPayChanI kd Source #
type SettleTx = BtcTx P2SH ChanParams PaymentScriptSig Source #
Error
data PayChanError Source #
SigVerifyFailed | Signature verification failed |
LockTimeParseError LockTimeParseError | |
BadSigHashFlag SigHash SigHash | Unexpected |
BadPaymentValue BtcAmount | Payment assigns less value to server than previous payment. Client change value is greater by the specified |
PaymentError (TxMismatch ChanParams) | |
ChannelExpired | Channel has expired or is too close to expiration date |
StatusError HTTPError | Channel not ready for payment. 409=try again; 410=channel gone. |
RBPCPError ParseError | Failed to parse RBPCP payment |
OpenError OpenError | Channel-open error |
class IsPayChanError e where Source #
mkChanErr :: e -> PayChanError Source #
IsPayChanError LockTimeParseError Source # | |
IsPayChanError ParseError Source # | |
IsPayChanError OpenError Source # | |
Bitcoin
Objects from which a Bitcoin fee can be calculated, given a transaction
absoluteFee :: BtcAmount -> TxByteSize -> a -> BtcAmount Source #
Constant BtcAmount |
type TxByteSize = Word Source #
newtype SatoshisPerByte Source #
Specify a fee as satoshis per byte
SatoshisPerByte BtcAmount | Fee in satoshis per byte |
A maximum fee of two fees. Whichever fee results in the largest absolute fee is chosen.
MaxFee (a, b) |
(Eq b, Eq a) => Eq (MaxFee a b) Source # | |
(Ord b, Ord a) => Ord (MaxFee a b) Source # | |
(Show b, Show a) => Show (MaxFee a b) Source # | |
(ToJSON b, ToJSON a) => ToJSON (MaxFee a b) Source # | |
(FromJSON b, FromJSON a) => FromJSON (MaxFee a b) Source # | |
(Serialize b, Serialize a) => Serialize (MaxFee a b) Source # | |
(NFData b, NFData a) => NFData (MaxFee a b) Source # | |
(HasFee a, HasFee b) => HasFee (MaxFee a b) Source # | |
At most the specified fee. Will not fail if the specified amount is more than is available.
Capped val |
class PaymentValueSpec val where Source #
Capped/non-capped amount-specifications (get value)
paymentValue :: BtcAmount -> ServerSettings -> val -> BtcAmount Source #
PaymentValueSpec BtcAmount Source # | |
PaymentValueSpec (Capped BtcAmount) Source # | |
At most the specified fee. Will not fail if the specified amount is more than is available.
Capped val |
Crypto
newtype SendPubKey Source #
Wrapper for value sender's public key
newtype RecvPubKey Source #
Wrapper for value receiver's public key
class HasSendPubKey a where Source #
Types which contain a SendPubKey
getSendPubKey :: a -> SendPubKey Source #
HasSendPubKey ChanParams Source # | |
HasSendPubKey (ClientPayChanI a) Source # | |
HasSendPubKey (PayChanState a) Source # | |
HasSendPubKey (ServerPayChanG kd sd) Source # | |
class HasRecvPubKey a where Source #
getRecvPubKey :: a -> RecvPubKey Source #
HasRecvPubKey ChanParams Source # | |
HasRecvPubKey (ClientPayChanI a) Source # | |
HasRecvPubKey (PayChanState a) Source # | |
HasRecvPubKey (ServerPayChanG kd sd) Source # | |
Util
module Bitcoin.SpendCond.Util
getChanState :: HasSignedPayChanState a => a -> PayChanState BtcSig Source #
clientChangeVal :: SigSinglePair t r a -> BtcAmount Source #
toHaskoinTx :: SignatureScript r ss t => BtcTx t r ss -> Tx Source #