rbpcp-api-0.2.0.0: src/RBPCP/Types.hs
{-# LANGUAGE DeriveGeneric, DeriveAnyClass, OverloadedStrings #-}
module RBPCP.Types
(
module RBPCP.Types
, PAYREQ
, JsonHex(..)
, BaseUrl(..)
, Client(..)
, Server(..)
)
where
import RBPCP.Internal.Types
import RBPCP.Internal.Util
import RBPCP.Internal.Orphans ()
import PayProto (PaymentRequest, PAYREQ, PayReqSpec(..), mkPayRequestT)
import Data.Aeson
import Data.Aeson.Types
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import Data.Word (Word8, Word32, Word64)
import qualified Data.Serialize as Bin
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import Servant.API (MimeRender(..), JSON)
import Servant.Client (BaseUrl(..))
import Data.Time.Clock
-- Generated code
import Data.List (stripPrefix)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Function ((&))
{-
mkPayRequestT :: UTCTime -> PayReqSpec -> P.PaymentRequest
-}
type Vout = Word32
type Hours = Word
type BtcConf = Word
data FundInfoResponse = FundInfoResponse
{ firFundInfo :: FundingInfo
, firUserMemo :: T.Text -- ^ Memo displayed to user
, firNow :: UTCTime -- ^ Current time
, firPaymentURL :: BaseUrl
-- ^ BIP70 @Payment@ POST URL. Will receive message (containing tx paying to the funding address)
, firExpSecs :: Word64
}
instance MimeRender PAYREQ FundInfoResponse where
mimeRender a FundInfoResponse{..} =
mimeRender a $
mkPayRequestT firNow prs
where prs = PayReqSpec
{ prsOuts = [(fundingInfoFundingAddressCopy firFundInfo, 0)]
, prsPayUrl = firPaymentURL
, prsExpSecs = firExpSecs
, prsMerchMemo = firUserMemo
, prsMerchData = BL.toStrict $ encode firFundInfo
}
instance MimeRender JSON FundInfoResponse where
mimeRender a FundInfoResponse{..} =
mimeRender a firFundInfo
data ChannelStatus = ChannelOpen | ChannelClosed deriving (Show, Eq)
instance FromJSON ChannelStatus where
parseJSON = withText "ChannelStatus" $
\s -> case s of
"open" -> return ChannelOpen
"closed" -> return ChannelClosed
e -> fail $ "expected \"open\" or \"closed\", not: " ++ show (cs e :: String)
instance ToJSON ChannelStatus where
toJSON ChannelOpen = String "open"
toJSON ChannelClosed = String "closed"
instance Bin.Serialize ChannelStatus where
put ChannelOpen = Bin.putWord8 0x01
put ChannelClosed = Bin.putWord8 0x02
get = Bin.getWord8 >>= \w -> case w of
0x01 -> return ChannelOpen
0x02 -> return ChannelClosed
n -> fail $ "expected 1 or 2, not: " ++ show n
data ErrorType = PaymentError | ApplicationError deriving (Show, Eq)
instance FromJSON ErrorType where
parseJSON = withText "ErrorType" $
\s -> case s of
"payment_error" -> return PaymentError
"application_error" -> return ApplicationError
e -> fail $ "expected \"payment_error\"" ++
" or \"application_error\", not: " ++ show (cs e :: String)
instance ToJSON ErrorType where
toJSON PaymentError = String "payment_error"
toJSON ApplicationError = String "application_error"
instance Bin.Serialize ErrorType where
put PaymentError = Bin.putWord8 0x01
put ApplicationError = Bin.putWord8 0x02
get = Bin.getWord8 >>= \w -> case w of
0x01 -> return PaymentError
0x02 -> return ApplicationError
n -> fail $ "expected 0x01 or 0x02, not: " ++ show n
instance Bin.Serialize Text where
put = Bin.put . encodeUtf8
get = decodeUtf8 <$> Bin.get
-- Generated code with some types modified:
-- |
data PaymentResult = PaymentResult
{ paymentResult_channel_status :: ChannelStatus -- ^ Equal to \"open\" if the channel is still open, otherwise \"closed\". The channel is automatically closed when there is no value left to send. If a payment sends all remaining channel value to the server, the server will close the channel and set this field to \"closed\".
, paymentResult_channel_valueLeft :: Word64 -- ^ Remaining channel value. This is the amount that the client/sender would receive if the channel was closed now.
, paymentResult_value_received :: Word64 -- ^ Value of the payment that was just received. This is the additional value assigned to the receiver/server with this payment.
, paymentResult_settlement_txid :: Maybe TxHash -- ^ If channel_status equals \"closed\": the transaction ID of the Bitcoin transaction which settles the channel; otherwise null.
, paymentResult_application_data :: Text -- ^ Optional application data
} deriving (Show, Eq, Generic, Bin.Serialize)
-- |
data FundingInfo = FundingInfo
{ fundingInfoServerPubkey :: Server PubKey -- ^ Server/value receiver public key. Hex-encoded, compressed Secp256k1 pubkey, 33 bytes.
, fundingInfoDustLimit :: Word64 -- ^ (Satoshis) The server will not accept payments where the client change amount is less than this amount. This \"dust limit\" is necessary in order to avoid producing a settlement transaction that will not circulate in the Bitcoin P2P network because it contains an output of minuscule value. Consequently, the maximum amount, that can be sent over the payment channel, is the amount sent to the funding address minus this \"dust limit\".
, fundingInfoFundingAddressCopy :: Address -- ^ Server derived channel funding address. The client will confirm that its own derived funding address matches this one, before paying to it.
, fundingInfoRedeem_scriptCopy :: JsonHex Script -- ^ Server derived channel redeem script. Defines sender, receiver and channel expiration date. Used to construct the input in the payment transaction. The client will also verify that this matches what it expects. Hex-encoded.
, fundingInfoOpenPrice :: Word64 -- ^ Price (in satoshis) for opening a channel with the given {exp_time}. This amount is paid in the initial channel payment when creating a new channel. May be zero, in which case a payment of zero value is transferred, ensuring that the channel can be closed at any time.
, fundingInfoFunding_tx_min_conf :: BtcConf -- ^ Minimum confirmation count that the funding transaction must have before proceeding with opening a new channel.
, fundingInfoSettlement_period_hours :: Hours -- ^ The server reserves the right to close the payment channel this many hours before the specified expiration date. The server hasn't received any actual value until it publishes a payment transaction to the Bitcoin network, so it needs a window of time in which the client can no longer send payments over the channel, and yet the channel refund transaction hasn't become valid.
, fundingInfoMin_duration_hours :: Hours -- ^ Minimum duration of newly opened channels
} deriving (Show, Eq, Generic, Bin.Serialize)
-- | Error response type
data Error = Error
{ errorType :: ErrorType -- ^ Either 'payment_error', in case of an invalid payment, or 'application_error', in case of application-related errors (invalid 'application_data' in the supplied **Payment**)
, errorMessage :: Text -- ^ Human-readable error message
} deriving (Show, Eq, Generic, Bin.Serialize)
-- | A payment comprises a signature over a Bitcoin transaction with a decremented client change value.
-- The Bitcoin transaction redeems the outpoint specified by 'funding_txid' and 'funding_vout' (a P2SH output governed by 'redeem_script'), and pays 'change_value' to 'change_address'.
data PaymentData = PaymentData
{ paymentDataRedeemScript :: JsonHex Script -- ^ The funds sent to the funding address are bound by this contract (Bitcoin script). The data is needed to construct the payment signature. Hex-encoded data.
, paymentDataFundingTxid :: TxHash -- ^ The transaction ID of the Bitcoin transaction paying to the channel funding address.
, paymentDataFundingVout :: Vout -- ^ The output index/\"vout\" of the output (in the transaction) payingto the channel funding address.
, paymentDataSignatureData :: JsonHex Signature -- ^ DER-encoded ECDSA signature (in hex). This is a SIGHASH_SINGLE|ANYONECANPAY signature over the the \"payment transaction\", which is a Bitcoin transaction that: redeems the outpoint specified by 'funding_txid' and 'funding_vout' using the redeem script defined in 'redeem_script', with an output which sends 'change_value' to 'change_address'.
, paymentDataChangeValue :: Word64 -- ^ The value sent back to the client in the payment transaction. The total amount transferred to the server is this amount subtracted from the value sent to the channel funding address.
, paymentDataChangeAddress :: Address -- ^ The client change address as used in the only output of the payment transaction.
, paymentDataSighashFlag :: JsonHex SigHash -- ^ Specifies which parts of the payment Bitcoin transaction are signed. Hex-encoded, single byte; in both v1 and v2 always equal to \"83\" (0x83), which is **SIGHASH_SINGLE|ANYONECANPAY**, meaning the client only signs its own output, and also allowing more to be added.
} deriving (Show, Eq, Generic, Bin.Serialize)
instance FromJSON PaymentData where
parseJSON = genericParseJSON (removeFieldLabelPrefix True "paymentData")
instance ToJSON PaymentData where
toJSON = genericToJSON (removeFieldLabelPrefix False "paymentData")
-- | A wrapper that contains both payment data and application data
data Payment = Payment
{ paymentPaymentData :: PaymentData -- ^ Actual payment
, paymentApplicationData :: Text -- ^ Optional application data (may be an empty string). The client may wish to include data with the payment, for example an order reference, or any other data which will be used by the server to deliver the appropriate application data in the **PaymentResult** response.
} deriving (Show, Eq, Generic, Bin.Serialize)
instance FromJSON Payment where
parseJSON = genericParseJSON (removeFieldLabelPrefix True "payment")
instance ToJSON Payment where
toJSON = genericToJSON (removeFieldLabelPrefix False "payment")
instance FromJSON Error where
parseJSON = genericParseJSON (removeFieldLabelPrefix True "error")
instance ToJSON Error where
toJSON = genericToJSON (removeFieldLabelPrefix False "error")
instance FromJSON FundingInfo where
parseJSON = genericParseJSON (removeFieldLabelPrefix True "fundingInfo")
instance ToJSON FundingInfo where
toJSON = genericToJSON (removeFieldLabelPrefix False "fundingInfo")
instance FromJSON PaymentResult where
parseJSON = genericParseJSON (removeFieldLabelPrefix True "paymentResult_")
instance ToJSON PaymentResult where
toJSON = genericToJSON (removeFieldLabelPrefix False "paymentResult_")
removeFieldLabelPrefix :: Bool -> String -> Options
removeFieldLabelPrefix forParsing prefix =
defaultOptions
{ fieldLabelModifier = camelTo2 '_' . fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix . replaceSpecialChars
}
where
replaceSpecialChars field = foldl (&) field (map mkCharReplacement specialChars)
specialChars = [("@", "'At"), ("!", "'Exclamation"), ("<=", "'Less_Than_Or_Equal_To"), ("#", "'Hash"), ("$", "'Dollar"), ("%", "'Percent"), ("&", "'Ampersand"), ("*", "'Star"), ("+", "'Plus"), ("-", "'Dash"), (".", "'Period"), (":", "'Colon"), ("|", "'Pipe"), ("<", "'LessThan"), ("!=", "'Not_Equal"), ("=", "'Equal"), ("^", "'Caret"), (">", "'GreaterThan"), ("_", "'Underscore"), (">=", "'Greater_Than_Or_Equal_To")]
mkCharReplacement (replaceStr, searchStr) = T.unpack . replacer (T.pack searchStr) (T.pack replaceStr) . T.pack
replacer = if forParsing then flip T.replace else T.replace