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

module CoinbasePro.Authenticated.CoinbaseAccounts
    ( CoinbaseAccount (..)
    ) where

import           Data.Aeson        (FromJSON (..), Value (..), withObject, (.:),
                                    (.:?))
import           Data.Aeson.Casing (snakeCase)
import           Data.Aeson.TH     (defaultOptions, deriveJSON,
                                    fieldLabelModifier)
import           Data.Text         (Text)


data BankCountry = BankCountry
    { BankCountry -> Text
code :: Text
    , BankCountry -> Text
name :: Text
    } deriving Int -> BankCountry -> ShowS
[BankCountry] -> ShowS
BankCountry -> String
(Int -> BankCountry -> ShowS)
-> (BankCountry -> String)
-> ([BankCountry] -> ShowS)
-> Show BankCountry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BankCountry] -> ShowS
$cshowList :: [BankCountry] -> ShowS
show :: BankCountry -> String
$cshow :: BankCountry -> String
showsPrec :: Int -> BankCountry -> ShowS
$cshowsPrec :: Int -> BankCountry -> ShowS
Show


deriveJSON defaultOptions
    { fieldLabelModifier = snakeCase
    } ''BankCountry


data WireDepositInformation = WireDepositInformation
    { WireDepositInformation -> Maybe Text
accountNumber  :: Maybe Text
    , WireDepositInformation -> Text
routingNumber  :: Text
    , WireDepositInformation -> Text
bankName       :: Text
    , WireDepositInformation -> Text
bankAddress    :: Text
    , WireDepositInformation -> BankCountry
bankCountry    :: BankCountry
    , WireDepositInformation -> Text
accountName    :: Text
    , WireDepositInformation -> Text
accountAddress :: Text
    , WireDepositInformation -> Text
reference      :: Text
    } deriving Int -> WireDepositInformation -> ShowS
[WireDepositInformation] -> ShowS
WireDepositInformation -> String
(Int -> WireDepositInformation -> ShowS)
-> (WireDepositInformation -> String)
-> ([WireDepositInformation] -> ShowS)
-> Show WireDepositInformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WireDepositInformation] -> ShowS
$cshowList :: [WireDepositInformation] -> ShowS
show :: WireDepositInformation -> String
$cshow :: WireDepositInformation -> String
showsPrec :: Int -> WireDepositInformation -> ShowS
$cshowsPrec :: Int -> WireDepositInformation -> ShowS
Show


instance FromJSON WireDepositInformation where
  parseJSON :: Value -> Parser WireDepositInformation
parseJSON = String
-> (Object -> Parser WireDepositInformation)
-> Value
-> Parser WireDepositInformation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"wire deposit information" ((Object -> Parser WireDepositInformation)
 -> Value -> Parser WireDepositInformation)
-> (Object -> Parser WireDepositInformation)
-> Value
-> Parser WireDepositInformation
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe Text
-> Text
-> Text
-> Text
-> BankCountry
-> Text
-> Text
-> Text
-> WireDepositInformation
WireDepositInformation
    (Maybe Text
 -> Text
 -> Text
 -> Text
 -> BankCountry
 -> Text
 -> Text
 -> Text
 -> WireDepositInformation)
-> Parser (Maybe Text)
-> Parser
     (Text
      -> Text
      -> Text
      -> BankCountry
      -> Text
      -> Text
      -> Text
      -> WireDepositInformation)
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 a
.: Text
"account_number"
    Parser
  (Text
   -> Text
   -> Text
   -> BankCountry
   -> Text
   -> Text
   -> Text
   -> WireDepositInformation)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> BankCountry
      -> Text
      -> Text
      -> Text
      -> WireDepositInformation)
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
"routing_number"
    Parser
  (Text
   -> Text
   -> BankCountry
   -> Text
   -> Text
   -> Text
   -> WireDepositInformation)
-> Parser Text
-> Parser
     (Text
      -> BankCountry -> Text -> Text -> Text -> WireDepositInformation)
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
"bank_name"
    Parser
  (Text
   -> BankCountry -> Text -> Text -> Text -> WireDepositInformation)
-> Parser Text
-> Parser
     (BankCountry -> Text -> Text -> Text -> WireDepositInformation)
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
"bank_address"
    Parser
  (BankCountry -> Text -> Text -> Text -> WireDepositInformation)
-> Parser BankCountry
-> Parser (Text -> Text -> Text -> WireDepositInformation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser BankCountry
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser BankCountry) -> Parser Value -> Parser BankCountry
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object
o Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"bank_country"))
    Parser (Text -> Text -> Text -> WireDepositInformation)
-> Parser Text -> Parser (Text -> Text -> WireDepositInformation)
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
"account_name"
    Parser (Text -> Text -> WireDepositInformation)
-> Parser Text -> Parser (Text -> WireDepositInformation)
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
"account_address"
    Parser (Text -> WireDepositInformation)
-> Parser Text -> Parser WireDepositInformation
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
"reference"


data SepaDepositInformation = SepaDepositInformation
    { SepaDepositInformation -> Text
sIban            :: Text
    , SepaDepositInformation -> Text
sSwift           :: Text
    , SepaDepositInformation -> Text
sBankName        :: Text
    , SepaDepositInformation -> Text
sBankAddress     :: Text
    , SepaDepositInformation -> Text
sBankCountryName :: Text
    , SepaDepositInformation -> Text
sAccountName     :: Text
    , SepaDepositInformation -> Text
sAccountAddress  :: Text
    , SepaDepositInformation -> Text
sReference       :: Text
    } deriving Int -> SepaDepositInformation -> ShowS
[SepaDepositInformation] -> ShowS
SepaDepositInformation -> String
(Int -> SepaDepositInformation -> ShowS)
-> (SepaDepositInformation -> String)
-> ([SepaDepositInformation] -> ShowS)
-> Show SepaDepositInformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SepaDepositInformation] -> ShowS
$cshowList :: [SepaDepositInformation] -> ShowS
show :: SepaDepositInformation -> String
$cshow :: SepaDepositInformation -> String
showsPrec :: Int -> SepaDepositInformation -> ShowS
$cshowsPrec :: Int -> SepaDepositInformation -> ShowS
Show


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


data DepositInformation = Wire WireDepositInformation | Sepa SepaDepositInformation
  deriving Int -> DepositInformation -> ShowS
[DepositInformation] -> ShowS
DepositInformation -> String
(Int -> DepositInformation -> ShowS)
-> (DepositInformation -> String)
-> ([DepositInformation] -> ShowS)
-> Show DepositInformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DepositInformation] -> ShowS
$cshowList :: [DepositInformation] -> ShowS
show :: DepositInformation -> String
$cshow :: DepositInformation -> String
showsPrec :: Int -> DepositInformation -> ShowS
$cshowsPrec :: Int -> DepositInformation -> ShowS
Show


-- TODO: this is slightly messy, potentially refactor
instance FromJSON DepositInformation where
    parseJSON :: Value -> Parser DepositInformation
parseJSON = String
-> (Object -> Parser DepositInformation)
-> Value
-> Parser DepositInformation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"deposit_information" ((Object -> Parser DepositInformation)
 -> Value -> Parser DepositInformation)
-> (Object -> Parser DepositInformation)
-> Value
-> Parser DepositInformation
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Maybe Value
w <- Object
o Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"wire_deposit_information"
      case Maybe Value
w of
        Just (Object Object
w') -> WireDepositInformation -> DepositInformation
Wire (WireDepositInformation -> DepositInformation)
-> Parser WireDepositInformation -> Parser DepositInformation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser WireDepositInformation
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
w')
        Maybe Value
Nothing -> do
          Maybe Value
s <- Object
o Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"sepa_deposit_information"
          case Maybe Value
s of
            Just (Object Object
s') -> SepaDepositInformation -> DepositInformation
Sepa (SepaDepositInformation -> DepositInformation)
-> Parser SepaDepositInformation -> Parser DepositInformation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser SepaDepositInformation
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
s')
            Maybe Value
_                -> String -> Parser DepositInformation
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse deposit information"
        Maybe Value
_ -> String -> Parser DepositInformation
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse deposit information"


data Account = Account
    { Account -> Text
aId       :: Text
    , Account -> Text
aName     :: Text
    , Account -> Double
aBalance  :: Double
    , Account -> Text
aCurrency :: Text
    , Account -> Text
aType     :: Text
    , Account -> Bool
aPrimary  :: Bool
    , Account -> Bool
aActive   :: Bool
    } deriving (Int -> Account -> ShowS
[Account] -> ShowS
Account -> String
(Int -> Account -> ShowS)
-> (Account -> String) -> ([Account] -> ShowS) -> Show Account
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Account] -> ShowS
$cshowList :: [Account] -> ShowS
show :: Account -> String
$cshow :: Account -> String
showsPrec :: Int -> Account -> ShowS
$cshowsPrec :: Int -> Account -> ShowS
Show)


instance FromJSON Account where
  parseJSON :: Value -> Parser Account
parseJSON = String -> (Object -> Parser Account) -> Value -> Parser Account
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"account" ((Object -> Parser Account) -> Value -> Parser Account)
-> (Object -> Parser Account) -> Value -> Parser Account
forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> Double -> Text -> Text -> Bool -> Bool -> Account
Account
    (Text -> Text -> Double -> Text -> Text -> Bool -> Bool -> Account)
-> Parser Text
-> Parser
     (Text -> Double -> Text -> Text -> Bool -> Bool -> Account)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
    Parser (Text -> Double -> Text -> Text -> Bool -> Bool -> Account)
-> Parser Text
-> Parser (Double -> Text -> Text -> Bool -> Bool -> Account)
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
"name"
    Parser (Double -> Text -> Text -> Bool -> Bool -> Account)
-> Parser Double
-> Parser (Text -> Text -> Bool -> Bool -> Account)
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
"balance")
    Parser (Text -> Text -> Bool -> Bool -> Account)
-> Parser Text -> Parser (Text -> Bool -> Bool -> Account)
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 (Text -> Bool -> Bool -> Account)
-> Parser Text -> Parser (Bool -> Bool -> Account)
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
"type"
    Parser (Bool -> Bool -> Account)
-> Parser Bool -> Parser (Bool -> Account)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"primary"
    Parser (Bool -> Account) -> Parser Bool -> Parser Account
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"active"


data FiatAccount = FiatAccount
    { FiatAccount -> Account
fAccount            :: Account
    , FiatAccount -> DepositInformation
fDepositInformation :: DepositInformation
    } deriving Int -> FiatAccount -> ShowS
[FiatAccount] -> ShowS
FiatAccount -> String
(Int -> FiatAccount -> ShowS)
-> (FiatAccount -> String)
-> ([FiatAccount] -> ShowS)
-> Show FiatAccount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FiatAccount] -> ShowS
$cshowList :: [FiatAccount] -> ShowS
show :: FiatAccount -> String
$cshow :: FiatAccount -> String
showsPrec :: Int -> FiatAccount -> ShowS
$cshowsPrec :: Int -> FiatAccount -> ShowS
Show


instance FromJSON FiatAccount where
    parseJSON :: Value -> Parser FiatAccount
parseJSON = String
-> (Object -> Parser FiatAccount) -> Value -> Parser FiatAccount
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"fiat account" ((Object -> Parser FiatAccount) -> Value -> Parser FiatAccount)
-> (Object -> Parser FiatAccount) -> Value -> Parser FiatAccount
forall a b. (a -> b) -> a -> b
$ \Object
o -> Account -> DepositInformation -> FiatAccount
FiatAccount
      (Account -> DepositInformation -> FiatAccount)
-> Parser Account -> Parser (DepositInformation -> FiatAccount)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Account
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      Parser (DepositInformation -> FiatAccount)
-> Parser DepositInformation -> Parser FiatAccount
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser DepositInformation
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)


newtype CryptoAccount = CryptoAccount Account
    deriving Int -> CryptoAccount -> ShowS
[CryptoAccount] -> ShowS
CryptoAccount -> String
(Int -> CryptoAccount -> ShowS)
-> (CryptoAccount -> String)
-> ([CryptoAccount] -> ShowS)
-> Show CryptoAccount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CryptoAccount] -> ShowS
$cshowList :: [CryptoAccount] -> ShowS
show :: CryptoAccount -> String
$cshow :: CryptoAccount -> String
showsPrec :: Int -> CryptoAccount -> ShowS
$cshowsPrec :: Int -> CryptoAccount -> ShowS
Show


instance FromJSON CryptoAccount where
  parseJSON :: Value -> Parser CryptoAccount
parseJSON = String
-> (Object -> Parser CryptoAccount)
-> Value
-> Parser CryptoAccount
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"crypto account" ((Object -> Parser CryptoAccount) -> Value -> Parser CryptoAccount)
-> (Object -> Parser CryptoAccount)
-> Value
-> Parser CryptoAccount
forall a b. (a -> b) -> a -> b
$ \Object
o -> Account -> CryptoAccount
CryptoAccount
    (Account -> CryptoAccount)
-> Parser Account -> Parser CryptoAccount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Account
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)


data CoinbaseAccount = Fiat FiatAccount | Crypto CryptoAccount
    deriving Int -> CoinbaseAccount -> ShowS
[CoinbaseAccount] -> ShowS
CoinbaseAccount -> String
(Int -> CoinbaseAccount -> ShowS)
-> (CoinbaseAccount -> String)
-> ([CoinbaseAccount] -> ShowS)
-> Show CoinbaseAccount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoinbaseAccount] -> ShowS
$cshowList :: [CoinbaseAccount] -> ShowS
show :: CoinbaseAccount -> String
$cshow :: CoinbaseAccount -> String
showsPrec :: Int -> CoinbaseAccount -> ShowS
$cshowsPrec :: Int -> CoinbaseAccount -> ShowS
Show


instance FromJSON CoinbaseAccount where
  parseJSON :: Value -> Parser CoinbaseAccount
parseJSON = String
-> (Object -> Parser CoinbaseAccount)
-> Value
-> Parser CoinbaseAccount
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"coinbase account" ((Object -> Parser CoinbaseAccount)
 -> Value -> Parser CoinbaseAccount)
-> (Object -> Parser CoinbaseAccount)
-> Value
-> Parser CoinbaseAccount
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Value
t <- Text -> Value
String (Text -> Value) -> Parser Text -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type"
      case Value
t of
        Value
"fiat"   -> FiatAccount -> CoinbaseAccount
Fiat (FiatAccount -> CoinbaseAccount)
-> Parser FiatAccount -> Parser CoinbaseAccount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser FiatAccount
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
        Value
"wallet" -> CryptoAccount -> CoinbaseAccount
Crypto (CryptoAccount -> CoinbaseAccount)
-> Parser CryptoAccount -> Parser CoinbaseAccount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser CryptoAccount
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
        Value
_        -> String -> Parser CoinbaseAccount
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse coinbase account"