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

module CoinbasePro.Authenticated.Conversion
  ( ConversionId
  , StablecoinConversionRequest (..)
  , StablecoinConversionResponse (..)
  ) where

import           Data.Aeson                         (FromJSON, parseJSON,
                                                     withObject, (.:))
import           Data.Aeson.Casing                  (snakeCase)
import           Data.Aeson.TH                      (defaultOptions, deriveJSON,
                                                     fieldLabelModifier,
                                                     unwrapUnaryRecords)
import           Data.UUID                          (UUID, toString)

import           CoinbasePro.Authenticated.Accounts (AccountId)
import           CoinbasePro.Types                  (CurrencyType)


data StablecoinConversionRequest = StablecoinConversionRequest
    { StablecoinConversionRequest -> CurrencyType
reqFrom   :: CurrencyType
    , StablecoinConversionRequest -> CurrencyType
reqTo     :: CurrencyType
    , StablecoinConversionRequest -> Double
reqAmount :: Double
    } deriving Int -> StablecoinConversionRequest -> ShowS
[StablecoinConversionRequest] -> ShowS
StablecoinConversionRequest -> String
(Int -> StablecoinConversionRequest -> ShowS)
-> (StablecoinConversionRequest -> String)
-> ([StablecoinConversionRequest] -> ShowS)
-> Show StablecoinConversionRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StablecoinConversionRequest] -> ShowS
$cshowList :: [StablecoinConversionRequest] -> ShowS
show :: StablecoinConversionRequest -> String
$cshow :: StablecoinConversionRequest -> String
showsPrec :: Int -> StablecoinConversionRequest -> ShowS
$cshowsPrec :: Int -> StablecoinConversionRequest -> ShowS
Show


deriveJSON defaultOptions
  { fieldLabelModifier = snakeCase . drop 3
  } ''StablecoinConversionRequest


newtype ConversionId = ConversionId UUID


instance Show ConversionId where
  show :: ConversionId -> String
show (ConversionId UUID
u) = UUID -> String
toString UUID
u


deriveJSON defaultOptions
    { fieldLabelModifier = snakeCase
    , unwrapUnaryRecords = True
    } ''ConversionId


data StablecoinConversionResponse = StablecoinConversionResponse
    { StablecoinConversionResponse -> ConversionId
resId            :: ConversionId
    , StablecoinConversionResponse -> Double
resAmount        :: Double
    , StablecoinConversionResponse -> AccountId
resFromAccountId :: AccountId
    , StablecoinConversionResponse -> AccountId
resToAccountId   :: AccountId
    , StablecoinConversionResponse -> CurrencyType
resFrom          :: CurrencyType
    , StablecoinConversionResponse -> CurrencyType
restTo           :: CurrencyType
    } deriving Int -> StablecoinConversionResponse -> ShowS
[StablecoinConversionResponse] -> ShowS
StablecoinConversionResponse -> String
(Int -> StablecoinConversionResponse -> ShowS)
-> (StablecoinConversionResponse -> String)
-> ([StablecoinConversionResponse] -> ShowS)
-> Show StablecoinConversionResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StablecoinConversionResponse] -> ShowS
$cshowList :: [StablecoinConversionResponse] -> ShowS
show :: StablecoinConversionResponse -> String
$cshow :: StablecoinConversionResponse -> String
showsPrec :: Int -> StablecoinConversionResponse -> ShowS
$cshowsPrec :: Int -> StablecoinConversionResponse -> ShowS
Show


instance FromJSON StablecoinConversionResponse where
  parseJSON :: Value -> Parser StablecoinConversionResponse
parseJSON = String
-> (Object -> Parser StablecoinConversionResponse)
-> Value
-> Parser StablecoinConversionResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"stablecoin conversion response" ((Object -> Parser StablecoinConversionResponse)
 -> Value -> Parser StablecoinConversionResponse)
-> (Object -> Parser StablecoinConversionResponse)
-> Value
-> Parser StablecoinConversionResponse
forall a b. (a -> b) -> a -> b
$ \Object
o -> ConversionId
-> Double
-> AccountId
-> AccountId
-> CurrencyType
-> CurrencyType
-> StablecoinConversionResponse
StablecoinConversionResponse
    (ConversionId
 -> Double
 -> AccountId
 -> AccountId
 -> CurrencyType
 -> CurrencyType
 -> StablecoinConversionResponse)
-> Parser ConversionId
-> Parser
     (Double
      -> AccountId
      -> AccountId
      -> CurrencyType
      -> CurrencyType
      -> StablecoinConversionResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser ConversionId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
    Parser
  (Double
   -> AccountId
   -> AccountId
   -> CurrencyType
   -> CurrencyType
   -> StablecoinConversionResponse)
-> Parser Double
-> Parser
     (AccountId
      -> AccountId
      -> CurrencyType
      -> CurrencyType
      -> StablecoinConversionResponse)
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
  (AccountId
   -> AccountId
   -> CurrencyType
   -> CurrencyType
   -> StablecoinConversionResponse)
-> Parser AccountId
-> Parser
     (AccountId
      -> CurrencyType -> CurrencyType -> StablecoinConversionResponse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser AccountId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"from_account_id"
    Parser
  (AccountId
   -> CurrencyType -> CurrencyType -> StablecoinConversionResponse)
-> Parser AccountId
-> Parser
     (CurrencyType -> CurrencyType -> StablecoinConversionResponse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser AccountId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"to_account_id"
    Parser
  (CurrencyType -> CurrencyType -> StablecoinConversionResponse)
-> Parser CurrencyType
-> Parser (CurrencyType -> StablecoinConversionResponse)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser CurrencyType
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"from"
    Parser (CurrencyType -> StablecoinConversionResponse)
-> Parser CurrencyType -> Parser StablecoinConversionResponse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser CurrencyType
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"to"