{-# 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
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
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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"wire deposit information" forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe Text
-> Text
-> Text
-> Text
-> BankCountry
-> Text
-> Text
-> Text
-> WireDepositInformation
WireDepositInformation
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"account_number"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"routing_number"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bank_name"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bank_address"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. FromJSON a => Value -> Parser a
parseJSON forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bank_country"))
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"account_name"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"account_address"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"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
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
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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"deposit_information" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Maybe Value
w <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"wire_deposit_information"
      case Maybe Value
w of
        Just (Object Object
w') -> WireDepositInformation -> DepositInformation
Wire forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
w')
        Maybe Value
Nothing -> do
          Maybe Value
s <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sepa_deposit_information"
          case Maybe Value
s of
            Just (Object Object
s') -> SepaDepositInformation -> DepositInformation
Sepa forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
s')
            Maybe Value
_                -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse deposit information"
        Maybe Value
_ -> 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
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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"account" forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> Double -> Text -> Text -> Bool -> Bool -> Account
Account
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"balance")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"currency"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"primary"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"active"


data FiatAccount = FiatAccount
    { FiatAccount -> Account
fAccount            :: Account
    , FiatAccount -> DepositInformation
fDepositInformation :: DepositInformation
    } deriving Int -> FiatAccount -> ShowS
[FiatAccount] -> ShowS
FiatAccount -> String
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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"fiat account" forall a b. (a -> b) -> a -> b
$ \Object
o -> Account -> DepositInformation -> FiatAccount
FiatAccount
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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
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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"crypto account" forall a b. (a -> b) -> a -> b
$ \Object
o -> Account -> CryptoAccount
CryptoAccount
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"coinbase account" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Value
t <- Text -> Value
String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      case Value
t of
        Value
"fiat"   -> FiatAccount -> CoinbaseAccount
Fiat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
        Value
"wallet" -> CryptoAccount -> CoinbaseAccount
Crypto forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
        Value
_        -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse coinbase account"