{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}

module CoinbasePro.Authenticated.Withdrawal
    ( WithdrawalDetails (..)
    , WithdrawalRequest (..)
    , WithdrawalResponse (..)
    , CoinbaseWithdrawalRequest (..)
    , CryptoWithdrawalRequest (..)
    , CryptoWithdrawalResponse (..)
    , WithdrawalFeeEstimateResponse (..)
    ) where

import           Data.Aeson                         (FromJSON, parseJSON,
                                                     withObject, (.:), (.:?))
import           Data.Aeson.Casing                  (snakeCase)
import           Data.Aeson.TH                      (defaultOptions, deriveJSON,
                                                     fieldLabelModifier)
import           Data.Text                          (Text)
import           Data.Time.Clock                    (UTCTime)
import           Data.UUID                          (UUID)

import           CoinbasePro.Authenticated.Accounts (AccountId)
import           CoinbasePro.Authenticated.Payment  (PaymentMethodId)


data WithdrawalDetails = WithdrawalDetails
    { WithdrawalDetails -> Maybe Text
destinationTag        :: Maybe Text
    , WithdrawalDetails -> Maybe Text
sentToAddress         :: Maybe Text
    , WithdrawalDetails -> Text
coinbaseAccountId     :: Text
    , WithdrawalDetails -> Maybe Text
destinationTagName    :: Maybe Text
    , WithdrawalDetails -> Maybe Text
coinbaseWithdrawalId  :: Maybe Text
    , WithdrawalDetails -> Text
coinbaseTransactionId :: Text
    , WithdrawalDetails -> Text
cryptoPaymentMethodId :: Text
    , WithdrawalDetails -> Maybe Double
fee                   :: Maybe Double
    , WithdrawalDetails -> Maybe Double
subtotal              :: Maybe Double
    } deriving (WithdrawalDetails -> WithdrawalDetails -> Bool
(WithdrawalDetails -> WithdrawalDetails -> Bool)
-> (WithdrawalDetails -> WithdrawalDetails -> Bool)
-> Eq WithdrawalDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WithdrawalDetails -> WithdrawalDetails -> Bool
$c/= :: WithdrawalDetails -> WithdrawalDetails -> Bool
== :: WithdrawalDetails -> WithdrawalDetails -> Bool
$c== :: WithdrawalDetails -> WithdrawalDetails -> Bool
Eq, Int -> WithdrawalDetails -> ShowS
[WithdrawalDetails] -> ShowS
WithdrawalDetails -> String
(Int -> WithdrawalDetails -> ShowS)
-> (WithdrawalDetails -> String)
-> ([WithdrawalDetails] -> ShowS)
-> Show WithdrawalDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WithdrawalDetails] -> ShowS
$cshowList :: [WithdrawalDetails] -> ShowS
show :: WithdrawalDetails -> String
$cshow :: WithdrawalDetails -> String
showsPrec :: Int -> WithdrawalDetails -> ShowS
$cshowsPrec :: Int -> WithdrawalDetails -> ShowS
Show)


instance FromJSON WithdrawalDetails where
  parseJSON :: Value -> Parser WithdrawalDetails
parseJSON = String
-> (Object -> Parser WithdrawalDetails)
-> Value
-> Parser WithdrawalDetails
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"withdrawal details" ((Object -> Parser WithdrawalDetails)
 -> Value -> Parser WithdrawalDetails)
-> (Object -> Parser WithdrawalDetails)
-> Value
-> Parser WithdrawalDetails
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe Text
-> Maybe Text
-> Text
-> Maybe Text
-> Maybe Text
-> Text
-> Text
-> Maybe Double
-> Maybe Double
-> WithdrawalDetails
WithdrawalDetails
    (Maybe Text
 -> Maybe Text
 -> Text
 -> Maybe Text
 -> Maybe Text
 -> Text
 -> Text
 -> Maybe Double
 -> Maybe Double
 -> WithdrawalDetails)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Text
      -> Maybe Double
      -> Maybe Double
      -> WithdrawalDetails)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"destination_tag"
    Parser
  (Maybe Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Text
   -> Maybe Double
   -> Maybe Double
   -> WithdrawalDetails)
-> Parser (Maybe Text)
-> Parser
     (Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Text
      -> Maybe Double
      -> Maybe Double
      -> WithdrawalDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"sent_to_address"
    Parser
  (Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Text
   -> Maybe Double
   -> Maybe Double
   -> WithdrawalDetails)
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Text
      -> Text
      -> Maybe Double
      -> Maybe Double
      -> WithdrawalDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"coinbase_account_id"
    Parser
  (Maybe Text
   -> Maybe Text
   -> Text
   -> Text
   -> Maybe Double
   -> Maybe Double
   -> WithdrawalDetails)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Text
      -> Text
      -> Maybe Double
      -> Maybe Double
      -> WithdrawalDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"destination_tag_name"
    Parser
  (Maybe Text
   -> Text
   -> Text
   -> Maybe Double
   -> Maybe Double
   -> WithdrawalDetails)
-> Parser (Maybe Text)
-> Parser
     (Text -> Text -> Maybe Double -> Maybe Double -> WithdrawalDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"coinbase_withdrawal_id"
    Parser
  (Text -> Text -> Maybe Double -> Maybe Double -> WithdrawalDetails)
-> Parser Text
-> Parser
     (Text -> Maybe Double -> Maybe Double -> WithdrawalDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"coinbase_transaction_id"
    Parser (Text -> Maybe Double -> Maybe Double -> WithdrawalDetails)
-> Parser Text
-> Parser (Maybe Double -> Maybe Double -> WithdrawalDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"coinbase_payment_method_id"
    Parser (Maybe Double -> Maybe Double -> WithdrawalDetails)
-> Parser (Maybe Double)
-> Parser (Maybe Double -> WithdrawalDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe Double
-> (String -> Maybe Double) -> Maybe String -> Maybe Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe Double
forall a. Maybe a
Nothing String -> Maybe Double
forall a. Read a => String -> a
read (Maybe String -> Maybe Double)
-> Parser (Maybe String) -> Parser (Maybe Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"fee")
    Parser (Maybe Double -> WithdrawalDetails)
-> Parser (Maybe Double) -> Parser WithdrawalDetails
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe Double
-> (String -> Maybe Double) -> Maybe String -> Maybe Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe Double
forall a. Maybe a
Nothing String -> Maybe Double
forall a. Read a => String -> a
read (Maybe String -> Maybe Double)
-> Parser (Maybe String) -> Parser (Maybe Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe String)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"subtotal")


data WithdrawalRequest = WithdrawalRequest
    { WithdrawalRequest -> Double
amount          :: Double
    , WithdrawalRequest -> Text
currency        :: Text
    , WithdrawalRequest -> PaymentMethodId
paymentMethodId :: PaymentMethodId
    } deriving (WithdrawalRequest -> WithdrawalRequest -> Bool
(WithdrawalRequest -> WithdrawalRequest -> Bool)
-> (WithdrawalRequest -> WithdrawalRequest -> Bool)
-> Eq WithdrawalRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WithdrawalRequest -> WithdrawalRequest -> Bool
$c/= :: WithdrawalRequest -> WithdrawalRequest -> Bool
== :: WithdrawalRequest -> WithdrawalRequest -> Bool
$c== :: WithdrawalRequest -> WithdrawalRequest -> Bool
Eq, Int -> WithdrawalRequest -> ShowS
[WithdrawalRequest] -> ShowS
WithdrawalRequest -> String
(Int -> WithdrawalRequest -> ShowS)
-> (WithdrawalRequest -> String)
-> ([WithdrawalRequest] -> ShowS)
-> Show WithdrawalRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WithdrawalRequest] -> ShowS
$cshowList :: [WithdrawalRequest] -> ShowS
show :: WithdrawalRequest -> String
$cshow :: WithdrawalRequest -> String
showsPrec :: Int -> WithdrawalRequest -> ShowS
$cshowsPrec :: Int -> WithdrawalRequest -> ShowS
Show)


deriveJSON defaultOptions { fieldLabelModifier = snakeCase } ''WithdrawalRequest


data WithdrawalResponse = WithdrawalResponse
    { WithdrawalResponse -> UUID
wId       :: UUID
    , WithdrawalResponse -> Double
wAmount   :: Double
    , WithdrawalResponse -> Text
wCurrency :: Text
    , WithdrawalResponse -> UTCTime
wPayoutAt :: UTCTime
    } deriving (WithdrawalResponse -> WithdrawalResponse -> Bool
(WithdrawalResponse -> WithdrawalResponse -> Bool)
-> (WithdrawalResponse -> WithdrawalResponse -> Bool)
-> Eq WithdrawalResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WithdrawalResponse -> WithdrawalResponse -> Bool
$c/= :: WithdrawalResponse -> WithdrawalResponse -> Bool
== :: WithdrawalResponse -> WithdrawalResponse -> Bool
$c== :: WithdrawalResponse -> WithdrawalResponse -> Bool
Eq, Int -> WithdrawalResponse -> ShowS
[WithdrawalResponse] -> ShowS
WithdrawalResponse -> String
(Int -> WithdrawalResponse -> ShowS)
-> (WithdrawalResponse -> String)
-> ([WithdrawalResponse] -> ShowS)
-> Show WithdrawalResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WithdrawalResponse] -> ShowS
$cshowList :: [WithdrawalResponse] -> ShowS
show :: WithdrawalResponse -> String
$cshow :: WithdrawalResponse -> String
showsPrec :: Int -> WithdrawalResponse -> ShowS
$cshowsPrec :: Int -> WithdrawalResponse -> ShowS
Show)


instance FromJSON WithdrawalResponse where
  parseJSON :: Value -> Parser WithdrawalResponse
parseJSON = String
-> (Object -> Parser WithdrawalResponse)
-> Value
-> Parser WithdrawalResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"withdrawal response" ((Object -> Parser WithdrawalResponse)
 -> Value -> Parser WithdrawalResponse)
-> (Object -> Parser WithdrawalResponse)
-> Value
-> Parser WithdrawalResponse
forall a b. (a -> b) -> a -> b
$ \Object
o -> UUID -> Double -> Text -> UTCTime -> WithdrawalResponse
WithdrawalResponse
    (UUID -> Double -> Text -> UTCTime -> WithdrawalResponse)
-> Parser UUID
-> Parser (Double -> Text -> UTCTime -> WithdrawalResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser UUID
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
    Parser (Double -> Text -> UTCTime -> WithdrawalResponse)
-> Parser Double -> Parser (Text -> UTCTime -> WithdrawalResponse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Double
forall a. Read a => String -> a
read (String -> Double) -> Parser String -> Parser Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"amount")
    Parser (Text -> UTCTime -> WithdrawalResponse)
-> Parser Text -> Parser (UTCTime -> WithdrawalResponse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"currency"
    Parser (UTCTime -> WithdrawalResponse)
-> Parser UTCTime -> Parser WithdrawalResponse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser UTCTime
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"payout_at"


data CoinbaseWithdrawalRequest = CoinbaseWithdrawalRequest
    { CoinbaseWithdrawalRequest -> Double
cAmount            :: Double
    , CoinbaseWithdrawalRequest -> Text
cCurrency          :: Text
    , CoinbaseWithdrawalRequest -> AccountId
cCoinbaseAccountId :: AccountId
    } deriving (CoinbaseWithdrawalRequest -> CoinbaseWithdrawalRequest -> Bool
(CoinbaseWithdrawalRequest -> CoinbaseWithdrawalRequest -> Bool)
-> (CoinbaseWithdrawalRequest -> CoinbaseWithdrawalRequest -> Bool)
-> Eq CoinbaseWithdrawalRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoinbaseWithdrawalRequest -> CoinbaseWithdrawalRequest -> Bool
$c/= :: CoinbaseWithdrawalRequest -> CoinbaseWithdrawalRequest -> Bool
== :: CoinbaseWithdrawalRequest -> CoinbaseWithdrawalRequest -> Bool
$c== :: CoinbaseWithdrawalRequest -> CoinbaseWithdrawalRequest -> Bool
Eq, Int -> CoinbaseWithdrawalRequest -> ShowS
[CoinbaseWithdrawalRequest] -> ShowS
CoinbaseWithdrawalRequest -> String
(Int -> CoinbaseWithdrawalRequest -> ShowS)
-> (CoinbaseWithdrawalRequest -> String)
-> ([CoinbaseWithdrawalRequest] -> ShowS)
-> Show CoinbaseWithdrawalRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoinbaseWithdrawalRequest] -> ShowS
$cshowList :: [CoinbaseWithdrawalRequest] -> ShowS
show :: CoinbaseWithdrawalRequest -> String
$cshow :: CoinbaseWithdrawalRequest -> String
showsPrec :: Int -> CoinbaseWithdrawalRequest -> ShowS
$cshowsPrec :: Int -> CoinbaseWithdrawalRequest -> ShowS
Show)


deriveJSON defaultOptions { fieldLabelModifier = snakeCase . drop 1 } ''CoinbaseWithdrawalRequest


data CryptoWithdrawalRequest = CryptoWithdrawalRequest
    { CryptoWithdrawalRequest -> Double
crAmount        :: Double
    , CryptoWithdrawalRequest -> Text
crCurrency      :: Text
    , CryptoWithdrawalRequest -> Text
crCryptoAddress :: Text
    } deriving (CryptoWithdrawalRequest -> CryptoWithdrawalRequest -> Bool
(CryptoWithdrawalRequest -> CryptoWithdrawalRequest -> Bool)
-> (CryptoWithdrawalRequest -> CryptoWithdrawalRequest -> Bool)
-> Eq CryptoWithdrawalRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CryptoWithdrawalRequest -> CryptoWithdrawalRequest -> Bool
$c/= :: CryptoWithdrawalRequest -> CryptoWithdrawalRequest -> Bool
== :: CryptoWithdrawalRequest -> CryptoWithdrawalRequest -> Bool
$c== :: CryptoWithdrawalRequest -> CryptoWithdrawalRequest -> Bool
Eq, Int -> CryptoWithdrawalRequest -> ShowS
[CryptoWithdrawalRequest] -> ShowS
CryptoWithdrawalRequest -> String
(Int -> CryptoWithdrawalRequest -> ShowS)
-> (CryptoWithdrawalRequest -> String)
-> ([CryptoWithdrawalRequest] -> ShowS)
-> Show CryptoWithdrawalRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CryptoWithdrawalRequest] -> ShowS
$cshowList :: [CryptoWithdrawalRequest] -> ShowS
show :: CryptoWithdrawalRequest -> String
$cshow :: CryptoWithdrawalRequest -> String
showsPrec :: Int -> CryptoWithdrawalRequest -> ShowS
$cshowsPrec :: Int -> CryptoWithdrawalRequest -> ShowS
Show)


deriveJSON defaultOptions { fieldLabelModifier = snakeCase . drop 2 } ''CryptoWithdrawalRequest


data CryptoWithdrawalResponse = CryptoWithdrawalResponse
    { CryptoWithdrawalResponse -> UUID
cwId       :: UUID
    , CryptoWithdrawalResponse -> Double
cwAmount   :: Double
    , CryptoWithdrawalResponse -> Text
cwCurrency :: Text
    , CryptoWithdrawalResponse -> Double
cwFee      :: Double
    , CryptoWithdrawalResponse -> Double
cwSubtotal :: Double
    } deriving (CryptoWithdrawalResponse -> CryptoWithdrawalResponse -> Bool
(CryptoWithdrawalResponse -> CryptoWithdrawalResponse -> Bool)
-> (CryptoWithdrawalResponse -> CryptoWithdrawalResponse -> Bool)
-> Eq CryptoWithdrawalResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CryptoWithdrawalResponse -> CryptoWithdrawalResponse -> Bool
$c/= :: CryptoWithdrawalResponse -> CryptoWithdrawalResponse -> Bool
== :: CryptoWithdrawalResponse -> CryptoWithdrawalResponse -> Bool
$c== :: CryptoWithdrawalResponse -> CryptoWithdrawalResponse -> Bool
Eq, Int -> CryptoWithdrawalResponse -> ShowS
[CryptoWithdrawalResponse] -> ShowS
CryptoWithdrawalResponse -> String
(Int -> CryptoWithdrawalResponse -> ShowS)
-> (CryptoWithdrawalResponse -> String)
-> ([CryptoWithdrawalResponse] -> ShowS)
-> Show CryptoWithdrawalResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CryptoWithdrawalResponse] -> ShowS
$cshowList :: [CryptoWithdrawalResponse] -> ShowS
show :: CryptoWithdrawalResponse -> String
$cshow :: CryptoWithdrawalResponse -> String
showsPrec :: Int -> CryptoWithdrawalResponse -> ShowS
$cshowsPrec :: Int -> CryptoWithdrawalResponse -> ShowS
Show)


instance FromJSON CryptoWithdrawalResponse where
  parseJSON :: Value -> Parser CryptoWithdrawalResponse
parseJSON = String
-> (Object -> Parser CryptoWithdrawalResponse)
-> Value
-> Parser CryptoWithdrawalResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"crypto withdrawal response" ((Object -> Parser CryptoWithdrawalResponse)
 -> Value -> Parser CryptoWithdrawalResponse)
-> (Object -> Parser CryptoWithdrawalResponse)
-> Value
-> Parser CryptoWithdrawalResponse
forall a b. (a -> b) -> a -> b
$ \Object
o -> UUID
-> Double -> Text -> Double -> Double -> CryptoWithdrawalResponse
CryptoWithdrawalResponse
    (UUID
 -> Double -> Text -> Double -> Double -> CryptoWithdrawalResponse)
-> Parser UUID
-> Parser
     (Double -> Text -> Double -> Double -> CryptoWithdrawalResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser UUID
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
    Parser
  (Double -> Text -> Double -> Double -> CryptoWithdrawalResponse)
-> Parser Double
-> Parser (Text -> Double -> Double -> CryptoWithdrawalResponse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Double
forall a. Read a => String -> a
read (String -> Double) -> Parser String -> Parser Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"amount")
    Parser (Text -> Double -> Double -> CryptoWithdrawalResponse)
-> Parser Text
-> Parser (Double -> Double -> CryptoWithdrawalResponse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"currency"
    Parser (Double -> Double -> CryptoWithdrawalResponse)
-> Parser Double -> Parser (Double -> CryptoWithdrawalResponse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Double
forall a. Read a => String -> a
read (String -> Double) -> Parser String -> Parser Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"fee")
    Parser (Double -> CryptoWithdrawalResponse)
-> Parser Double -> Parser CryptoWithdrawalResponse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Double
forall a. Read a => String -> a
read (String -> Double) -> Parser String -> Parser Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"subtotal")


newtype WithdrawalFeeEstimateResponse = WithdrawalFeeEstimateResponse
    { WithdrawalFeeEstimateResponse -> Double
wfFee :: Double} deriving (WithdrawalFeeEstimateResponse
-> WithdrawalFeeEstimateResponse -> Bool
(WithdrawalFeeEstimateResponse
 -> WithdrawalFeeEstimateResponse -> Bool)
-> (WithdrawalFeeEstimateResponse
    -> WithdrawalFeeEstimateResponse -> Bool)
-> Eq WithdrawalFeeEstimateResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WithdrawalFeeEstimateResponse
-> WithdrawalFeeEstimateResponse -> Bool
$c/= :: WithdrawalFeeEstimateResponse
-> WithdrawalFeeEstimateResponse -> Bool
== :: WithdrawalFeeEstimateResponse
-> WithdrawalFeeEstimateResponse -> Bool
$c== :: WithdrawalFeeEstimateResponse
-> WithdrawalFeeEstimateResponse -> Bool
Eq, Int -> WithdrawalFeeEstimateResponse -> ShowS
[WithdrawalFeeEstimateResponse] -> ShowS
WithdrawalFeeEstimateResponse -> String
(Int -> WithdrawalFeeEstimateResponse -> ShowS)
-> (WithdrawalFeeEstimateResponse -> String)
-> ([WithdrawalFeeEstimateResponse] -> ShowS)
-> Show WithdrawalFeeEstimateResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WithdrawalFeeEstimateResponse] -> ShowS
$cshowList :: [WithdrawalFeeEstimateResponse] -> ShowS
show :: WithdrawalFeeEstimateResponse -> String
$cshow :: WithdrawalFeeEstimateResponse -> String
showsPrec :: Int -> WithdrawalFeeEstimateResponse -> ShowS
$cshowsPrec :: Int -> WithdrawalFeeEstimateResponse -> ShowS
Show)


deriveJSON defaultOptions { fieldLabelModifier = snakeCase . drop 2 } ''WithdrawalFeeEstimateResponse