{-
   BitMEX API

   ## REST API for the BitMEX Trading Platform  [View Changelog](/app/apiChangelog)    #### Getting Started   ##### Fetching Data  All REST endpoints are documented below. You can try out any query right from this interface.  Most table queries accept `count`, `start`, and `reverse` params. Set `reverse=true` to get rows newest-first.  Additional documentation regarding filters, timestamps, and authentication is available in [the main API documentation](https://www.bitmex.com/app/restAPI).  *All* table data is available via the [Websocket](/app/wsAPI). We highly recommend using the socket if you want to have the quickest possible data without being subject to ratelimits.  ##### Return Types  By default, all data is returned as JSON. Send `?_format=csv` to get CSV data or `?_format=xml` to get XML data.  ##### Trade Data Queries  *This is only a small subset of what is available, to get you started.*  Fill in the parameters and click the `Try it out!` button to try any of these queries.  * [Pricing Data](#!/Quote/Quote_get)  * [Trade Data](#!/Trade/Trade_get)  * [OrderBook Data](#!/OrderBook/OrderBook_getL2)  * [Settlement Data](#!/Settlement/Settlement_get)  * [Exchange Statistics](#!/Stats/Stats_history)  Every function of the BitMEX.com platform is exposed here and documented. Many more functions are available.  ##### Swagger Specification  [⇩ Download Swagger JSON](swagger.json)    ## All API Endpoints  Click to expand a section. 

   OpenAPI spec version: 2.0
   BitMEX API API version: 1.2.0
   Contact: support@bitmex.com
   Generated by Swagger Codegen (https://github.com/swagger-api/swagger-codegen.git)
-}

{-|
Module : BitMEX.Model
-}

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-unused-matches -fno-warn-unused-binds -fno-warn-unused-imports #-}

module BitMEX.Model where

import BitMEX.Core
import BitMEX.MimeTypes

import Data.Aeson ((.:),(.:!),(.:?),(.=))

import qualified Control.Arrow as P (left)
import qualified Data.Aeson as A
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Data as P (Data, Typeable)
import qualified Data.Foldable as P
import qualified Data.HashMap.Lazy as HM
import qualified Data.Map as Map
import qualified Data.Maybe as P
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Time as TI
import qualified Web.FormUrlEncoded as WH
import qualified Web.HttpApiData as WH

import Control.Applicative ((<|>))
import Control.Applicative (Alternative)
import Data.Text (Text)
import Prelude (($), (.),(<$>),(<*>),(>>=),(=<<),Maybe(..),Bool(..),Char,Double,FilePath,Float,Int,Integer,String,fmap,undefined,mempty,maybe,pure,Monad,Applicative,Functor)

import qualified Prelude as P



-- * Models


-- ** APIKey
-- | APIKey
-- Persistent API Keys for Developers
data APIKey = APIKey
  { aPIKeyId :: !(Text) -- ^ /Required/ "id"
  , aPIKeySecret :: !(Text) -- ^ /Required/ "secret"
  , aPIKeyName :: !(Text) -- ^ /Required/ "name"
  , aPIKeyNonce :: !(Double) -- ^ /Required/ "nonce"
  , aPIKeyCidr :: !(Maybe Text) -- ^ "cidr"
  , aPIKeyPermissions :: !(Maybe [XAny]) -- ^ "permissions"
  , aPIKeyEnabled :: !(Maybe Bool) -- ^ "enabled"
  , aPIKeyUserId :: !(Double) -- ^ /Required/ "userId"
  , aPIKeyCreated :: !(Maybe DateTime) -- ^ "created"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON APIKey
instance A.FromJSON APIKey where
  parseJSON = A.withObject "APIKey" $ \o ->
    APIKey
      <$> (o .:  "id")
      <*> (o .:  "secret")
      <*> (o .:  "name")
      <*> (o .:  "nonce")
      <*> (o .:? "cidr")
      <*> (o .:? "permissions")
      <*> (o .:? "enabled")
      <*> (o .:  "userId")
      <*> (o .:? "created")

-- | ToJSON APIKey
instance A.ToJSON APIKey where
  toJSON APIKey {..} =
   _omitNulls
      [ "id" .= aPIKeyId
      , "secret" .= aPIKeySecret
      , "name" .= aPIKeyName
      , "nonce" .= aPIKeyNonce
      , "cidr" .= aPIKeyCidr
      , "permissions" .= aPIKeyPermissions
      , "enabled" .= aPIKeyEnabled
      , "userId" .= aPIKeyUserId
      , "created" .= aPIKeyCreated
      ]


-- | Construct a value of type 'APIKey' (by applying it's required fields, if any)
mkAPIKey
  :: Text -- ^ 'aPIKeyId' 
  -> Text -- ^ 'aPIKeySecret' 
  -> Text -- ^ 'aPIKeyName' 
  -> Double -- ^ 'aPIKeyNonce' 
  -> Double -- ^ 'aPIKeyUserId' 
  -> APIKey
mkAPIKey aPIKeyId aPIKeySecret aPIKeyName aPIKeyNonce aPIKeyUserId =
  APIKey
  { aPIKeyId
  , aPIKeySecret
  , aPIKeyName
  , aPIKeyNonce
  , aPIKeyCidr = Nothing
  , aPIKeyPermissions = Nothing
  , aPIKeyEnabled = Nothing
  , aPIKeyUserId
  , aPIKeyCreated = Nothing
  }

-- ** AccessToken
-- | AccessToken
data AccessToken = AccessToken
  { accessTokenId :: !(Text) -- ^ /Required/ "id"
  , accessTokenTtl :: !(Maybe Double) -- ^ "ttl" - time to live in seconds (2 weeks by default)
  , accessTokenCreated :: !(Maybe DateTime) -- ^ "created"
  , accessTokenUserId :: !(Maybe Double) -- ^ "userId"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON AccessToken
instance A.FromJSON AccessToken where
  parseJSON = A.withObject "AccessToken" $ \o ->
    AccessToken
      <$> (o .:  "id")
      <*> (o .:? "ttl")
      <*> (o .:? "created")
      <*> (o .:? "userId")

-- | ToJSON AccessToken
instance A.ToJSON AccessToken where
  toJSON AccessToken {..} =
   _omitNulls
      [ "id" .= accessTokenId
      , "ttl" .= accessTokenTtl
      , "created" .= accessTokenCreated
      , "userId" .= accessTokenUserId
      ]


-- | Construct a value of type 'AccessToken' (by applying it's required fields, if any)
mkAccessToken
  :: Text -- ^ 'accessTokenId' 
  -> AccessToken
mkAccessToken accessTokenId =
  AccessToken
  { accessTokenId
  , accessTokenTtl = Nothing
  , accessTokenCreated = Nothing
  , accessTokenUserId = Nothing
  }

-- ** Affiliate
-- | Affiliate
data Affiliate = Affiliate
  { affiliateAccount :: !(Double) -- ^ /Required/ "account"
  , affiliateCurrency :: !(Text) -- ^ /Required/ "currency"
  , affiliatePrevPayout :: !(Maybe Double) -- ^ "prevPayout"
  , affiliatePrevTurnover :: !(Maybe Double) -- ^ "prevTurnover"
  , affiliatePrevComm :: !(Maybe Double) -- ^ "prevComm"
  , affiliatePrevTimestamp :: !(Maybe DateTime) -- ^ "prevTimestamp"
  , affiliateExecTurnover :: !(Maybe Double) -- ^ "execTurnover"
  , affiliateExecComm :: !(Maybe Double) -- ^ "execComm"
  , affiliateTotalReferrals :: !(Maybe Double) -- ^ "totalReferrals"
  , affiliateTotalTurnover :: !(Maybe Double) -- ^ "totalTurnover"
  , affiliateTotalComm :: !(Maybe Double) -- ^ "totalComm"
  , affiliatePayoutPcnt :: !(Maybe Double) -- ^ "payoutPcnt"
  , affiliatePendingPayout :: !(Maybe Double) -- ^ "pendingPayout"
  , affiliateTimestamp :: !(Maybe DateTime) -- ^ "timestamp"
  , affiliateReferrerAccount :: !(Maybe Double) -- ^ "referrerAccount"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON Affiliate
instance A.FromJSON Affiliate where
  parseJSON = A.withObject "Affiliate" $ \o ->
    Affiliate
      <$> (o .:  "account")
      <*> (o .:  "currency")
      <*> (o .:? "prevPayout")
      <*> (o .:? "prevTurnover")
      <*> (o .:? "prevComm")
      <*> (o .:? "prevTimestamp")
      <*> (o .:? "execTurnover")
      <*> (o .:? "execComm")
      <*> (o .:? "totalReferrals")
      <*> (o .:? "totalTurnover")
      <*> (o .:? "totalComm")
      <*> (o .:? "payoutPcnt")
      <*> (o .:? "pendingPayout")
      <*> (o .:? "timestamp")
      <*> (o .:? "referrerAccount")

-- | ToJSON Affiliate
instance A.ToJSON Affiliate where
  toJSON Affiliate {..} =
   _omitNulls
      [ "account" .= affiliateAccount
      , "currency" .= affiliateCurrency
      , "prevPayout" .= affiliatePrevPayout
      , "prevTurnover" .= affiliatePrevTurnover
      , "prevComm" .= affiliatePrevComm
      , "prevTimestamp" .= affiliatePrevTimestamp
      , "execTurnover" .= affiliateExecTurnover
      , "execComm" .= affiliateExecComm
      , "totalReferrals" .= affiliateTotalReferrals
      , "totalTurnover" .= affiliateTotalTurnover
      , "totalComm" .= affiliateTotalComm
      , "payoutPcnt" .= affiliatePayoutPcnt
      , "pendingPayout" .= affiliatePendingPayout
      , "timestamp" .= affiliateTimestamp
      , "referrerAccount" .= affiliateReferrerAccount
      ]


-- | Construct a value of type 'Affiliate' (by applying it's required fields, if any)
mkAffiliate
  :: Double -- ^ 'affiliateAccount' 
  -> Text -- ^ 'affiliateCurrency' 
  -> Affiliate
mkAffiliate affiliateAccount affiliateCurrency =
  Affiliate
  { affiliateAccount
  , affiliateCurrency
  , affiliatePrevPayout = Nothing
  , affiliatePrevTurnover = Nothing
  , affiliatePrevComm = Nothing
  , affiliatePrevTimestamp = Nothing
  , affiliateExecTurnover = Nothing
  , affiliateExecComm = Nothing
  , affiliateTotalReferrals = Nothing
  , affiliateTotalTurnover = Nothing
  , affiliateTotalComm = Nothing
  , affiliatePayoutPcnt = Nothing
  , affiliatePendingPayout = Nothing
  , affiliateTimestamp = Nothing
  , affiliateReferrerAccount = Nothing
  }

-- ** Announcement
-- | Announcement
-- Public Announcements
data Announcement = Announcement
  { announcementId :: !(Double) -- ^ /Required/ "id"
  , announcementLink :: !(Maybe Text) -- ^ "link"
  , announcementTitle :: !(Maybe Text) -- ^ "title"
  , announcementContent :: !(Maybe Text) -- ^ "content"
  , announcementDate :: !(Maybe DateTime) -- ^ "date"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON Announcement
instance A.FromJSON Announcement where
  parseJSON = A.withObject "Announcement" $ \o ->
    Announcement
      <$> (o .:  "id")
      <*> (o .:? "link")
      <*> (o .:? "title")
      <*> (o .:? "content")
      <*> (o .:? "date")

-- | ToJSON Announcement
instance A.ToJSON Announcement where
  toJSON Announcement {..} =
   _omitNulls
      [ "id" .= announcementId
      , "link" .= announcementLink
      , "title" .= announcementTitle
      , "content" .= announcementContent
      , "date" .= announcementDate
      ]


-- | Construct a value of type 'Announcement' (by applying it's required fields, if any)
mkAnnouncement
  :: Double -- ^ 'announcementId' 
  -> Announcement
mkAnnouncement announcementId =
  Announcement
  { announcementId
  , announcementLink = Nothing
  , announcementTitle = Nothing
  , announcementContent = Nothing
  , announcementDate = Nothing
  }

-- ** Chat
-- | Chat
-- Trollbox Data
data Chat = Chat
  { chatId :: !(Maybe Double) -- ^ "id"
  , chatDate :: !(DateTime) -- ^ /Required/ "date"
  , chatUser :: !(Text) -- ^ /Required/ "user"
  , chatMessage :: !(Text) -- ^ /Required/ "message"
  , chatHtml :: !(Text) -- ^ /Required/ "html"
  , chatFromBot :: !(Maybe Bool) -- ^ "fromBot"
  , chatChannelId :: !(Maybe Double) -- ^ "channelID"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON Chat
instance A.FromJSON Chat where
  parseJSON = A.withObject "Chat" $ \o ->
    Chat
      <$> (o .:? "id")
      <*> (o .:  "date")
      <*> (o .:  "user")
      <*> (o .:  "message")
      <*> (o .:  "html")
      <*> (o .:? "fromBot")
      <*> (o .:? "channelID")

-- | ToJSON Chat
instance A.ToJSON Chat where
  toJSON Chat {..} =
   _omitNulls
      [ "id" .= chatId
      , "date" .= chatDate
      , "user" .= chatUser
      , "message" .= chatMessage
      , "html" .= chatHtml
      , "fromBot" .= chatFromBot
      , "channelID" .= chatChannelId
      ]


-- | Construct a value of type 'Chat' (by applying it's required fields, if any)
mkChat
  :: DateTime -- ^ 'chatDate' 
  -> Text -- ^ 'chatUser' 
  -> Text -- ^ 'chatMessage' 
  -> Text -- ^ 'chatHtml' 
  -> Chat
mkChat chatDate chatUser chatMessage chatHtml =
  Chat
  { chatId = Nothing
  , chatDate
  , chatUser
  , chatMessage
  , chatHtml
  , chatFromBot = Nothing
  , chatChannelId = Nothing
  }

-- ** ChatChannels
-- | ChatChannels
data ChatChannels = ChatChannels
  { chatChannelsId :: !(Maybe Double) -- ^ "id"
  , chatChannelsName :: !(Text) -- ^ /Required/ "name"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON ChatChannels
instance A.FromJSON ChatChannels where
  parseJSON = A.withObject "ChatChannels" $ \o ->
    ChatChannels
      <$> (o .:? "id")
      <*> (o .:  "name")

-- | ToJSON ChatChannels
instance A.ToJSON ChatChannels where
  toJSON ChatChannels {..} =
   _omitNulls
      [ "id" .= chatChannelsId
      , "name" .= chatChannelsName
      ]


-- | Construct a value of type 'ChatChannels' (by applying it's required fields, if any)
mkChatChannels
  :: Text -- ^ 'chatChannelsName' 
  -> ChatChannels
mkChatChannels chatChannelsName =
  ChatChannels
  { chatChannelsId = Nothing
  , chatChannelsName
  }

-- ** ConnectedUsers
-- | ConnectedUsers
data ConnectedUsers = ConnectedUsers
  { connectedUsersUsers :: !(Maybe Double) -- ^ "users"
  , connectedUsersBots :: !(Maybe Double) -- ^ "bots"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON ConnectedUsers
instance A.FromJSON ConnectedUsers where
  parseJSON = A.withObject "ConnectedUsers" $ \o ->
    ConnectedUsers
      <$> (o .:? "users")
      <*> (o .:? "bots")

-- | ToJSON ConnectedUsers
instance A.ToJSON ConnectedUsers where
  toJSON ConnectedUsers {..} =
   _omitNulls
      [ "users" .= connectedUsersUsers
      , "bots" .= connectedUsersBots
      ]


-- | Construct a value of type 'ConnectedUsers' (by applying it's required fields, if any)
mkConnectedUsers
  :: ConnectedUsers
mkConnectedUsers =
  ConnectedUsers
  { connectedUsersUsers = Nothing
  , connectedUsersBots = Nothing
  }

-- ** Error
-- | Error
data Error = Error
  { errorError :: !(ErrorError) -- ^ /Required/ "error"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON Error
instance A.FromJSON Error where
  parseJSON = A.withObject "Error" $ \o ->
    Error
      <$> (o .:  "error")

-- | ToJSON Error
instance A.ToJSON Error where
  toJSON Error {..} =
   _omitNulls
      [ "error" .= errorError
      ]


-- | Construct a value of type 'Error' (by applying it's required fields, if any)
mkError
  :: ErrorError -- ^ 'errorError' 
  -> Error
mkError errorError =
  Error
  { errorError
  }

-- ** ErrorError
-- | ErrorError
data ErrorError = ErrorError
  { errorErrorMessage :: !(Maybe Text) -- ^ "message"
  , errorErrorName :: !(Maybe Text) -- ^ "name"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON ErrorError
instance A.FromJSON ErrorError where
  parseJSON = A.withObject "ErrorError" $ \o ->
    ErrorError
      <$> (o .:? "message")
      <*> (o .:? "name")

-- | ToJSON ErrorError
instance A.ToJSON ErrorError where
  toJSON ErrorError {..} =
   _omitNulls
      [ "message" .= errorErrorMessage
      , "name" .= errorErrorName
      ]


-- | Construct a value of type 'ErrorError' (by applying it's required fields, if any)
mkErrorError
  :: ErrorError
mkErrorError =
  ErrorError
  { errorErrorMessage = Nothing
  , errorErrorName = Nothing
  }

-- ** Execution
-- | Execution
-- Raw Order and Balance Data
data Execution = Execution
  { executionExecId :: !(Text) -- ^ /Required/ "execID"
  , executionOrderId :: !(Maybe Text) -- ^ "orderID"
  , executionClOrdId :: !(Maybe Text) -- ^ "clOrdID"
  , executionClOrdLinkId :: !(Maybe Text) -- ^ "clOrdLinkID"
  , executionAccount :: !(Maybe Double) -- ^ "account"
  , executionSymbol :: !(Maybe Text) -- ^ "symbol"
  , executionSide :: !(Maybe Text) -- ^ "side"
  , executionLastQty :: !(Maybe Double) -- ^ "lastQty"
  , executionLastPx :: !(Maybe Double) -- ^ "lastPx"
  , executionUnderlyingLastPx :: !(Maybe Double) -- ^ "underlyingLastPx"
  , executionLastMkt :: !(Maybe Text) -- ^ "lastMkt"
  , executionLastLiquidityInd :: !(Maybe Text) -- ^ "lastLiquidityInd"
  , executionSimpleOrderQty :: !(Maybe Double) -- ^ "simpleOrderQty"
  , executionOrderQty :: !(Maybe Double) -- ^ "orderQty"
  , executionPrice :: !(Maybe Double) -- ^ "price"
  , executionDisplayQty :: !(Maybe Double) -- ^ "displayQty"
  , executionStopPx :: !(Maybe Double) -- ^ "stopPx"
  , executionPegOffsetValue :: !(Maybe Double) -- ^ "pegOffsetValue"
  , executionPegPriceType :: !(Maybe Text) -- ^ "pegPriceType"
  , executionCurrency :: !(Maybe Text) -- ^ "currency"
  , executionSettlCurrency :: !(Maybe Text) -- ^ "settlCurrency"
  , executionExecType :: !(Maybe Text) -- ^ "execType"
  , executionOrdType :: !(Maybe Text) -- ^ "ordType"
  , executionTimeInForce :: !(Maybe Text) -- ^ "timeInForce"
  , executionExecInst :: !(Maybe Text) -- ^ "execInst"
  , executionContingencyType :: !(Maybe Text) -- ^ "contingencyType"
  , executionExDestination :: !(Maybe Text) -- ^ "exDestination"
  , executionOrdStatus :: !(Maybe Text) -- ^ "ordStatus"
  , executionTriggered :: !(Maybe Text) -- ^ "triggered"
  , executionWorkingIndicator :: !(Maybe Bool) -- ^ "workingIndicator"
  , executionOrdRejReason :: !(Maybe Text) -- ^ "ordRejReason"
  , executionSimpleLeavesQty :: !(Maybe Double) -- ^ "simpleLeavesQty"
  , executionLeavesQty :: !(Maybe Double) -- ^ "leavesQty"
  , executionSimpleCumQty :: !(Maybe Double) -- ^ "simpleCumQty"
  , executionCumQty :: !(Maybe Double) -- ^ "cumQty"
  , executionAvgPx :: !(Maybe Double) -- ^ "avgPx"
  , executionCommission :: !(Maybe Double) -- ^ "commission"
  , executionTradePublishIndicator :: !(Maybe Text) -- ^ "tradePublishIndicator"
  , executionMultiLegReportingType :: !(Maybe Text) -- ^ "multiLegReportingType"
  , executionText :: !(Maybe Text) -- ^ "text"
  , executionTrdMatchId :: !(Maybe Text) -- ^ "trdMatchID"
  , executionExecCost :: !(Maybe Double) -- ^ "execCost"
  , executionExecComm :: !(Maybe Double) -- ^ "execComm"
  , executionHomeNotional :: !(Maybe Double) -- ^ "homeNotional"
  , executionForeignNotional :: !(Maybe Double) -- ^ "foreignNotional"
  , executionTransactTime :: !(Maybe DateTime) -- ^ "transactTime"
  , executionTimestamp :: !(Maybe DateTime) -- ^ "timestamp"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON Execution
instance A.FromJSON Execution where
  parseJSON = A.withObject "Execution" $ \o ->
    Execution
      <$> (o .:  "execID")
      <*> (o .:? "orderID")
      <*> (o .:? "clOrdID")
      <*> (o .:? "clOrdLinkID")
      <*> (o .:? "account")
      <*> (o .:? "symbol")
      <*> (o .:? "side")
      <*> (o .:? "lastQty")
      <*> (o .:? "lastPx")
      <*> (o .:? "underlyingLastPx")
      <*> (o .:? "lastMkt")
      <*> (o .:? "lastLiquidityInd")
      <*> (o .:? "simpleOrderQty")
      <*> (o .:? "orderQty")
      <*> (o .:? "price")
      <*> (o .:? "displayQty")
      <*> (o .:? "stopPx")
      <*> (o .:? "pegOffsetValue")
      <*> (o .:? "pegPriceType")
      <*> (o .:? "currency")
      <*> (o .:? "settlCurrency")
      <*> (o .:? "execType")
      <*> (o .:? "ordType")
      <*> (o .:? "timeInForce")
      <*> (o .:? "execInst")
      <*> (o .:? "contingencyType")
      <*> (o .:? "exDestination")
      <*> (o .:? "ordStatus")
      <*> (o .:? "triggered")
      <*> (o .:? "workingIndicator")
      <*> (o .:? "ordRejReason")
      <*> (o .:? "simpleLeavesQty")
      <*> (o .:? "leavesQty")
      <*> (o .:? "simpleCumQty")
      <*> (o .:? "cumQty")
      <*> (o .:? "avgPx")
      <*> (o .:? "commission")
      <*> (o .:? "tradePublishIndicator")
      <*> (o .:? "multiLegReportingType")
      <*> (o .:? "text")
      <*> (o .:? "trdMatchID")
      <*> (o .:? "execCost")
      <*> (o .:? "execComm")
      <*> (o .:? "homeNotional")
      <*> (o .:? "foreignNotional")
      <*> (o .:? "transactTime")
      <*> (o .:? "timestamp")

-- | ToJSON Execution
instance A.ToJSON Execution where
  toJSON Execution {..} =
   _omitNulls
      [ "execID" .= executionExecId
      , "orderID" .= executionOrderId
      , "clOrdID" .= executionClOrdId
      , "clOrdLinkID" .= executionClOrdLinkId
      , "account" .= executionAccount
      , "symbol" .= executionSymbol
      , "side" .= executionSide
      , "lastQty" .= executionLastQty
      , "lastPx" .= executionLastPx
      , "underlyingLastPx" .= executionUnderlyingLastPx
      , "lastMkt" .= executionLastMkt
      , "lastLiquidityInd" .= executionLastLiquidityInd
      , "simpleOrderQty" .= executionSimpleOrderQty
      , "orderQty" .= executionOrderQty
      , "price" .= executionPrice
      , "displayQty" .= executionDisplayQty
      , "stopPx" .= executionStopPx
      , "pegOffsetValue" .= executionPegOffsetValue
      , "pegPriceType" .= executionPegPriceType
      , "currency" .= executionCurrency
      , "settlCurrency" .= executionSettlCurrency
      , "execType" .= executionExecType
      , "ordType" .= executionOrdType
      , "timeInForce" .= executionTimeInForce
      , "execInst" .= executionExecInst
      , "contingencyType" .= executionContingencyType
      , "exDestination" .= executionExDestination
      , "ordStatus" .= executionOrdStatus
      , "triggered" .= executionTriggered
      , "workingIndicator" .= executionWorkingIndicator
      , "ordRejReason" .= executionOrdRejReason
      , "simpleLeavesQty" .= executionSimpleLeavesQty
      , "leavesQty" .= executionLeavesQty
      , "simpleCumQty" .= executionSimpleCumQty
      , "cumQty" .= executionCumQty
      , "avgPx" .= executionAvgPx
      , "commission" .= executionCommission
      , "tradePublishIndicator" .= executionTradePublishIndicator
      , "multiLegReportingType" .= executionMultiLegReportingType
      , "text" .= executionText
      , "trdMatchID" .= executionTrdMatchId
      , "execCost" .= executionExecCost
      , "execComm" .= executionExecComm
      , "homeNotional" .= executionHomeNotional
      , "foreignNotional" .= executionForeignNotional
      , "transactTime" .= executionTransactTime
      , "timestamp" .= executionTimestamp
      ]


-- | Construct a value of type 'Execution' (by applying it's required fields, if any)
mkExecution
  :: Text -- ^ 'executionExecId' 
  -> Execution
mkExecution executionExecId =
  Execution
  { executionExecId
  , executionOrderId = Nothing
  , executionClOrdId = Nothing
  , executionClOrdLinkId = Nothing
  , executionAccount = Nothing
  , executionSymbol = Nothing
  , executionSide = Nothing
  , executionLastQty = Nothing
  , executionLastPx = Nothing
  , executionUnderlyingLastPx = Nothing
  , executionLastMkt = Nothing
  , executionLastLiquidityInd = Nothing
  , executionSimpleOrderQty = Nothing
  , executionOrderQty = Nothing
  , executionPrice = Nothing
  , executionDisplayQty = Nothing
  , executionStopPx = Nothing
  , executionPegOffsetValue = Nothing
  , executionPegPriceType = Nothing
  , executionCurrency = Nothing
  , executionSettlCurrency = Nothing
  , executionExecType = Nothing
  , executionOrdType = Nothing
  , executionTimeInForce = Nothing
  , executionExecInst = Nothing
  , executionContingencyType = Nothing
  , executionExDestination = Nothing
  , executionOrdStatus = Nothing
  , executionTriggered = Nothing
  , executionWorkingIndicator = Nothing
  , executionOrdRejReason = Nothing
  , executionSimpleLeavesQty = Nothing
  , executionLeavesQty = Nothing
  , executionSimpleCumQty = Nothing
  , executionCumQty = Nothing
  , executionAvgPx = Nothing
  , executionCommission = Nothing
  , executionTradePublishIndicator = Nothing
  , executionMultiLegReportingType = Nothing
  , executionText = Nothing
  , executionTrdMatchId = Nothing
  , executionExecCost = Nothing
  , executionExecComm = Nothing
  , executionHomeNotional = Nothing
  , executionForeignNotional = Nothing
  , executionTransactTime = Nothing
  , executionTimestamp = Nothing
  }

-- ** Funding
-- | Funding
-- Swap Funding History
data Funding = Funding
  { fundingTimestamp :: !(DateTime) -- ^ /Required/ "timestamp"
  , fundingSymbol :: !(Text) -- ^ /Required/ "symbol"
  , fundingFundingInterval :: !(Maybe DateTime) -- ^ "fundingInterval"
  , fundingFundingRate :: !(Maybe Double) -- ^ "fundingRate"
  , fundingFundingRateDaily :: !(Maybe Double) -- ^ "fundingRateDaily"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON Funding
instance A.FromJSON Funding where
  parseJSON = A.withObject "Funding" $ \o ->
    Funding
      <$> (o .:  "timestamp")
      <*> (o .:  "symbol")
      <*> (o .:? "fundingInterval")
      <*> (o .:? "fundingRate")
      <*> (o .:? "fundingRateDaily")

-- | ToJSON Funding
instance A.ToJSON Funding where
  toJSON Funding {..} =
   _omitNulls
      [ "timestamp" .= fundingTimestamp
      , "symbol" .= fundingSymbol
      , "fundingInterval" .= fundingFundingInterval
      , "fundingRate" .= fundingFundingRate
      , "fundingRateDaily" .= fundingFundingRateDaily
      ]


-- | Construct a value of type 'Funding' (by applying it's required fields, if any)
mkFunding
  :: DateTime -- ^ 'fundingTimestamp' 
  -> Text -- ^ 'fundingSymbol' 
  -> Funding
mkFunding fundingTimestamp fundingSymbol =
  Funding
  { fundingTimestamp
  , fundingSymbol
  , fundingFundingInterval = Nothing
  , fundingFundingRate = Nothing
  , fundingFundingRateDaily = Nothing
  }

-- ** IndexComposite
-- | IndexComposite
data IndexComposite = IndexComposite
  { indexCompositeTimestamp :: !(DateTime) -- ^ /Required/ "timestamp"
  , indexCompositeSymbol :: !(Maybe Text) -- ^ "symbol"
  , indexCompositeIndexSymbol :: !(Maybe Text) -- ^ "indexSymbol"
  , indexCompositeReference :: !(Maybe Text) -- ^ "reference"
  , indexCompositeLastPrice :: !(Maybe Double) -- ^ "lastPrice"
  , indexCompositeWeight :: !(Maybe Double) -- ^ "weight"
  , indexCompositeLogged :: !(Maybe DateTime) -- ^ "logged"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON IndexComposite
instance A.FromJSON IndexComposite where
  parseJSON = A.withObject "IndexComposite" $ \o ->
    IndexComposite
      <$> (o .:  "timestamp")
      <*> (o .:? "symbol")
      <*> (o .:? "indexSymbol")
      <*> (o .:? "reference")
      <*> (o .:? "lastPrice")
      <*> (o .:? "weight")
      <*> (o .:? "logged")

-- | ToJSON IndexComposite
instance A.ToJSON IndexComposite where
  toJSON IndexComposite {..} =
   _omitNulls
      [ "timestamp" .= indexCompositeTimestamp
      , "symbol" .= indexCompositeSymbol
      , "indexSymbol" .= indexCompositeIndexSymbol
      , "reference" .= indexCompositeReference
      , "lastPrice" .= indexCompositeLastPrice
      , "weight" .= indexCompositeWeight
      , "logged" .= indexCompositeLogged
      ]


-- | Construct a value of type 'IndexComposite' (by applying it's required fields, if any)
mkIndexComposite
  :: DateTime -- ^ 'indexCompositeTimestamp' 
  -> IndexComposite
mkIndexComposite indexCompositeTimestamp =
  IndexComposite
  { indexCompositeTimestamp
  , indexCompositeSymbol = Nothing
  , indexCompositeIndexSymbol = Nothing
  , indexCompositeReference = Nothing
  , indexCompositeLastPrice = Nothing
  , indexCompositeWeight = Nothing
  , indexCompositeLogged = Nothing
  }

-- ** InlineResponse200
-- | InlineResponse200
data InlineResponse200 = InlineResponse200
  { inlineResponse200Success :: !(Maybe Bool) -- ^ "success"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON InlineResponse200
instance A.FromJSON InlineResponse200 where
  parseJSON = A.withObject "InlineResponse200" $ \o ->
    InlineResponse200
      <$> (o .:? "success")

-- | ToJSON InlineResponse200
instance A.ToJSON InlineResponse200 where
  toJSON InlineResponse200 {..} =
   _omitNulls
      [ "success" .= inlineResponse200Success
      ]


-- | Construct a value of type 'InlineResponse200' (by applying it's required fields, if any)
mkInlineResponse200
  :: InlineResponse200
mkInlineResponse200 =
  InlineResponse200
  { inlineResponse200Success = Nothing
  }

-- ** Instrument
-- | Instrument
-- Tradeable Contracts, Indices, and History
data Instrument = Instrument
  { instrumentSymbol :: !(Text) -- ^ /Required/ "symbol"
  , instrumentRootSymbol :: !(Maybe Text) -- ^ "rootSymbol"
  , instrumentState :: !(Maybe Text) -- ^ "state"
  , instrumentTyp :: !(Maybe Text) -- ^ "typ"
  , instrumentListing :: !(Maybe DateTime) -- ^ "listing"
  , instrumentFront :: !(Maybe DateTime) -- ^ "front"
  , instrumentExpiry :: !(Maybe DateTime) -- ^ "expiry"
  , instrumentSettle :: !(Maybe DateTime) -- ^ "settle"
  , instrumentRelistInterval :: !(Maybe DateTime) -- ^ "relistInterval"
  , instrumentInverseLeg :: !(Maybe Text) -- ^ "inverseLeg"
  , instrumentSellLeg :: !(Maybe Text) -- ^ "sellLeg"
  , instrumentBuyLeg :: !(Maybe Text) -- ^ "buyLeg"
  , instrumentPositionCurrency :: !(Maybe Text) -- ^ "positionCurrency"
  , instrumentUnderlying :: !(Maybe Text) -- ^ "underlying"
  , instrumentQuoteCurrency :: !(Maybe Text) -- ^ "quoteCurrency"
  , instrumentUnderlyingSymbol :: !(Maybe Text) -- ^ "underlyingSymbol"
  , instrumentReference :: !(Maybe Text) -- ^ "reference"
  , instrumentReferenceSymbol :: !(Maybe Text) -- ^ "referenceSymbol"
  , instrumentCalcInterval :: !(Maybe DateTime) -- ^ "calcInterval"
  , instrumentPublishInterval :: !(Maybe DateTime) -- ^ "publishInterval"
  , instrumentPublishTime :: !(Maybe DateTime) -- ^ "publishTime"
  , instrumentMaxOrderQty :: !(Maybe Double) -- ^ "maxOrderQty"
  , instrumentMaxPrice :: !(Maybe Double) -- ^ "maxPrice"
  , instrumentLotSize :: !(Maybe Double) -- ^ "lotSize"
  , instrumentTickSize :: !(Maybe Double) -- ^ "tickSize"
  , instrumentMultiplier :: !(Maybe Double) -- ^ "multiplier"
  , instrumentSettlCurrency :: !(Maybe Text) -- ^ "settlCurrency"
  , instrumentUnderlyingToPositionMultiplier :: !(Maybe Double) -- ^ "underlyingToPositionMultiplier"
  , instrumentUnderlyingToSettleMultiplier :: !(Maybe Double) -- ^ "underlyingToSettleMultiplier"
  , instrumentQuoteToSettleMultiplier :: !(Maybe Double) -- ^ "quoteToSettleMultiplier"
  , instrumentIsQuanto :: !(Maybe Bool) -- ^ "isQuanto"
  , instrumentIsInverse :: !(Maybe Bool) -- ^ "isInverse"
  , instrumentInitMargin :: !(Maybe Double) -- ^ "initMargin"
  , instrumentMaintMargin :: !(Maybe Double) -- ^ "maintMargin"
  , instrumentRiskLimit :: !(Maybe Double) -- ^ "riskLimit"
  , instrumentRiskStep :: !(Maybe Double) -- ^ "riskStep"
  , instrumentLimit :: !(Maybe Double) -- ^ "limit"
  , instrumentCapped :: !(Maybe Bool) -- ^ "capped"
  , instrumentTaxed :: !(Maybe Bool) -- ^ "taxed"
  , instrumentDeleverage :: !(Maybe Bool) -- ^ "deleverage"
  , instrumentMakerFee :: !(Maybe Double) -- ^ "makerFee"
  , instrumentTakerFee :: !(Maybe Double) -- ^ "takerFee"
  , instrumentSettlementFee :: !(Maybe Double) -- ^ "settlementFee"
  , instrumentInsuranceFee :: !(Maybe Double) -- ^ "insuranceFee"
  , instrumentFundingBaseSymbol :: !(Maybe Text) -- ^ "fundingBaseSymbol"
  , instrumentFundingQuoteSymbol :: !(Maybe Text) -- ^ "fundingQuoteSymbol"
  , instrumentFundingPremiumSymbol :: !(Maybe Text) -- ^ "fundingPremiumSymbol"
  , instrumentFundingTimestamp :: !(Maybe DateTime) -- ^ "fundingTimestamp"
  , instrumentFundingInterval :: !(Maybe DateTime) -- ^ "fundingInterval"
  , instrumentFundingRate :: !(Maybe Double) -- ^ "fundingRate"
  , instrumentIndicativeFundingRate :: !(Maybe Double) -- ^ "indicativeFundingRate"
  , instrumentRebalanceTimestamp :: !(Maybe DateTime) -- ^ "rebalanceTimestamp"
  , instrumentRebalanceInterval :: !(Maybe DateTime) -- ^ "rebalanceInterval"
  , instrumentOpeningTimestamp :: !(Maybe DateTime) -- ^ "openingTimestamp"
  , instrumentClosingTimestamp :: !(Maybe DateTime) -- ^ "closingTimestamp"
  , instrumentSessionInterval :: !(Maybe DateTime) -- ^ "sessionInterval"
  , instrumentPrevClosePrice :: !(Maybe Double) -- ^ "prevClosePrice"
  , instrumentLimitDownPrice :: !(Maybe Double) -- ^ "limitDownPrice"
  , instrumentLimitUpPrice :: !(Maybe Double) -- ^ "limitUpPrice"
  , instrumentBankruptLimitDownPrice :: !(Maybe Double) -- ^ "bankruptLimitDownPrice"
  , instrumentBankruptLimitUpPrice :: !(Maybe Double) -- ^ "bankruptLimitUpPrice"
  , instrumentPrevTotalVolume :: !(Maybe Double) -- ^ "prevTotalVolume"
  , instrumentTotalVolume :: !(Maybe Double) -- ^ "totalVolume"
  , instrumentVolume :: !(Maybe Double) -- ^ "volume"
  , instrumentVolume24h :: !(Maybe Double) -- ^ "volume24h"
  , instrumentPrevTotalTurnover :: !(Maybe Double) -- ^ "prevTotalTurnover"
  , instrumentTotalTurnover :: !(Maybe Double) -- ^ "totalTurnover"
  , instrumentTurnover :: !(Maybe Double) -- ^ "turnover"
  , instrumentTurnover24h :: !(Maybe Double) -- ^ "turnover24h"
  , instrumentPrevPrice24h :: !(Maybe Double) -- ^ "prevPrice24h"
  , instrumentVwap :: !(Maybe Double) -- ^ "vwap"
  , instrumentHighPrice :: !(Maybe Double) -- ^ "highPrice"
  , instrumentLowPrice :: !(Maybe Double) -- ^ "lowPrice"
  , instrumentLastPrice :: !(Maybe Double) -- ^ "lastPrice"
  , instrumentLastPriceProtected :: !(Maybe Double) -- ^ "lastPriceProtected"
  , instrumentLastTickDirection :: !(Maybe Text) -- ^ "lastTickDirection"
  , instrumentLastChangePcnt :: !(Maybe Double) -- ^ "lastChangePcnt"
  , instrumentBidPrice :: !(Maybe Double) -- ^ "bidPrice"
  , instrumentMidPrice :: !(Maybe Double) -- ^ "midPrice"
  , instrumentAskPrice :: !(Maybe Double) -- ^ "askPrice"
  , instrumentImpactBidPrice :: !(Maybe Double) -- ^ "impactBidPrice"
  , instrumentImpactMidPrice :: !(Maybe Double) -- ^ "impactMidPrice"
  , instrumentImpactAskPrice :: !(Maybe Double) -- ^ "impactAskPrice"
  , instrumentHasLiquidity :: !(Maybe Bool) -- ^ "hasLiquidity"
  , instrumentOpenInterest :: !(Maybe Double) -- ^ "openInterest"
  , instrumentOpenValue :: !(Maybe Double) -- ^ "openValue"
  , instrumentFairMethod :: !(Maybe Text) -- ^ "fairMethod"
  , instrumentFairBasisRate :: !(Maybe Double) -- ^ "fairBasisRate"
  , instrumentFairBasis :: !(Maybe Double) -- ^ "fairBasis"
  , instrumentFairPrice :: !(Maybe Double) -- ^ "fairPrice"
  , instrumentMarkMethod :: !(Maybe Text) -- ^ "markMethod"
  , instrumentMarkPrice :: !(Maybe Double) -- ^ "markPrice"
  , instrumentIndicativeTaxRate :: !(Maybe Double) -- ^ "indicativeTaxRate"
  , instrumentIndicativeSettlePrice :: !(Maybe Double) -- ^ "indicativeSettlePrice"
  , instrumentSettledPrice :: !(Maybe Double) -- ^ "settledPrice"
  , instrumentTimestamp :: !(Maybe DateTime) -- ^ "timestamp"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON Instrument
instance A.FromJSON Instrument where
  parseJSON = A.withObject "Instrument" $ \o ->
    Instrument
      <$> (o .:  "symbol")
      <*> (o .:? "rootSymbol")
      <*> (o .:? "state")
      <*> (o .:? "typ")
      <*> (o .:? "listing")
      <*> (o .:? "front")
      <*> (o .:? "expiry")
      <*> (o .:? "settle")
      <*> (o .:? "relistInterval")
      <*> (o .:? "inverseLeg")
      <*> (o .:? "sellLeg")
      <*> (o .:? "buyLeg")
      <*> (o .:? "positionCurrency")
      <*> (o .:? "underlying")
      <*> (o .:? "quoteCurrency")
      <*> (o .:? "underlyingSymbol")
      <*> (o .:? "reference")
      <*> (o .:? "referenceSymbol")
      <*> (o .:? "calcInterval")
      <*> (o .:? "publishInterval")
      <*> (o .:? "publishTime")
      <*> (o .:? "maxOrderQty")
      <*> (o .:? "maxPrice")
      <*> (o .:? "lotSize")
      <*> (o .:? "tickSize")
      <*> (o .:? "multiplier")
      <*> (o .:? "settlCurrency")
      <*> (o .:? "underlyingToPositionMultiplier")
      <*> (o .:? "underlyingToSettleMultiplier")
      <*> (o .:? "quoteToSettleMultiplier")
      <*> (o .:? "isQuanto")
      <*> (o .:? "isInverse")
      <*> (o .:? "initMargin")
      <*> (o .:? "maintMargin")
      <*> (o .:? "riskLimit")
      <*> (o .:? "riskStep")
      <*> (o .:? "limit")
      <*> (o .:? "capped")
      <*> (o .:? "taxed")
      <*> (o .:? "deleverage")
      <*> (o .:? "makerFee")
      <*> (o .:? "takerFee")
      <*> (o .:? "settlementFee")
      <*> (o .:? "insuranceFee")
      <*> (o .:? "fundingBaseSymbol")
      <*> (o .:? "fundingQuoteSymbol")
      <*> (o .:? "fundingPremiumSymbol")
      <*> (o .:? "fundingTimestamp")
      <*> (o .:? "fundingInterval")
      <*> (o .:? "fundingRate")
      <*> (o .:? "indicativeFundingRate")
      <*> (o .:? "rebalanceTimestamp")
      <*> (o .:? "rebalanceInterval")
      <*> (o .:? "openingTimestamp")
      <*> (o .:? "closingTimestamp")
      <*> (o .:? "sessionInterval")
      <*> (o .:? "prevClosePrice")
      <*> (o .:? "limitDownPrice")
      <*> (o .:? "limitUpPrice")
      <*> (o .:? "bankruptLimitDownPrice")
      <*> (o .:? "bankruptLimitUpPrice")
      <*> (o .:? "prevTotalVolume")
      <*> (o .:? "totalVolume")
      <*> (o .:? "volume")
      <*> (o .:? "volume24h")
      <*> (o .:? "prevTotalTurnover")
      <*> (o .:? "totalTurnover")
      <*> (o .:? "turnover")
      <*> (o .:? "turnover24h")
      <*> (o .:? "prevPrice24h")
      <*> (o .:? "vwap")
      <*> (o .:? "highPrice")
      <*> (o .:? "lowPrice")
      <*> (o .:? "lastPrice")
      <*> (o .:? "lastPriceProtected")
      <*> (o .:? "lastTickDirection")
      <*> (o .:? "lastChangePcnt")
      <*> (o .:? "bidPrice")
      <*> (o .:? "midPrice")
      <*> (o .:? "askPrice")
      <*> (o .:? "impactBidPrice")
      <*> (o .:? "impactMidPrice")
      <*> (o .:? "impactAskPrice")
      <*> (o .:? "hasLiquidity")
      <*> (o .:? "openInterest")
      <*> (o .:? "openValue")
      <*> (o .:? "fairMethod")
      <*> (o .:? "fairBasisRate")
      <*> (o .:? "fairBasis")
      <*> (o .:? "fairPrice")
      <*> (o .:? "markMethod")
      <*> (o .:? "markPrice")
      <*> (o .:? "indicativeTaxRate")
      <*> (o .:? "indicativeSettlePrice")
      <*> (o .:? "settledPrice")
      <*> (o .:? "timestamp")

-- | ToJSON Instrument
instance A.ToJSON Instrument where
  toJSON Instrument {..} =
   _omitNulls
      [ "symbol" .= instrumentSymbol
      , "rootSymbol" .= instrumentRootSymbol
      , "state" .= instrumentState
      , "typ" .= instrumentTyp
      , "listing" .= instrumentListing
      , "front" .= instrumentFront
      , "expiry" .= instrumentExpiry
      , "settle" .= instrumentSettle
      , "relistInterval" .= instrumentRelistInterval
      , "inverseLeg" .= instrumentInverseLeg
      , "sellLeg" .= instrumentSellLeg
      , "buyLeg" .= instrumentBuyLeg
      , "positionCurrency" .= instrumentPositionCurrency
      , "underlying" .= instrumentUnderlying
      , "quoteCurrency" .= instrumentQuoteCurrency
      , "underlyingSymbol" .= instrumentUnderlyingSymbol
      , "reference" .= instrumentReference
      , "referenceSymbol" .= instrumentReferenceSymbol
      , "calcInterval" .= instrumentCalcInterval
      , "publishInterval" .= instrumentPublishInterval
      , "publishTime" .= instrumentPublishTime
      , "maxOrderQty" .= instrumentMaxOrderQty
      , "maxPrice" .= instrumentMaxPrice
      , "lotSize" .= instrumentLotSize
      , "tickSize" .= instrumentTickSize
      , "multiplier" .= instrumentMultiplier
      , "settlCurrency" .= instrumentSettlCurrency
      , "underlyingToPositionMultiplier" .= instrumentUnderlyingToPositionMultiplier
      , "underlyingToSettleMultiplier" .= instrumentUnderlyingToSettleMultiplier
      , "quoteToSettleMultiplier" .= instrumentQuoteToSettleMultiplier
      , "isQuanto" .= instrumentIsQuanto
      , "isInverse" .= instrumentIsInverse
      , "initMargin" .= instrumentInitMargin
      , "maintMargin" .= instrumentMaintMargin
      , "riskLimit" .= instrumentRiskLimit
      , "riskStep" .= instrumentRiskStep
      , "limit" .= instrumentLimit
      , "capped" .= instrumentCapped
      , "taxed" .= instrumentTaxed
      , "deleverage" .= instrumentDeleverage
      , "makerFee" .= instrumentMakerFee
      , "takerFee" .= instrumentTakerFee
      , "settlementFee" .= instrumentSettlementFee
      , "insuranceFee" .= instrumentInsuranceFee
      , "fundingBaseSymbol" .= instrumentFundingBaseSymbol
      , "fundingQuoteSymbol" .= instrumentFundingQuoteSymbol
      , "fundingPremiumSymbol" .= instrumentFundingPremiumSymbol
      , "fundingTimestamp" .= instrumentFundingTimestamp
      , "fundingInterval" .= instrumentFundingInterval
      , "fundingRate" .= instrumentFundingRate
      , "indicativeFundingRate" .= instrumentIndicativeFundingRate
      , "rebalanceTimestamp" .= instrumentRebalanceTimestamp
      , "rebalanceInterval" .= instrumentRebalanceInterval
      , "openingTimestamp" .= instrumentOpeningTimestamp
      , "closingTimestamp" .= instrumentClosingTimestamp
      , "sessionInterval" .= instrumentSessionInterval
      , "prevClosePrice" .= instrumentPrevClosePrice
      , "limitDownPrice" .= instrumentLimitDownPrice
      , "limitUpPrice" .= instrumentLimitUpPrice
      , "bankruptLimitDownPrice" .= instrumentBankruptLimitDownPrice
      , "bankruptLimitUpPrice" .= instrumentBankruptLimitUpPrice
      , "prevTotalVolume" .= instrumentPrevTotalVolume
      , "totalVolume" .= instrumentTotalVolume
      , "volume" .= instrumentVolume
      , "volume24h" .= instrumentVolume24h
      , "prevTotalTurnover" .= instrumentPrevTotalTurnover
      , "totalTurnover" .= instrumentTotalTurnover
      , "turnover" .= instrumentTurnover
      , "turnover24h" .= instrumentTurnover24h
      , "prevPrice24h" .= instrumentPrevPrice24h
      , "vwap" .= instrumentVwap
      , "highPrice" .= instrumentHighPrice
      , "lowPrice" .= instrumentLowPrice
      , "lastPrice" .= instrumentLastPrice
      , "lastPriceProtected" .= instrumentLastPriceProtected
      , "lastTickDirection" .= instrumentLastTickDirection
      , "lastChangePcnt" .= instrumentLastChangePcnt
      , "bidPrice" .= instrumentBidPrice
      , "midPrice" .= instrumentMidPrice
      , "askPrice" .= instrumentAskPrice
      , "impactBidPrice" .= instrumentImpactBidPrice
      , "impactMidPrice" .= instrumentImpactMidPrice
      , "impactAskPrice" .= instrumentImpactAskPrice
      , "hasLiquidity" .= instrumentHasLiquidity
      , "openInterest" .= instrumentOpenInterest
      , "openValue" .= instrumentOpenValue
      , "fairMethod" .= instrumentFairMethod
      , "fairBasisRate" .= instrumentFairBasisRate
      , "fairBasis" .= instrumentFairBasis
      , "fairPrice" .= instrumentFairPrice
      , "markMethod" .= instrumentMarkMethod
      , "markPrice" .= instrumentMarkPrice
      , "indicativeTaxRate" .= instrumentIndicativeTaxRate
      , "indicativeSettlePrice" .= instrumentIndicativeSettlePrice
      , "settledPrice" .= instrumentSettledPrice
      , "timestamp" .= instrumentTimestamp
      ]


-- | Construct a value of type 'Instrument' (by applying it's required fields, if any)
mkInstrument
  :: Text -- ^ 'instrumentSymbol' 
  -> Instrument
mkInstrument instrumentSymbol =
  Instrument
  { instrumentSymbol
  , instrumentRootSymbol = Nothing
  , instrumentState = Nothing
  , instrumentTyp = Nothing
  , instrumentListing = Nothing
  , instrumentFront = Nothing
  , instrumentExpiry = Nothing
  , instrumentSettle = Nothing
  , instrumentRelistInterval = Nothing
  , instrumentInverseLeg = Nothing
  , instrumentSellLeg = Nothing
  , instrumentBuyLeg = Nothing
  , instrumentPositionCurrency = Nothing
  , instrumentUnderlying = Nothing
  , instrumentQuoteCurrency = Nothing
  , instrumentUnderlyingSymbol = Nothing
  , instrumentReference = Nothing
  , instrumentReferenceSymbol = Nothing
  , instrumentCalcInterval = Nothing
  , instrumentPublishInterval = Nothing
  , instrumentPublishTime = Nothing
  , instrumentMaxOrderQty = Nothing
  , instrumentMaxPrice = Nothing
  , instrumentLotSize = Nothing
  , instrumentTickSize = Nothing
  , instrumentMultiplier = Nothing
  , instrumentSettlCurrency = Nothing
  , instrumentUnderlyingToPositionMultiplier = Nothing
  , instrumentUnderlyingToSettleMultiplier = Nothing
  , instrumentQuoteToSettleMultiplier = Nothing
  , instrumentIsQuanto = Nothing
  , instrumentIsInverse = Nothing
  , instrumentInitMargin = Nothing
  , instrumentMaintMargin = Nothing
  , instrumentRiskLimit = Nothing
  , instrumentRiskStep = Nothing
  , instrumentLimit = Nothing
  , instrumentCapped = Nothing
  , instrumentTaxed = Nothing
  , instrumentDeleverage = Nothing
  , instrumentMakerFee = Nothing
  , instrumentTakerFee = Nothing
  , instrumentSettlementFee = Nothing
  , instrumentInsuranceFee = Nothing
  , instrumentFundingBaseSymbol = Nothing
  , instrumentFundingQuoteSymbol = Nothing
  , instrumentFundingPremiumSymbol = Nothing
  , instrumentFundingTimestamp = Nothing
  , instrumentFundingInterval = Nothing
  , instrumentFundingRate = Nothing
  , instrumentIndicativeFundingRate = Nothing
  , instrumentRebalanceTimestamp = Nothing
  , instrumentRebalanceInterval = Nothing
  , instrumentOpeningTimestamp = Nothing
  , instrumentClosingTimestamp = Nothing
  , instrumentSessionInterval = Nothing
  , instrumentPrevClosePrice = Nothing
  , instrumentLimitDownPrice = Nothing
  , instrumentLimitUpPrice = Nothing
  , instrumentBankruptLimitDownPrice = Nothing
  , instrumentBankruptLimitUpPrice = Nothing
  , instrumentPrevTotalVolume = Nothing
  , instrumentTotalVolume = Nothing
  , instrumentVolume = Nothing
  , instrumentVolume24h = Nothing
  , instrumentPrevTotalTurnover = Nothing
  , instrumentTotalTurnover = Nothing
  , instrumentTurnover = Nothing
  , instrumentTurnover24h = Nothing
  , instrumentPrevPrice24h = Nothing
  , instrumentVwap = Nothing
  , instrumentHighPrice = Nothing
  , instrumentLowPrice = Nothing
  , instrumentLastPrice = Nothing
  , instrumentLastPriceProtected = Nothing
  , instrumentLastTickDirection = Nothing
  , instrumentLastChangePcnt = Nothing
  , instrumentBidPrice = Nothing
  , instrumentMidPrice = Nothing
  , instrumentAskPrice = Nothing
  , instrumentImpactBidPrice = Nothing
  , instrumentImpactMidPrice = Nothing
  , instrumentImpactAskPrice = Nothing
  , instrumentHasLiquidity = Nothing
  , instrumentOpenInterest = Nothing
  , instrumentOpenValue = Nothing
  , instrumentFairMethod = Nothing
  , instrumentFairBasisRate = Nothing
  , instrumentFairBasis = Nothing
  , instrumentFairPrice = Nothing
  , instrumentMarkMethod = Nothing
  , instrumentMarkPrice = Nothing
  , instrumentIndicativeTaxRate = Nothing
  , instrumentIndicativeSettlePrice = Nothing
  , instrumentSettledPrice = Nothing
  , instrumentTimestamp = Nothing
  }

-- ** InstrumentInterval
-- | InstrumentInterval
data InstrumentInterval = InstrumentInterval
  { instrumentIntervalIntervals :: !([Text]) -- ^ /Required/ "intervals"
  , instrumentIntervalSymbols :: !([Text]) -- ^ /Required/ "symbols"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON InstrumentInterval
instance A.FromJSON InstrumentInterval where
  parseJSON = A.withObject "InstrumentInterval" $ \o ->
    InstrumentInterval
      <$> (o .:  "intervals")
      <*> (o .:  "symbols")

-- | ToJSON InstrumentInterval
instance A.ToJSON InstrumentInterval where
  toJSON InstrumentInterval {..} =
   _omitNulls
      [ "intervals" .= instrumentIntervalIntervals
      , "symbols" .= instrumentIntervalSymbols
      ]


-- | Construct a value of type 'InstrumentInterval' (by applying it's required fields, if any)
mkInstrumentInterval
  :: [Text] -- ^ 'instrumentIntervalIntervals' 
  -> [Text] -- ^ 'instrumentIntervalSymbols' 
  -> InstrumentInterval
mkInstrumentInterval instrumentIntervalIntervals instrumentIntervalSymbols =
  InstrumentInterval
  { instrumentIntervalIntervals
  , instrumentIntervalSymbols
  }

-- ** Insurance
-- | Insurance
-- Insurance Fund Data
data Insurance = Insurance
  { insuranceCurrency :: !(Text) -- ^ /Required/ "currency"
  , insuranceTimestamp :: !(DateTime) -- ^ /Required/ "timestamp"
  , insuranceWalletBalance :: !(Maybe Double) -- ^ "walletBalance"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON Insurance
instance A.FromJSON Insurance where
  parseJSON = A.withObject "Insurance" $ \o ->
    Insurance
      <$> (o .:  "currency")
      <*> (o .:  "timestamp")
      <*> (o .:? "walletBalance")

-- | ToJSON Insurance
instance A.ToJSON Insurance where
  toJSON Insurance {..} =
   _omitNulls
      [ "currency" .= insuranceCurrency
      , "timestamp" .= insuranceTimestamp
      , "walletBalance" .= insuranceWalletBalance
      ]


-- | Construct a value of type 'Insurance' (by applying it's required fields, if any)
mkInsurance
  :: Text -- ^ 'insuranceCurrency' 
  -> DateTime -- ^ 'insuranceTimestamp' 
  -> Insurance
mkInsurance insuranceCurrency insuranceTimestamp =
  Insurance
  { insuranceCurrency
  , insuranceTimestamp
  , insuranceWalletBalance = Nothing
  }

-- ** Leaderboard
-- | Leaderboard
-- Information on Top Users
data Leaderboard = Leaderboard
  { leaderboardName :: !(Text) -- ^ /Required/ "name"
  , leaderboardIsRealName :: !(Maybe Bool) -- ^ "isRealName"
  , leaderboardIsMe :: !(Maybe Bool) -- ^ "isMe"
  , leaderboardProfit :: !(Maybe Double) -- ^ "profit"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON Leaderboard
instance A.FromJSON Leaderboard where
  parseJSON = A.withObject "Leaderboard" $ \o ->
    Leaderboard
      <$> (o .:  "name")
      <*> (o .:? "isRealName")
      <*> (o .:? "isMe")
      <*> (o .:? "profit")

-- | ToJSON Leaderboard
instance A.ToJSON Leaderboard where
  toJSON Leaderboard {..} =
   _omitNulls
      [ "name" .= leaderboardName
      , "isRealName" .= leaderboardIsRealName
      , "isMe" .= leaderboardIsMe
      , "profit" .= leaderboardProfit
      ]


-- | Construct a value of type 'Leaderboard' (by applying it's required fields, if any)
mkLeaderboard
  :: Text -- ^ 'leaderboardName' 
  -> Leaderboard
mkLeaderboard leaderboardName =
  Leaderboard
  { leaderboardName
  , leaderboardIsRealName = Nothing
  , leaderboardIsMe = Nothing
  , leaderboardProfit = Nothing
  }

-- ** Liquidation
-- | Liquidation
-- Active Liquidations
data Liquidation = Liquidation
  { liquidationOrderId :: !(Text) -- ^ /Required/ "orderID"
  , liquidationSymbol :: !(Maybe Text) -- ^ "symbol"
  , liquidationSide :: !(Maybe Text) -- ^ "side"
  , liquidationPrice :: !(Maybe Double) -- ^ "price"
  , liquidationLeavesQty :: !(Maybe Double) -- ^ "leavesQty"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON Liquidation
instance A.FromJSON Liquidation where
  parseJSON = A.withObject "Liquidation" $ \o ->
    Liquidation
      <$> (o .:  "orderID")
      <*> (o .:? "symbol")
      <*> (o .:? "side")
      <*> (o .:? "price")
      <*> (o .:? "leavesQty")

-- | ToJSON Liquidation
instance A.ToJSON Liquidation where
  toJSON Liquidation {..} =
   _omitNulls
      [ "orderID" .= liquidationOrderId
      , "symbol" .= liquidationSymbol
      , "side" .= liquidationSide
      , "price" .= liquidationPrice
      , "leavesQty" .= liquidationLeavesQty
      ]


-- | Construct a value of type 'Liquidation' (by applying it's required fields, if any)
mkLiquidation
  :: Text -- ^ 'liquidationOrderId' 
  -> Liquidation
mkLiquidation liquidationOrderId =
  Liquidation
  { liquidationOrderId
  , liquidationSymbol = Nothing
  , liquidationSide = Nothing
  , liquidationPrice = Nothing
  , liquidationLeavesQty = Nothing
  }

-- ** Margin
-- | Margin
data Margin = Margin
  { marginAccount :: !(Double) -- ^ /Required/ "account"
  , marginCurrency :: !(Text) -- ^ /Required/ "currency"
  , marginRiskLimit :: !(Maybe Double) -- ^ "riskLimit"
  , marginPrevState :: !(Maybe Text) -- ^ "prevState"
  , marginState :: !(Maybe Text) -- ^ "state"
  , marginAction :: !(Maybe Text) -- ^ "action"
  , marginAmount :: !(Maybe Double) -- ^ "amount"
  , marginPendingCredit :: !(Maybe Double) -- ^ "pendingCredit"
  , marginPendingDebit :: !(Maybe Double) -- ^ "pendingDebit"
  , marginConfirmedDebit :: !(Maybe Double) -- ^ "confirmedDebit"
  , marginPrevRealisedPnl :: !(Maybe Double) -- ^ "prevRealisedPnl"
  , marginPrevUnrealisedPnl :: !(Maybe Double) -- ^ "prevUnrealisedPnl"
  , marginGrossComm :: !(Maybe Double) -- ^ "grossComm"
  , marginGrossOpenCost :: !(Maybe Double) -- ^ "grossOpenCost"
  , marginGrossOpenPremium :: !(Maybe Double) -- ^ "grossOpenPremium"
  , marginGrossExecCost :: !(Maybe Double) -- ^ "grossExecCost"
  , marginGrossMarkValue :: !(Maybe Double) -- ^ "grossMarkValue"
  , marginRiskValue :: !(Maybe Double) -- ^ "riskValue"
  , marginTaxableMargin :: !(Maybe Double) -- ^ "taxableMargin"
  , marginInitMargin :: !(Maybe Double) -- ^ "initMargin"
  , marginMaintMargin :: !(Maybe Double) -- ^ "maintMargin"
  , marginSessionMargin :: !(Maybe Double) -- ^ "sessionMargin"
  , marginTargetExcessMargin :: !(Maybe Double) -- ^ "targetExcessMargin"
  , marginVarMargin :: !(Maybe Double) -- ^ "varMargin"
  , marginRealisedPnl :: !(Maybe Double) -- ^ "realisedPnl"
  , marginUnrealisedPnl :: !(Maybe Double) -- ^ "unrealisedPnl"
  , marginIndicativeTax :: !(Maybe Double) -- ^ "indicativeTax"
  , marginUnrealisedProfit :: !(Maybe Double) -- ^ "unrealisedProfit"
  , marginSyntheticMargin :: !(Maybe Double) -- ^ "syntheticMargin"
  , marginWalletBalance :: !(Maybe Double) -- ^ "walletBalance"
  , marginMarginBalance :: !(Maybe Double) -- ^ "marginBalance"
  , marginMarginBalancePcnt :: !(Maybe Double) -- ^ "marginBalancePcnt"
  , marginMarginLeverage :: !(Maybe Double) -- ^ "marginLeverage"
  , marginMarginUsedPcnt :: !(Maybe Double) -- ^ "marginUsedPcnt"
  , marginExcessMargin :: !(Maybe Double) -- ^ "excessMargin"
  , marginExcessMarginPcnt :: !(Maybe Double) -- ^ "excessMarginPcnt"
  , marginAvailableMargin :: !(Maybe Double) -- ^ "availableMargin"
  , marginWithdrawableMargin :: !(Maybe Double) -- ^ "withdrawableMargin"
  , marginTimestamp :: !(Maybe DateTime) -- ^ "timestamp"
  , marginGrossLastValue :: !(Maybe Double) -- ^ "grossLastValue"
  , marginCommission :: !(Maybe Double) -- ^ "commission"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON Margin
instance A.FromJSON Margin where
  parseJSON = A.withObject "Margin" $ \o ->
    Margin
      <$> (o .:  "account")
      <*> (o .:  "currency")
      <*> (o .:? "riskLimit")
      <*> (o .:? "prevState")
      <*> (o .:? "state")
      <*> (o .:? "action")
      <*> (o .:? "amount")
      <*> (o .:? "pendingCredit")
      <*> (o .:? "pendingDebit")
      <*> (o .:? "confirmedDebit")
      <*> (o .:? "prevRealisedPnl")
      <*> (o .:? "prevUnrealisedPnl")
      <*> (o .:? "grossComm")
      <*> (o .:? "grossOpenCost")
      <*> (o .:? "grossOpenPremium")
      <*> (o .:? "grossExecCost")
      <*> (o .:? "grossMarkValue")
      <*> (o .:? "riskValue")
      <*> (o .:? "taxableMargin")
      <*> (o .:? "initMargin")
      <*> (o .:? "maintMargin")
      <*> (o .:? "sessionMargin")
      <*> (o .:? "targetExcessMargin")
      <*> (o .:? "varMargin")
      <*> (o .:? "realisedPnl")
      <*> (o .:? "unrealisedPnl")
      <*> (o .:? "indicativeTax")
      <*> (o .:? "unrealisedProfit")
      <*> (o .:? "syntheticMargin")
      <*> (o .:? "walletBalance")
      <*> (o .:? "marginBalance")
      <*> (o .:? "marginBalancePcnt")
      <*> (o .:? "marginLeverage")
      <*> (o .:? "marginUsedPcnt")
      <*> (o .:? "excessMargin")
      <*> (o .:? "excessMarginPcnt")
      <*> (o .:? "availableMargin")
      <*> (o .:? "withdrawableMargin")
      <*> (o .:? "timestamp")
      <*> (o .:? "grossLastValue")
      <*> (o .:? "commission")

-- | ToJSON Margin
instance A.ToJSON Margin where
  toJSON Margin {..} =
   _omitNulls
      [ "account" .= marginAccount
      , "currency" .= marginCurrency
      , "riskLimit" .= marginRiskLimit
      , "prevState" .= marginPrevState
      , "state" .= marginState
      , "action" .= marginAction
      , "amount" .= marginAmount
      , "pendingCredit" .= marginPendingCredit
      , "pendingDebit" .= marginPendingDebit
      , "confirmedDebit" .= marginConfirmedDebit
      , "prevRealisedPnl" .= marginPrevRealisedPnl
      , "prevUnrealisedPnl" .= marginPrevUnrealisedPnl
      , "grossComm" .= marginGrossComm
      , "grossOpenCost" .= marginGrossOpenCost
      , "grossOpenPremium" .= marginGrossOpenPremium
      , "grossExecCost" .= marginGrossExecCost
      , "grossMarkValue" .= marginGrossMarkValue
      , "riskValue" .= marginRiskValue
      , "taxableMargin" .= marginTaxableMargin
      , "initMargin" .= marginInitMargin
      , "maintMargin" .= marginMaintMargin
      , "sessionMargin" .= marginSessionMargin
      , "targetExcessMargin" .= marginTargetExcessMargin
      , "varMargin" .= marginVarMargin
      , "realisedPnl" .= marginRealisedPnl
      , "unrealisedPnl" .= marginUnrealisedPnl
      , "indicativeTax" .= marginIndicativeTax
      , "unrealisedProfit" .= marginUnrealisedProfit
      , "syntheticMargin" .= marginSyntheticMargin
      , "walletBalance" .= marginWalletBalance
      , "marginBalance" .= marginMarginBalance
      , "marginBalancePcnt" .= marginMarginBalancePcnt
      , "marginLeverage" .= marginMarginLeverage
      , "marginUsedPcnt" .= marginMarginUsedPcnt
      , "excessMargin" .= marginExcessMargin
      , "excessMarginPcnt" .= marginExcessMarginPcnt
      , "availableMargin" .= marginAvailableMargin
      , "withdrawableMargin" .= marginWithdrawableMargin
      , "timestamp" .= marginTimestamp
      , "grossLastValue" .= marginGrossLastValue
      , "commission" .= marginCommission
      ]


-- | Construct a value of type 'Margin' (by applying it's required fields, if any)
mkMargin
  :: Double -- ^ 'marginAccount' 
  -> Text -- ^ 'marginCurrency' 
  -> Margin
mkMargin marginAccount marginCurrency =
  Margin
  { marginAccount
  , marginCurrency
  , marginRiskLimit = Nothing
  , marginPrevState = Nothing
  , marginState = Nothing
  , marginAction = Nothing
  , marginAmount = Nothing
  , marginPendingCredit = Nothing
  , marginPendingDebit = Nothing
  , marginConfirmedDebit = Nothing
  , marginPrevRealisedPnl = Nothing
  , marginPrevUnrealisedPnl = Nothing
  , marginGrossComm = Nothing
  , marginGrossOpenCost = Nothing
  , marginGrossOpenPremium = Nothing
  , marginGrossExecCost = Nothing
  , marginGrossMarkValue = Nothing
  , marginRiskValue = Nothing
  , marginTaxableMargin = Nothing
  , marginInitMargin = Nothing
  , marginMaintMargin = Nothing
  , marginSessionMargin = Nothing
  , marginTargetExcessMargin = Nothing
  , marginVarMargin = Nothing
  , marginRealisedPnl = Nothing
  , marginUnrealisedPnl = Nothing
  , marginIndicativeTax = Nothing
  , marginUnrealisedProfit = Nothing
  , marginSyntheticMargin = Nothing
  , marginWalletBalance = Nothing
  , marginMarginBalance = Nothing
  , marginMarginBalancePcnt = Nothing
  , marginMarginLeverage = Nothing
  , marginMarginUsedPcnt = Nothing
  , marginExcessMargin = Nothing
  , marginExcessMarginPcnt = Nothing
  , marginAvailableMargin = Nothing
  , marginWithdrawableMargin = Nothing
  , marginTimestamp = Nothing
  , marginGrossLastValue = Nothing
  , marginCommission = Nothing
  }

-- ** Notification
-- | Notification
-- Account Notifications
data Notification = Notification
  { notificationId :: !(Maybe Double) -- ^ "id"
  , notificationDate :: !(DateTime) -- ^ /Required/ "date"
  , notificationTitle :: !(Text) -- ^ /Required/ "title"
  , notificationBody :: !(Text) -- ^ /Required/ "body"
  , notificationTtl :: !(Double) -- ^ /Required/ "ttl"
  , notificationType :: !(Maybe E'Type) -- ^ "type"
  , notificationClosable :: !(Maybe Bool) -- ^ "closable"
  , notificationPersist :: !(Maybe Bool) -- ^ "persist"
  , notificationWaitForVisibility :: !(Maybe Bool) -- ^ "waitForVisibility"
  , notificationSound :: !(Maybe Text) -- ^ "sound"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON Notification
instance A.FromJSON Notification where
  parseJSON = A.withObject "Notification" $ \o ->
    Notification
      <$> (o .:? "id")
      <*> (o .:  "date")
      <*> (o .:  "title")
      <*> (o .:  "body")
      <*> (o .:  "ttl")
      <*> (o .:? "type")
      <*> (o .:? "closable")
      <*> (o .:? "persist")
      <*> (o .:? "waitForVisibility")
      <*> (o .:? "sound")

-- | ToJSON Notification
instance A.ToJSON Notification where
  toJSON Notification {..} =
   _omitNulls
      [ "id" .= notificationId
      , "date" .= notificationDate
      , "title" .= notificationTitle
      , "body" .= notificationBody
      , "ttl" .= notificationTtl
      , "type" .= notificationType
      , "closable" .= notificationClosable
      , "persist" .= notificationPersist
      , "waitForVisibility" .= notificationWaitForVisibility
      , "sound" .= notificationSound
      ]


-- | Construct a value of type 'Notification' (by applying it's required fields, if any)
mkNotification
  :: DateTime -- ^ 'notificationDate' 
  -> Text -- ^ 'notificationTitle' 
  -> Text -- ^ 'notificationBody' 
  -> Double -- ^ 'notificationTtl' 
  -> Notification
mkNotification notificationDate notificationTitle notificationBody notificationTtl =
  Notification
  { notificationId = Nothing
  , notificationDate
  , notificationTitle
  , notificationBody
  , notificationTtl
  , notificationType = Nothing
  , notificationClosable = Nothing
  , notificationPersist = Nothing
  , notificationWaitForVisibility = Nothing
  , notificationSound = Nothing
  }

-- ** Order
-- | Order
-- Placement, Cancellation, Amending, and History
data Order = Order
  { orderOrderId :: !(Text) -- ^ /Required/ "orderID"
  , orderClOrdId :: !(Maybe Text) -- ^ "clOrdID"
  , orderClOrdLinkId :: !(Maybe Text) -- ^ "clOrdLinkID"
  , orderAccount :: !(Maybe Double) -- ^ "account"
  , orderSymbol :: !(Maybe Text) -- ^ "symbol"
  , orderSide :: !(Maybe Text) -- ^ "side"
  , orderSimpleOrderQty :: !(Maybe Double) -- ^ "simpleOrderQty"
  , orderOrderQty :: !(Maybe Double) -- ^ "orderQty"
  , orderPrice :: !(Maybe Double) -- ^ "price"
  , orderDisplayQty :: !(Maybe Double) -- ^ "displayQty"
  , orderStopPx :: !(Maybe Double) -- ^ "stopPx"
  , orderPegOffsetValue :: !(Maybe Double) -- ^ "pegOffsetValue"
  , orderPegPriceType :: !(Maybe Text) -- ^ "pegPriceType"
  , orderCurrency :: !(Maybe Text) -- ^ "currency"
  , orderSettlCurrency :: !(Maybe Text) -- ^ "settlCurrency"
  , orderOrdType :: !(Maybe Text) -- ^ "ordType"
  , orderTimeInForce :: !(Maybe Text) -- ^ "timeInForce"
  , orderExecInst :: !(Maybe Text) -- ^ "execInst"
  , orderContingencyType :: !(Maybe Text) -- ^ "contingencyType"
  , orderExDestination :: !(Maybe Text) -- ^ "exDestination"
  , orderOrdStatus :: !(Maybe Text) -- ^ "ordStatus"
  , orderTriggered :: !(Maybe Text) -- ^ "triggered"
  , orderWorkingIndicator :: !(Maybe Bool) -- ^ "workingIndicator"
  , orderOrdRejReason :: !(Maybe Text) -- ^ "ordRejReason"
  , orderSimpleLeavesQty :: !(Maybe Double) -- ^ "simpleLeavesQty"
  , orderLeavesQty :: !(Maybe Double) -- ^ "leavesQty"
  , orderSimpleCumQty :: !(Maybe Double) -- ^ "simpleCumQty"
  , orderCumQty :: !(Maybe Double) -- ^ "cumQty"
  , orderAvgPx :: !(Maybe Double) -- ^ "avgPx"
  , orderMultiLegReportingType :: !(Maybe Text) -- ^ "multiLegReportingType"
  , orderText :: !(Maybe Text) -- ^ "text"
  , orderTransactTime :: !(Maybe DateTime) -- ^ "transactTime"
  , orderTimestamp :: !(Maybe DateTime) -- ^ "timestamp"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON Order
instance A.FromJSON Order where
  parseJSON = A.withObject "Order" $ \o ->
    Order
      <$> (o .:  "orderID")
      <*> (o .:? "clOrdID")
      <*> (o .:? "clOrdLinkID")
      <*> (o .:? "account")
      <*> (o .:? "symbol")
      <*> (o .:? "side")
      <*> (o .:? "simpleOrderQty")
      <*> (o .:? "orderQty")
      <*> (o .:? "price")
      <*> (o .:? "displayQty")
      <*> (o .:? "stopPx")
      <*> (o .:? "pegOffsetValue")
      <*> (o .:? "pegPriceType")
      <*> (o .:? "currency")
      <*> (o .:? "settlCurrency")
      <*> (o .:? "ordType")
      <*> (o .:? "timeInForce")
      <*> (o .:? "execInst")
      <*> (o .:? "contingencyType")
      <*> (o .:? "exDestination")
      <*> (o .:? "ordStatus")
      <*> (o .:? "triggered")
      <*> (o .:? "workingIndicator")
      <*> (o .:? "ordRejReason")
      <*> (o .:? "simpleLeavesQty")
      <*> (o .:? "leavesQty")
      <*> (o .:? "simpleCumQty")
      <*> (o .:? "cumQty")
      <*> (o .:? "avgPx")
      <*> (o .:? "multiLegReportingType")
      <*> (o .:? "text")
      <*> (o .:? "transactTime")
      <*> (o .:? "timestamp")

-- | ToJSON Order
instance A.ToJSON Order where
  toJSON Order {..} =
   _omitNulls
      [ "orderID" .= orderOrderId
      , "clOrdID" .= orderClOrdId
      , "clOrdLinkID" .= orderClOrdLinkId
      , "account" .= orderAccount
      , "symbol" .= orderSymbol
      , "side" .= orderSide
      , "simpleOrderQty" .= orderSimpleOrderQty
      , "orderQty" .= orderOrderQty
      , "price" .= orderPrice
      , "displayQty" .= orderDisplayQty
      , "stopPx" .= orderStopPx
      , "pegOffsetValue" .= orderPegOffsetValue
      , "pegPriceType" .= orderPegPriceType
      , "currency" .= orderCurrency
      , "settlCurrency" .= orderSettlCurrency
      , "ordType" .= orderOrdType
      , "timeInForce" .= orderTimeInForce
      , "execInst" .= orderExecInst
      , "contingencyType" .= orderContingencyType
      , "exDestination" .= orderExDestination
      , "ordStatus" .= orderOrdStatus
      , "triggered" .= orderTriggered
      , "workingIndicator" .= orderWorkingIndicator
      , "ordRejReason" .= orderOrdRejReason
      , "simpleLeavesQty" .= orderSimpleLeavesQty
      , "leavesQty" .= orderLeavesQty
      , "simpleCumQty" .= orderSimpleCumQty
      , "cumQty" .= orderCumQty
      , "avgPx" .= orderAvgPx
      , "multiLegReportingType" .= orderMultiLegReportingType
      , "text" .= orderText
      , "transactTime" .= orderTransactTime
      , "timestamp" .= orderTimestamp
      ]


-- | Construct a value of type 'Order' (by applying it's required fields, if any)
mkOrder
  :: Text -- ^ 'orderOrderId' 
  -> Order
mkOrder orderOrderId =
  Order
  { orderOrderId
  , orderClOrdId = Nothing
  , orderClOrdLinkId = Nothing
  , orderAccount = Nothing
  , orderSymbol = Nothing
  , orderSide = Nothing
  , orderSimpleOrderQty = Nothing
  , orderOrderQty = Nothing
  , orderPrice = Nothing
  , orderDisplayQty = Nothing
  , orderStopPx = Nothing
  , orderPegOffsetValue = Nothing
  , orderPegPriceType = Nothing
  , orderCurrency = Nothing
  , orderSettlCurrency = Nothing
  , orderOrdType = Nothing
  , orderTimeInForce = Nothing
  , orderExecInst = Nothing
  , orderContingencyType = Nothing
  , orderExDestination = Nothing
  , orderOrdStatus = Nothing
  , orderTriggered = Nothing
  , orderWorkingIndicator = Nothing
  , orderOrdRejReason = Nothing
  , orderSimpleLeavesQty = Nothing
  , orderLeavesQty = Nothing
  , orderSimpleCumQty = Nothing
  , orderCumQty = Nothing
  , orderAvgPx = Nothing
  , orderMultiLegReportingType = Nothing
  , orderText = Nothing
  , orderTransactTime = Nothing
  , orderTimestamp = Nothing
  }

-- ** OrderBook
-- | OrderBook
-- Level 2 Book Data
data OrderBook = OrderBook
  { orderBookSymbol :: !(Text) -- ^ /Required/ "symbol"
  , orderBookLevel :: !(Double) -- ^ /Required/ "level"
  , orderBookBidSize :: !(Maybe Double) -- ^ "bidSize"
  , orderBookBidPrice :: !(Maybe Double) -- ^ "bidPrice"
  , orderBookAskPrice :: !(Maybe Double) -- ^ "askPrice"
  , orderBookAskSize :: !(Maybe Double) -- ^ "askSize"
  , orderBookTimestamp :: !(Maybe DateTime) -- ^ "timestamp"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON OrderBook
instance A.FromJSON OrderBook where
  parseJSON = A.withObject "OrderBook" $ \o ->
    OrderBook
      <$> (o .:  "symbol")
      <*> (o .:  "level")
      <*> (o .:? "bidSize")
      <*> (o .:? "bidPrice")
      <*> (o .:? "askPrice")
      <*> (o .:? "askSize")
      <*> (o .:? "timestamp")

-- | ToJSON OrderBook
instance A.ToJSON OrderBook where
  toJSON OrderBook {..} =
   _omitNulls
      [ "symbol" .= orderBookSymbol
      , "level" .= orderBookLevel
      , "bidSize" .= orderBookBidSize
      , "bidPrice" .= orderBookBidPrice
      , "askPrice" .= orderBookAskPrice
      , "askSize" .= orderBookAskSize
      , "timestamp" .= orderBookTimestamp
      ]


-- | Construct a value of type 'OrderBook' (by applying it's required fields, if any)
mkOrderBook
  :: Text -- ^ 'orderBookSymbol' 
  -> Double -- ^ 'orderBookLevel' 
  -> OrderBook
mkOrderBook orderBookSymbol orderBookLevel =
  OrderBook
  { orderBookSymbol
  , orderBookLevel
  , orderBookBidSize = Nothing
  , orderBookBidPrice = Nothing
  , orderBookAskPrice = Nothing
  , orderBookAskSize = Nothing
  , orderBookTimestamp = Nothing
  }

-- ** OrderBookL2
-- | OrderBookL2
data OrderBookL2 = OrderBookL2
  { orderBookL2Symbol :: !(Text) -- ^ /Required/ "symbol"
  , orderBookL2Id :: !(Double) -- ^ /Required/ "id"
  , orderBookL2Side :: !(Text) -- ^ /Required/ "side"
  , orderBookL2Size :: !(Maybe Double) -- ^ "size"
  , orderBookL2Price :: !(Maybe Double) -- ^ "price"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON OrderBookL2
instance A.FromJSON OrderBookL2 where
  parseJSON = A.withObject "OrderBookL2" $ \o ->
    OrderBookL2
      <$> (o .:  "symbol")
      <*> (o .:  "id")
      <*> (o .:  "side")
      <*> (o .:? "size")
      <*> (o .:? "price")

-- | ToJSON OrderBookL2
instance A.ToJSON OrderBookL2 where
  toJSON OrderBookL2 {..} =
   _omitNulls
      [ "symbol" .= orderBookL2Symbol
      , "id" .= orderBookL2Id
      , "side" .= orderBookL2Side
      , "size" .= orderBookL2Size
      , "price" .= orderBookL2Price
      ]


-- | Construct a value of type 'OrderBookL2' (by applying it's required fields, if any)
mkOrderBookL2
  :: Text -- ^ 'orderBookL2Symbol' 
  -> Double -- ^ 'orderBookL2Id' 
  -> Text -- ^ 'orderBookL2Side' 
  -> OrderBookL2
mkOrderBookL2 orderBookL2Symbol orderBookL2Id orderBookL2Side =
  OrderBookL2
  { orderBookL2Symbol
  , orderBookL2Id
  , orderBookL2Side
  , orderBookL2Size = Nothing
  , orderBookL2Price = Nothing
  }

-- ** Position
-- | Position
-- Summary of Open and Closed Positions
data Position = Position
  { positionAccount :: !(Double) -- ^ /Required/ "account"
  , positionSymbol :: !(Text) -- ^ /Required/ "symbol"
  , positionCurrency :: !(Text) -- ^ /Required/ "currency"
  , positionUnderlying :: !(Maybe Text) -- ^ "underlying"
  , positionQuoteCurrency :: !(Maybe Text) -- ^ "quoteCurrency"
  , positionCommission :: !(Maybe Double) -- ^ "commission"
  , positionInitMarginReq :: !(Maybe Double) -- ^ "initMarginReq"
  , positionMaintMarginReq :: !(Maybe Double) -- ^ "maintMarginReq"
  , positionRiskLimit :: !(Maybe Double) -- ^ "riskLimit"
  , positionLeverage :: !(Maybe Double) -- ^ "leverage"
  , positionCrossMargin :: !(Maybe Bool) -- ^ "crossMargin"
  , positionDeleveragePercentile :: !(Maybe Double) -- ^ "deleveragePercentile"
  , positionRebalancedPnl :: !(Maybe Double) -- ^ "rebalancedPnl"
  , positionPrevRealisedPnl :: !(Maybe Double) -- ^ "prevRealisedPnl"
  , positionPrevUnrealisedPnl :: !(Maybe Double) -- ^ "prevUnrealisedPnl"
  , positionPrevClosePrice :: !(Maybe Double) -- ^ "prevClosePrice"
  , positionOpeningTimestamp :: !(Maybe DateTime) -- ^ "openingTimestamp"
  , positionOpeningQty :: !(Maybe Double) -- ^ "openingQty"
  , positionOpeningCost :: !(Maybe Double) -- ^ "openingCost"
  , positionOpeningComm :: !(Maybe Double) -- ^ "openingComm"
  , positionOpenOrderBuyQty :: !(Maybe Double) -- ^ "openOrderBuyQty"
  , positionOpenOrderBuyCost :: !(Maybe Double) -- ^ "openOrderBuyCost"
  , positionOpenOrderBuyPremium :: !(Maybe Double) -- ^ "openOrderBuyPremium"
  , positionOpenOrderSellQty :: !(Maybe Double) -- ^ "openOrderSellQty"
  , positionOpenOrderSellCost :: !(Maybe Double) -- ^ "openOrderSellCost"
  , positionOpenOrderSellPremium :: !(Maybe Double) -- ^ "openOrderSellPremium"
  , positionExecBuyQty :: !(Maybe Double) -- ^ "execBuyQty"
  , positionExecBuyCost :: !(Maybe Double) -- ^ "execBuyCost"
  , positionExecSellQty :: !(Maybe Double) -- ^ "execSellQty"
  , positionExecSellCost :: !(Maybe Double) -- ^ "execSellCost"
  , positionExecQty :: !(Maybe Double) -- ^ "execQty"
  , positionExecCost :: !(Maybe Double) -- ^ "execCost"
  , positionExecComm :: !(Maybe Double) -- ^ "execComm"
  , positionCurrentTimestamp :: !(Maybe DateTime) -- ^ "currentTimestamp"
  , positionCurrentQty :: !(Maybe Double) -- ^ "currentQty"
  , positionCurrentCost :: !(Maybe Double) -- ^ "currentCost"
  , positionCurrentComm :: !(Maybe Double) -- ^ "currentComm"
  , positionRealisedCost :: !(Maybe Double) -- ^ "realisedCost"
  , positionUnrealisedCost :: !(Maybe Double) -- ^ "unrealisedCost"
  , positionGrossOpenCost :: !(Maybe Double) -- ^ "grossOpenCost"
  , positionGrossOpenPremium :: !(Maybe Double) -- ^ "grossOpenPremium"
  , positionGrossExecCost :: !(Maybe Double) -- ^ "grossExecCost"
  , positionIsOpen :: !(Maybe Bool) -- ^ "isOpen"
  , positionMarkPrice :: !(Maybe Double) -- ^ "markPrice"
  , positionMarkValue :: !(Maybe Double) -- ^ "markValue"
  , positionRiskValue :: !(Maybe Double) -- ^ "riskValue"
  , positionHomeNotional :: !(Maybe Double) -- ^ "homeNotional"
  , positionForeignNotional :: !(Maybe Double) -- ^ "foreignNotional"
  , positionPosState :: !(Maybe Text) -- ^ "posState"
  , positionPosCost :: !(Maybe Double) -- ^ "posCost"
  , positionPosCost2 :: !(Maybe Double) -- ^ "posCost2"
  , positionPosCross :: !(Maybe Double) -- ^ "posCross"
  , positionPosInit :: !(Maybe Double) -- ^ "posInit"
  , positionPosComm :: !(Maybe Double) -- ^ "posComm"
  , positionPosLoss :: !(Maybe Double) -- ^ "posLoss"
  , positionPosMargin :: !(Maybe Double) -- ^ "posMargin"
  , positionPosMaint :: !(Maybe Double) -- ^ "posMaint"
  , positionPosAllowance :: !(Maybe Double) -- ^ "posAllowance"
  , positionTaxableMargin :: !(Maybe Double) -- ^ "taxableMargin"
  , positionInitMargin :: !(Maybe Double) -- ^ "initMargin"
  , positionMaintMargin :: !(Maybe Double) -- ^ "maintMargin"
  , positionSessionMargin :: !(Maybe Double) -- ^ "sessionMargin"
  , positionTargetExcessMargin :: !(Maybe Double) -- ^ "targetExcessMargin"
  , positionVarMargin :: !(Maybe Double) -- ^ "varMargin"
  , positionRealisedGrossPnl :: !(Maybe Double) -- ^ "realisedGrossPnl"
  , positionRealisedTax :: !(Maybe Double) -- ^ "realisedTax"
  , positionRealisedPnl :: !(Maybe Double) -- ^ "realisedPnl"
  , positionUnrealisedGrossPnl :: !(Maybe Double) -- ^ "unrealisedGrossPnl"
  , positionLongBankrupt :: !(Maybe Double) -- ^ "longBankrupt"
  , positionShortBankrupt :: !(Maybe Double) -- ^ "shortBankrupt"
  , positionTaxBase :: !(Maybe Double) -- ^ "taxBase"
  , positionIndicativeTaxRate :: !(Maybe Double) -- ^ "indicativeTaxRate"
  , positionIndicativeTax :: !(Maybe Double) -- ^ "indicativeTax"
  , positionUnrealisedTax :: !(Maybe Double) -- ^ "unrealisedTax"
  , positionUnrealisedPnl :: !(Maybe Double) -- ^ "unrealisedPnl"
  , positionUnrealisedPnlPcnt :: !(Maybe Double) -- ^ "unrealisedPnlPcnt"
  , positionUnrealisedRoePcnt :: !(Maybe Double) -- ^ "unrealisedRoePcnt"
  , positionSimpleQty :: !(Maybe Double) -- ^ "simpleQty"
  , positionSimpleCost :: !(Maybe Double) -- ^ "simpleCost"
  , positionSimpleValue :: !(Maybe Double) -- ^ "simpleValue"
  , positionSimplePnl :: !(Maybe Double) -- ^ "simplePnl"
  , positionSimplePnlPcnt :: !(Maybe Double) -- ^ "simplePnlPcnt"
  , positionAvgCostPrice :: !(Maybe Double) -- ^ "avgCostPrice"
  , positionAvgEntryPrice :: !(Maybe Double) -- ^ "avgEntryPrice"
  , positionBreakEvenPrice :: !(Maybe Double) -- ^ "breakEvenPrice"
  , positionMarginCallPrice :: !(Maybe Double) -- ^ "marginCallPrice"
  , positionLiquidationPrice :: !(Maybe Double) -- ^ "liquidationPrice"
  , positionBankruptPrice :: !(Maybe Double) -- ^ "bankruptPrice"
  , positionTimestamp :: !(Maybe DateTime) -- ^ "timestamp"
  , positionLastPrice :: !(Maybe Double) -- ^ "lastPrice"
  , positionLastValue :: !(Maybe Double) -- ^ "lastValue"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON Position
instance A.FromJSON Position where
  parseJSON = A.withObject "Position" $ \o ->
    Position
      <$> (o .:  "account")
      <*> (o .:  "symbol")
      <*> (o .:  "currency")
      <*> (o .:? "underlying")
      <*> (o .:? "quoteCurrency")
      <*> (o .:? "commission")
      <*> (o .:? "initMarginReq")
      <*> (o .:? "maintMarginReq")
      <*> (o .:? "riskLimit")
      <*> (o .:? "leverage")
      <*> (o .:? "crossMargin")
      <*> (o .:? "deleveragePercentile")
      <*> (o .:? "rebalancedPnl")
      <*> (o .:? "prevRealisedPnl")
      <*> (o .:? "prevUnrealisedPnl")
      <*> (o .:? "prevClosePrice")
      <*> (o .:? "openingTimestamp")
      <*> (o .:? "openingQty")
      <*> (o .:? "openingCost")
      <*> (o .:? "openingComm")
      <*> (o .:? "openOrderBuyQty")
      <*> (o .:? "openOrderBuyCost")
      <*> (o .:? "openOrderBuyPremium")
      <*> (o .:? "openOrderSellQty")
      <*> (o .:? "openOrderSellCost")
      <*> (o .:? "openOrderSellPremium")
      <*> (o .:? "execBuyQty")
      <*> (o .:? "execBuyCost")
      <*> (o .:? "execSellQty")
      <*> (o .:? "execSellCost")
      <*> (o .:? "execQty")
      <*> (o .:? "execCost")
      <*> (o .:? "execComm")
      <*> (o .:? "currentTimestamp")
      <*> (o .:? "currentQty")
      <*> (o .:? "currentCost")
      <*> (o .:? "currentComm")
      <*> (o .:? "realisedCost")
      <*> (o .:? "unrealisedCost")
      <*> (o .:? "grossOpenCost")
      <*> (o .:? "grossOpenPremium")
      <*> (o .:? "grossExecCost")
      <*> (o .:? "isOpen")
      <*> (o .:? "markPrice")
      <*> (o .:? "markValue")
      <*> (o .:? "riskValue")
      <*> (o .:? "homeNotional")
      <*> (o .:? "foreignNotional")
      <*> (o .:? "posState")
      <*> (o .:? "posCost")
      <*> (o .:? "posCost2")
      <*> (o .:? "posCross")
      <*> (o .:? "posInit")
      <*> (o .:? "posComm")
      <*> (o .:? "posLoss")
      <*> (o .:? "posMargin")
      <*> (o .:? "posMaint")
      <*> (o .:? "posAllowance")
      <*> (o .:? "taxableMargin")
      <*> (o .:? "initMargin")
      <*> (o .:? "maintMargin")
      <*> (o .:? "sessionMargin")
      <*> (o .:? "targetExcessMargin")
      <*> (o .:? "varMargin")
      <*> (o .:? "realisedGrossPnl")
      <*> (o .:? "realisedTax")
      <*> (o .:? "realisedPnl")
      <*> (o .:? "unrealisedGrossPnl")
      <*> (o .:? "longBankrupt")
      <*> (o .:? "shortBankrupt")
      <*> (o .:? "taxBase")
      <*> (o .:? "indicativeTaxRate")
      <*> (o .:? "indicativeTax")
      <*> (o .:? "unrealisedTax")
      <*> (o .:? "unrealisedPnl")
      <*> (o .:? "unrealisedPnlPcnt")
      <*> (o .:? "unrealisedRoePcnt")
      <*> (o .:? "simpleQty")
      <*> (o .:? "simpleCost")
      <*> (o .:? "simpleValue")
      <*> (o .:? "simplePnl")
      <*> (o .:? "simplePnlPcnt")
      <*> (o .:? "avgCostPrice")
      <*> (o .:? "avgEntryPrice")
      <*> (o .:? "breakEvenPrice")
      <*> (o .:? "marginCallPrice")
      <*> (o .:? "liquidationPrice")
      <*> (o .:? "bankruptPrice")
      <*> (o .:? "timestamp")
      <*> (o .:? "lastPrice")
      <*> (o .:? "lastValue")

-- | ToJSON Position
instance A.ToJSON Position where
  toJSON Position {..} =
   _omitNulls
      [ "account" .= positionAccount
      , "symbol" .= positionSymbol
      , "currency" .= positionCurrency
      , "underlying" .= positionUnderlying
      , "quoteCurrency" .= positionQuoteCurrency
      , "commission" .= positionCommission
      , "initMarginReq" .= positionInitMarginReq
      , "maintMarginReq" .= positionMaintMarginReq
      , "riskLimit" .= positionRiskLimit
      , "leverage" .= positionLeverage
      , "crossMargin" .= positionCrossMargin
      , "deleveragePercentile" .= positionDeleveragePercentile
      , "rebalancedPnl" .= positionRebalancedPnl
      , "prevRealisedPnl" .= positionPrevRealisedPnl
      , "prevUnrealisedPnl" .= positionPrevUnrealisedPnl
      , "prevClosePrice" .= positionPrevClosePrice
      , "openingTimestamp" .= positionOpeningTimestamp
      , "openingQty" .= positionOpeningQty
      , "openingCost" .= positionOpeningCost
      , "openingComm" .= positionOpeningComm
      , "openOrderBuyQty" .= positionOpenOrderBuyQty
      , "openOrderBuyCost" .= positionOpenOrderBuyCost
      , "openOrderBuyPremium" .= positionOpenOrderBuyPremium
      , "openOrderSellQty" .= positionOpenOrderSellQty
      , "openOrderSellCost" .= positionOpenOrderSellCost
      , "openOrderSellPremium" .= positionOpenOrderSellPremium
      , "execBuyQty" .= positionExecBuyQty
      , "execBuyCost" .= positionExecBuyCost
      , "execSellQty" .= positionExecSellQty
      , "execSellCost" .= positionExecSellCost
      , "execQty" .= positionExecQty
      , "execCost" .= positionExecCost
      , "execComm" .= positionExecComm
      , "currentTimestamp" .= positionCurrentTimestamp
      , "currentQty" .= positionCurrentQty
      , "currentCost" .= positionCurrentCost
      , "currentComm" .= positionCurrentComm
      , "realisedCost" .= positionRealisedCost
      , "unrealisedCost" .= positionUnrealisedCost
      , "grossOpenCost" .= positionGrossOpenCost
      , "grossOpenPremium" .= positionGrossOpenPremium
      , "grossExecCost" .= positionGrossExecCost
      , "isOpen" .= positionIsOpen
      , "markPrice" .= positionMarkPrice
      , "markValue" .= positionMarkValue
      , "riskValue" .= positionRiskValue
      , "homeNotional" .= positionHomeNotional
      , "foreignNotional" .= positionForeignNotional
      , "posState" .= positionPosState
      , "posCost" .= positionPosCost
      , "posCost2" .= positionPosCost2
      , "posCross" .= positionPosCross
      , "posInit" .= positionPosInit
      , "posComm" .= positionPosComm
      , "posLoss" .= positionPosLoss
      , "posMargin" .= positionPosMargin
      , "posMaint" .= positionPosMaint
      , "posAllowance" .= positionPosAllowance
      , "taxableMargin" .= positionTaxableMargin
      , "initMargin" .= positionInitMargin
      , "maintMargin" .= positionMaintMargin
      , "sessionMargin" .= positionSessionMargin
      , "targetExcessMargin" .= positionTargetExcessMargin
      , "varMargin" .= positionVarMargin
      , "realisedGrossPnl" .= positionRealisedGrossPnl
      , "realisedTax" .= positionRealisedTax
      , "realisedPnl" .= positionRealisedPnl
      , "unrealisedGrossPnl" .= positionUnrealisedGrossPnl
      , "longBankrupt" .= positionLongBankrupt
      , "shortBankrupt" .= positionShortBankrupt
      , "taxBase" .= positionTaxBase
      , "indicativeTaxRate" .= positionIndicativeTaxRate
      , "indicativeTax" .= positionIndicativeTax
      , "unrealisedTax" .= positionUnrealisedTax
      , "unrealisedPnl" .= positionUnrealisedPnl
      , "unrealisedPnlPcnt" .= positionUnrealisedPnlPcnt
      , "unrealisedRoePcnt" .= positionUnrealisedRoePcnt
      , "simpleQty" .= positionSimpleQty
      , "simpleCost" .= positionSimpleCost
      , "simpleValue" .= positionSimpleValue
      , "simplePnl" .= positionSimplePnl
      , "simplePnlPcnt" .= positionSimplePnlPcnt
      , "avgCostPrice" .= positionAvgCostPrice
      , "avgEntryPrice" .= positionAvgEntryPrice
      , "breakEvenPrice" .= positionBreakEvenPrice
      , "marginCallPrice" .= positionMarginCallPrice
      , "liquidationPrice" .= positionLiquidationPrice
      , "bankruptPrice" .= positionBankruptPrice
      , "timestamp" .= positionTimestamp
      , "lastPrice" .= positionLastPrice
      , "lastValue" .= positionLastValue
      ]


-- | Construct a value of type 'Position' (by applying it's required fields, if any)
mkPosition
  :: Double -- ^ 'positionAccount' 
  -> Text -- ^ 'positionSymbol' 
  -> Text -- ^ 'positionCurrency' 
  -> Position
mkPosition positionAccount positionSymbol positionCurrency =
  Position
  { positionAccount
  , positionSymbol
  , positionCurrency
  , positionUnderlying = Nothing
  , positionQuoteCurrency = Nothing
  , positionCommission = Nothing
  , positionInitMarginReq = Nothing
  , positionMaintMarginReq = Nothing
  , positionRiskLimit = Nothing
  , positionLeverage = Nothing
  , positionCrossMargin = Nothing
  , positionDeleveragePercentile = Nothing
  , positionRebalancedPnl = Nothing
  , positionPrevRealisedPnl = Nothing
  , positionPrevUnrealisedPnl = Nothing
  , positionPrevClosePrice = Nothing
  , positionOpeningTimestamp = Nothing
  , positionOpeningQty = Nothing
  , positionOpeningCost = Nothing
  , positionOpeningComm = Nothing
  , positionOpenOrderBuyQty = Nothing
  , positionOpenOrderBuyCost = Nothing
  , positionOpenOrderBuyPremium = Nothing
  , positionOpenOrderSellQty = Nothing
  , positionOpenOrderSellCost = Nothing
  , positionOpenOrderSellPremium = Nothing
  , positionExecBuyQty = Nothing
  , positionExecBuyCost = Nothing
  , positionExecSellQty = Nothing
  , positionExecSellCost = Nothing
  , positionExecQty = Nothing
  , positionExecCost = Nothing
  , positionExecComm = Nothing
  , positionCurrentTimestamp = Nothing
  , positionCurrentQty = Nothing
  , positionCurrentCost = Nothing
  , positionCurrentComm = Nothing
  , positionRealisedCost = Nothing
  , positionUnrealisedCost = Nothing
  , positionGrossOpenCost = Nothing
  , positionGrossOpenPremium = Nothing
  , positionGrossExecCost = Nothing
  , positionIsOpen = Nothing
  , positionMarkPrice = Nothing
  , positionMarkValue = Nothing
  , positionRiskValue = Nothing
  , positionHomeNotional = Nothing
  , positionForeignNotional = Nothing
  , positionPosState = Nothing
  , positionPosCost = Nothing
  , positionPosCost2 = Nothing
  , positionPosCross = Nothing
  , positionPosInit = Nothing
  , positionPosComm = Nothing
  , positionPosLoss = Nothing
  , positionPosMargin = Nothing
  , positionPosMaint = Nothing
  , positionPosAllowance = Nothing
  , positionTaxableMargin = Nothing
  , positionInitMargin = Nothing
  , positionMaintMargin = Nothing
  , positionSessionMargin = Nothing
  , positionTargetExcessMargin = Nothing
  , positionVarMargin = Nothing
  , positionRealisedGrossPnl = Nothing
  , positionRealisedTax = Nothing
  , positionRealisedPnl = Nothing
  , positionUnrealisedGrossPnl = Nothing
  , positionLongBankrupt = Nothing
  , positionShortBankrupt = Nothing
  , positionTaxBase = Nothing
  , positionIndicativeTaxRate = Nothing
  , positionIndicativeTax = Nothing
  , positionUnrealisedTax = Nothing
  , positionUnrealisedPnl = Nothing
  , positionUnrealisedPnlPcnt = Nothing
  , positionUnrealisedRoePcnt = Nothing
  , positionSimpleQty = Nothing
  , positionSimpleCost = Nothing
  , positionSimpleValue = Nothing
  , positionSimplePnl = Nothing
  , positionSimplePnlPcnt = Nothing
  , positionAvgCostPrice = Nothing
  , positionAvgEntryPrice = Nothing
  , positionBreakEvenPrice = Nothing
  , positionMarginCallPrice = Nothing
  , positionLiquidationPrice = Nothing
  , positionBankruptPrice = Nothing
  , positionTimestamp = Nothing
  , positionLastPrice = Nothing
  , positionLastValue = Nothing
  }

-- ** Quote
-- | Quote
-- Best Bid/Offer Snapshots & Historical Bins
data Quote = Quote
  { quoteTimestamp :: !(DateTime) -- ^ /Required/ "timestamp"
  , quoteSymbol :: !(Text) -- ^ /Required/ "symbol"
  , quoteBidSize :: !(Maybe Double) -- ^ "bidSize"
  , quoteBidPrice :: !(Maybe Double) -- ^ "bidPrice"
  , quoteAskPrice :: !(Maybe Double) -- ^ "askPrice"
  , quoteAskSize :: !(Maybe Double) -- ^ "askSize"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON Quote
instance A.FromJSON Quote where
  parseJSON = A.withObject "Quote" $ \o ->
    Quote
      <$> (o .:  "timestamp")
      <*> (o .:  "symbol")
      <*> (o .:? "bidSize")
      <*> (o .:? "bidPrice")
      <*> (o .:? "askPrice")
      <*> (o .:? "askSize")

-- | ToJSON Quote
instance A.ToJSON Quote where
  toJSON Quote {..} =
   _omitNulls
      [ "timestamp" .= quoteTimestamp
      , "symbol" .= quoteSymbol
      , "bidSize" .= quoteBidSize
      , "bidPrice" .= quoteBidPrice
      , "askPrice" .= quoteAskPrice
      , "askSize" .= quoteAskSize
      ]


-- | Construct a value of type 'Quote' (by applying it's required fields, if any)
mkQuote
  :: DateTime -- ^ 'quoteTimestamp' 
  -> Text -- ^ 'quoteSymbol' 
  -> Quote
mkQuote quoteTimestamp quoteSymbol =
  Quote
  { quoteTimestamp
  , quoteSymbol
  , quoteBidSize = Nothing
  , quoteBidPrice = Nothing
  , quoteAskPrice = Nothing
  , quoteAskSize = Nothing
  }

-- ** Settlement
-- | Settlement
-- Historical Settlement Data
data Settlement = Settlement
  { settlementTimestamp :: !(DateTime) -- ^ /Required/ "timestamp"
  , settlementSymbol :: !(Text) -- ^ /Required/ "symbol"
  , settlementSettlementType :: !(Maybe Text) -- ^ "settlementType"
  , settlementSettledPrice :: !(Maybe Double) -- ^ "settledPrice"
  , settlementBankrupt :: !(Maybe Double) -- ^ "bankrupt"
  , settlementTaxBase :: !(Maybe Double) -- ^ "taxBase"
  , settlementTaxRate :: !(Maybe Double) -- ^ "taxRate"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON Settlement
instance A.FromJSON Settlement where
  parseJSON = A.withObject "Settlement" $ \o ->
    Settlement
      <$> (o .:  "timestamp")
      <*> (o .:  "symbol")
      <*> (o .:? "settlementType")
      <*> (o .:? "settledPrice")
      <*> (o .:? "bankrupt")
      <*> (o .:? "taxBase")
      <*> (o .:? "taxRate")

-- | ToJSON Settlement
instance A.ToJSON Settlement where
  toJSON Settlement {..} =
   _omitNulls
      [ "timestamp" .= settlementTimestamp
      , "symbol" .= settlementSymbol
      , "settlementType" .= settlementSettlementType
      , "settledPrice" .= settlementSettledPrice
      , "bankrupt" .= settlementBankrupt
      , "taxBase" .= settlementTaxBase
      , "taxRate" .= settlementTaxRate
      ]


-- | Construct a value of type 'Settlement' (by applying it's required fields, if any)
mkSettlement
  :: DateTime -- ^ 'settlementTimestamp' 
  -> Text -- ^ 'settlementSymbol' 
  -> Settlement
mkSettlement settlementTimestamp settlementSymbol =
  Settlement
  { settlementTimestamp
  , settlementSymbol
  , settlementSettlementType = Nothing
  , settlementSettledPrice = Nothing
  , settlementBankrupt = Nothing
  , settlementTaxBase = Nothing
  , settlementTaxRate = Nothing
  }

-- ** Stats
-- | Stats
-- Exchange Statistics
data Stats = Stats
  { statsRootSymbol :: !(Text) -- ^ /Required/ "rootSymbol"
  , statsCurrency :: !(Maybe Text) -- ^ "currency"
  , statsVolume24h :: !(Maybe Double) -- ^ "volume24h"
  , statsTurnover24h :: !(Maybe Double) -- ^ "turnover24h"
  , statsOpenInterest :: !(Maybe Double) -- ^ "openInterest"
  , statsOpenValue :: !(Maybe Double) -- ^ "openValue"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON Stats
instance A.FromJSON Stats where
  parseJSON = A.withObject "Stats" $ \o ->
    Stats
      <$> (o .:  "rootSymbol")
      <*> (o .:? "currency")
      <*> (o .:? "volume24h")
      <*> (o .:? "turnover24h")
      <*> (o .:? "openInterest")
      <*> (o .:? "openValue")

-- | ToJSON Stats
instance A.ToJSON Stats where
  toJSON Stats {..} =
   _omitNulls
      [ "rootSymbol" .= statsRootSymbol
      , "currency" .= statsCurrency
      , "volume24h" .= statsVolume24h
      , "turnover24h" .= statsTurnover24h
      , "openInterest" .= statsOpenInterest
      , "openValue" .= statsOpenValue
      ]


-- | Construct a value of type 'Stats' (by applying it's required fields, if any)
mkStats
  :: Text -- ^ 'statsRootSymbol' 
  -> Stats
mkStats statsRootSymbol =
  Stats
  { statsRootSymbol
  , statsCurrency = Nothing
  , statsVolume24h = Nothing
  , statsTurnover24h = Nothing
  , statsOpenInterest = Nothing
  , statsOpenValue = Nothing
  }

-- ** StatsHistory
-- | StatsHistory
data StatsHistory = StatsHistory
  { statsHistoryDate :: !(DateTime) -- ^ /Required/ "date"
  , statsHistoryRootSymbol :: !(Text) -- ^ /Required/ "rootSymbol"
  , statsHistoryCurrency :: !(Maybe Text) -- ^ "currency"
  , statsHistoryVolume :: !(Maybe Double) -- ^ "volume"
  , statsHistoryTurnover :: !(Maybe Double) -- ^ "turnover"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON StatsHistory
instance A.FromJSON StatsHistory where
  parseJSON = A.withObject "StatsHistory" $ \o ->
    StatsHistory
      <$> (o .:  "date")
      <*> (o .:  "rootSymbol")
      <*> (o .:? "currency")
      <*> (o .:? "volume")
      <*> (o .:? "turnover")

-- | ToJSON StatsHistory
instance A.ToJSON StatsHistory where
  toJSON StatsHistory {..} =
   _omitNulls
      [ "date" .= statsHistoryDate
      , "rootSymbol" .= statsHistoryRootSymbol
      , "currency" .= statsHistoryCurrency
      , "volume" .= statsHistoryVolume
      , "turnover" .= statsHistoryTurnover
      ]


-- | Construct a value of type 'StatsHistory' (by applying it's required fields, if any)
mkStatsHistory
  :: DateTime -- ^ 'statsHistoryDate' 
  -> Text -- ^ 'statsHistoryRootSymbol' 
  -> StatsHistory
mkStatsHistory statsHistoryDate statsHistoryRootSymbol =
  StatsHistory
  { statsHistoryDate
  , statsHistoryRootSymbol
  , statsHistoryCurrency = Nothing
  , statsHistoryVolume = Nothing
  , statsHistoryTurnover = Nothing
  }

-- ** StatsUSD
-- | StatsUSD
data StatsUSD = StatsUSD
  { statsUSDRootSymbol :: !(Text) -- ^ /Required/ "rootSymbol"
  , statsUSDCurrency :: !(Maybe Text) -- ^ "currency"
  , statsUSDTurnover24h :: !(Maybe Double) -- ^ "turnover24h"
  , statsUSDTurnover30d :: !(Maybe Double) -- ^ "turnover30d"
  , statsUSDTurnover365d :: !(Maybe Double) -- ^ "turnover365d"
  , statsUSDTurnover :: !(Maybe Double) -- ^ "turnover"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON StatsUSD
instance A.FromJSON StatsUSD where
  parseJSON = A.withObject "StatsUSD" $ \o ->
    StatsUSD
      <$> (o .:  "rootSymbol")
      <*> (o .:? "currency")
      <*> (o .:? "turnover24h")
      <*> (o .:? "turnover30d")
      <*> (o .:? "turnover365d")
      <*> (o .:? "turnover")

-- | ToJSON StatsUSD
instance A.ToJSON StatsUSD where
  toJSON StatsUSD {..} =
   _omitNulls
      [ "rootSymbol" .= statsUSDRootSymbol
      , "currency" .= statsUSDCurrency
      , "turnover24h" .= statsUSDTurnover24h
      , "turnover30d" .= statsUSDTurnover30d
      , "turnover365d" .= statsUSDTurnover365d
      , "turnover" .= statsUSDTurnover
      ]


-- | Construct a value of type 'StatsUSD' (by applying it's required fields, if any)
mkStatsUSD
  :: Text -- ^ 'statsUSDRootSymbol' 
  -> StatsUSD
mkStatsUSD statsUSDRootSymbol =
  StatsUSD
  { statsUSDRootSymbol
  , statsUSDCurrency = Nothing
  , statsUSDTurnover24h = Nothing
  , statsUSDTurnover30d = Nothing
  , statsUSDTurnover365d = Nothing
  , statsUSDTurnover = Nothing
  }

-- ** Trade
-- | Trade
-- Individual & Bucketed Trades
data Trade = Trade
  { tradeTimestamp :: !(DateTime) -- ^ /Required/ "timestamp"
  , tradeSymbol :: !(Text) -- ^ /Required/ "symbol"
  , tradeSide :: !(Maybe Text) -- ^ "side"
  , tradeSize :: !(Maybe Double) -- ^ "size"
  , tradePrice :: !(Maybe Double) -- ^ "price"
  , tradeTickDirection :: !(Maybe Text) -- ^ "tickDirection"
  , tradeTrdMatchId :: !(Maybe Text) -- ^ "trdMatchID"
  , tradeGrossValue :: !(Maybe Double) -- ^ "grossValue"
  , tradeHomeNotional :: !(Maybe Double) -- ^ "homeNotional"
  , tradeForeignNotional :: !(Maybe Double) -- ^ "foreignNotional"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON Trade
instance A.FromJSON Trade where
  parseJSON = A.withObject "Trade" $ \o ->
    Trade
      <$> (o .:  "timestamp")
      <*> (o .:  "symbol")
      <*> (o .:? "side")
      <*> (o .:? "size")
      <*> (o .:? "price")
      <*> (o .:? "tickDirection")
      <*> (o .:? "trdMatchID")
      <*> (o .:? "grossValue")
      <*> (o .:? "homeNotional")
      <*> (o .:? "foreignNotional")

-- | ToJSON Trade
instance A.ToJSON Trade where
  toJSON Trade {..} =
   _omitNulls
      [ "timestamp" .= tradeTimestamp
      , "symbol" .= tradeSymbol
      , "side" .= tradeSide
      , "size" .= tradeSize
      , "price" .= tradePrice
      , "tickDirection" .= tradeTickDirection
      , "trdMatchID" .= tradeTrdMatchId
      , "grossValue" .= tradeGrossValue
      , "homeNotional" .= tradeHomeNotional
      , "foreignNotional" .= tradeForeignNotional
      ]


-- | Construct a value of type 'Trade' (by applying it's required fields, if any)
mkTrade
  :: DateTime -- ^ 'tradeTimestamp' 
  -> Text -- ^ 'tradeSymbol' 
  -> Trade
mkTrade tradeTimestamp tradeSymbol =
  Trade
  { tradeTimestamp
  , tradeSymbol
  , tradeSide = Nothing
  , tradeSize = Nothing
  , tradePrice = Nothing
  , tradeTickDirection = Nothing
  , tradeTrdMatchId = Nothing
  , tradeGrossValue = Nothing
  , tradeHomeNotional = Nothing
  , tradeForeignNotional = Nothing
  }

-- ** TradeBin
-- | TradeBin
data TradeBin = TradeBin
  { tradeBinTimestamp :: !(DateTime) -- ^ /Required/ "timestamp"
  , tradeBinSymbol :: !(Text) -- ^ /Required/ "symbol"
  , tradeBinOpen :: !(Maybe Double) -- ^ "open"
  , tradeBinHigh :: !(Maybe Double) -- ^ "high"
  , tradeBinLow :: !(Maybe Double) -- ^ "low"
  , tradeBinClose :: !(Maybe Double) -- ^ "close"
  , tradeBinTrades :: !(Maybe Double) -- ^ "trades"
  , tradeBinVolume :: !(Maybe Double) -- ^ "volume"
  , tradeBinVwap :: !(Maybe Double) -- ^ "vwap"
  , tradeBinLastSize :: !(Maybe Double) -- ^ "lastSize"
  , tradeBinTurnover :: !(Maybe Double) -- ^ "turnover"
  , tradeBinHomeNotional :: !(Maybe Double) -- ^ "homeNotional"
  , tradeBinForeignNotional :: !(Maybe Double) -- ^ "foreignNotional"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON TradeBin
instance A.FromJSON TradeBin where
  parseJSON = A.withObject "TradeBin" $ \o ->
    TradeBin
      <$> (o .:  "timestamp")
      <*> (o .:  "symbol")
      <*> (o .:? "open")
      <*> (o .:? "high")
      <*> (o .:? "low")
      <*> (o .:? "close")
      <*> (o .:? "trades")
      <*> (o .:? "volume")
      <*> (o .:? "vwap")
      <*> (o .:? "lastSize")
      <*> (o .:? "turnover")
      <*> (o .:? "homeNotional")
      <*> (o .:? "foreignNotional")

-- | ToJSON TradeBin
instance A.ToJSON TradeBin where
  toJSON TradeBin {..} =
   _omitNulls
      [ "timestamp" .= tradeBinTimestamp
      , "symbol" .= tradeBinSymbol
      , "open" .= tradeBinOpen
      , "high" .= tradeBinHigh
      , "low" .= tradeBinLow
      , "close" .= tradeBinClose
      , "trades" .= tradeBinTrades
      , "volume" .= tradeBinVolume
      , "vwap" .= tradeBinVwap
      , "lastSize" .= tradeBinLastSize
      , "turnover" .= tradeBinTurnover
      , "homeNotional" .= tradeBinHomeNotional
      , "foreignNotional" .= tradeBinForeignNotional
      ]


-- | Construct a value of type 'TradeBin' (by applying it's required fields, if any)
mkTradeBin
  :: DateTime -- ^ 'tradeBinTimestamp' 
  -> Text -- ^ 'tradeBinSymbol' 
  -> TradeBin
mkTradeBin tradeBinTimestamp tradeBinSymbol =
  TradeBin
  { tradeBinTimestamp
  , tradeBinSymbol
  , tradeBinOpen = Nothing
  , tradeBinHigh = Nothing
  , tradeBinLow = Nothing
  , tradeBinClose = Nothing
  , tradeBinTrades = Nothing
  , tradeBinVolume = Nothing
  , tradeBinVwap = Nothing
  , tradeBinLastSize = Nothing
  , tradeBinTurnover = Nothing
  , tradeBinHomeNotional = Nothing
  , tradeBinForeignNotional = Nothing
  }

-- ** Transaction
-- | Transaction
data Transaction = Transaction
  { transactionTransactId :: !(Text) -- ^ /Required/ "transactID"
  , transactionAccount :: !(Maybe Double) -- ^ "account"
  , transactionCurrency :: !(Maybe Text) -- ^ "currency"
  , transactionTransactType :: !(Maybe Text) -- ^ "transactType"
  , transactionAmount :: !(Maybe Double) -- ^ "amount"
  , transactionFee :: !(Maybe Double) -- ^ "fee"
  , transactionTransactStatus :: !(Maybe Text) -- ^ "transactStatus"
  , transactionAddress :: !(Maybe Text) -- ^ "address"
  , transactionTx :: !(Maybe Text) -- ^ "tx"
  , transactionText :: !(Maybe Text) -- ^ "text"
  , transactionTransactTime :: !(Maybe DateTime) -- ^ "transactTime"
  , transactionTimestamp :: !(Maybe DateTime) -- ^ "timestamp"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON Transaction
instance A.FromJSON Transaction where
  parseJSON = A.withObject "Transaction" $ \o ->
    Transaction
      <$> (o .:  "transactID")
      <*> (o .:? "account")
      <*> (o .:? "currency")
      <*> (o .:? "transactType")
      <*> (o .:? "amount")
      <*> (o .:? "fee")
      <*> (o .:? "transactStatus")
      <*> (o .:? "address")
      <*> (o .:? "tx")
      <*> (o .:? "text")
      <*> (o .:? "transactTime")
      <*> (o .:? "timestamp")

-- | ToJSON Transaction
instance A.ToJSON Transaction where
  toJSON Transaction {..} =
   _omitNulls
      [ "transactID" .= transactionTransactId
      , "account" .= transactionAccount
      , "currency" .= transactionCurrency
      , "transactType" .= transactionTransactType
      , "amount" .= transactionAmount
      , "fee" .= transactionFee
      , "transactStatus" .= transactionTransactStatus
      , "address" .= transactionAddress
      , "tx" .= transactionTx
      , "text" .= transactionText
      , "transactTime" .= transactionTransactTime
      , "timestamp" .= transactionTimestamp
      ]


-- | Construct a value of type 'Transaction' (by applying it's required fields, if any)
mkTransaction
  :: Text -- ^ 'transactionTransactId' 
  -> Transaction
mkTransaction transactionTransactId =
  Transaction
  { transactionTransactId
  , transactionAccount = Nothing
  , transactionCurrency = Nothing
  , transactionTransactType = Nothing
  , transactionAmount = Nothing
  , transactionFee = Nothing
  , transactionTransactStatus = Nothing
  , transactionAddress = Nothing
  , transactionTx = Nothing
  , transactionText = Nothing
  , transactionTransactTime = Nothing
  , transactionTimestamp = Nothing
  }

-- ** User
-- | User
-- Account Operations
data User = User
  { userId :: !(Maybe Double) -- ^ "id"
  , userOwnerId :: !(Maybe Double) -- ^ "ownerId"
  , userFirstname :: !(Maybe Text) -- ^ "firstname"
  , userLastname :: !(Maybe Text) -- ^ "lastname"
  , userUsername :: !(Text) -- ^ /Required/ "username"
  , userEmail :: !(Text) -- ^ /Required/ "email"
  , userPhone :: !(Maybe Text) -- ^ "phone"
  , userCreated :: !(Maybe DateTime) -- ^ "created"
  , userLastUpdated :: !(Maybe DateTime) -- ^ "lastUpdated"
  , userPreferences :: !(Maybe UserPreferences) -- ^ "preferences"
  , userTfaEnabled :: !(Maybe Text) -- ^ "TFAEnabled"
  , userAffiliateId :: !(Maybe Text) -- ^ "affiliateID"
  , userPgpPubKey :: !(Maybe Text) -- ^ "pgpPubKey"
  , userCountry :: !(Maybe Text) -- ^ "country"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON User
instance A.FromJSON User where
  parseJSON = A.withObject "User" $ \o ->
    User
      <$> (o .:? "id")
      <*> (o .:? "ownerId")
      <*> (o .:? "firstname")
      <*> (o .:? "lastname")
      <*> (o .:  "username")
      <*> (o .:  "email")
      <*> (o .:? "phone")
      <*> (o .:? "created")
      <*> (o .:? "lastUpdated")
      <*> (o .:? "preferences")
      <*> (o .:? "TFAEnabled")
      <*> (o .:? "affiliateID")
      <*> (o .:? "pgpPubKey")
      <*> (o .:? "country")

-- | ToJSON User
instance A.ToJSON User where
  toJSON User {..} =
   _omitNulls
      [ "id" .= userId
      , "ownerId" .= userOwnerId
      , "firstname" .= userFirstname
      , "lastname" .= userLastname
      , "username" .= userUsername
      , "email" .= userEmail
      , "phone" .= userPhone
      , "created" .= userCreated
      , "lastUpdated" .= userLastUpdated
      , "preferences" .= userPreferences
      , "TFAEnabled" .= userTfaEnabled
      , "affiliateID" .= userAffiliateId
      , "pgpPubKey" .= userPgpPubKey
      , "country" .= userCountry
      ]


-- | Construct a value of type 'User' (by applying it's required fields, if any)
mkUser
  :: Text -- ^ 'userUsername' 
  -> Text -- ^ 'userEmail' 
  -> User
mkUser userUsername userEmail =
  User
  { userId = Nothing
  , userOwnerId = Nothing
  , userFirstname = Nothing
  , userLastname = Nothing
  , userUsername
  , userEmail
  , userPhone = Nothing
  , userCreated = Nothing
  , userLastUpdated = Nothing
  , userPreferences = Nothing
  , userTfaEnabled = Nothing
  , userAffiliateId = Nothing
  , userPgpPubKey = Nothing
  , userCountry = Nothing
  }

-- ** UserCommission
-- | UserCommission
data UserCommission = UserCommission
  { userCommissionMakerFee :: !(Maybe Double) -- ^ "makerFee"
  , userCommissionTakerFee :: !(Maybe Double) -- ^ "takerFee"
  , userCommissionSettlementFee :: !(Maybe Double) -- ^ "settlementFee"
  , userCommissionMaxFee :: !(Maybe Double) -- ^ "maxFee"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON UserCommission
instance A.FromJSON UserCommission where
  parseJSON = A.withObject "UserCommission" $ \o ->
    UserCommission
      <$> (o .:? "makerFee")
      <*> (o .:? "takerFee")
      <*> (o .:? "settlementFee")
      <*> (o .:? "maxFee")

-- | ToJSON UserCommission
instance A.ToJSON UserCommission where
  toJSON UserCommission {..} =
   _omitNulls
      [ "makerFee" .= userCommissionMakerFee
      , "takerFee" .= userCommissionTakerFee
      , "settlementFee" .= userCommissionSettlementFee
      , "maxFee" .= userCommissionMaxFee
      ]


-- | Construct a value of type 'UserCommission' (by applying it's required fields, if any)
mkUserCommission
  :: UserCommission
mkUserCommission =
  UserCommission
  { userCommissionMakerFee = Nothing
  , userCommissionTakerFee = Nothing
  , userCommissionSettlementFee = Nothing
  , userCommissionMaxFee = Nothing
  }

-- ** UserPreferences
-- | UserPreferences
data UserPreferences = UserPreferences
  { userPreferencesAlertOnLiquidations :: !(Maybe Bool) -- ^ "alertOnLiquidations"
  , userPreferencesAnimationsEnabled :: !(Maybe Bool) -- ^ "animationsEnabled"
  , userPreferencesAnnouncementsLastSeen :: !(Maybe DateTime) -- ^ "announcementsLastSeen"
  , userPreferencesChatChannelId :: !(Maybe Double) -- ^ "chatChannelID"
  , userPreferencesColorTheme :: !(Maybe Text) -- ^ "colorTheme"
  , userPreferencesCurrency :: !(Maybe Text) -- ^ "currency"
  , userPreferencesDebug :: !(Maybe Bool) -- ^ "debug"
  , userPreferencesDisableEmails :: !(Maybe [Text]) -- ^ "disableEmails"
  , userPreferencesHideConfirmDialogs :: !(Maybe [Text]) -- ^ "hideConfirmDialogs"
  , userPreferencesHideConnectionModal :: !(Maybe Bool) -- ^ "hideConnectionModal"
  , userPreferencesHideFromLeaderboard :: !(Maybe Bool) -- ^ "hideFromLeaderboard"
  , userPreferencesHideNameFromLeaderboard :: !(Maybe Bool) -- ^ "hideNameFromLeaderboard"
  , userPreferencesHideNotifications :: !(Maybe [Text]) -- ^ "hideNotifications"
  , userPreferencesLocale :: !(Maybe Text) -- ^ "locale"
  , userPreferencesMsgsSeen :: !(Maybe [Text]) -- ^ "msgsSeen"
  , userPreferencesOrderBookBinning :: !(Maybe A.Value) -- ^ "orderBookBinning"
  , userPreferencesOrderBookType :: !(Maybe Text) -- ^ "orderBookType"
  , userPreferencesOrderClearImmediate :: !(Maybe Bool) -- ^ "orderClearImmediate"
  , userPreferencesOrderControlsPlusMinus :: !(Maybe Bool) -- ^ "orderControlsPlusMinus"
  , userPreferencesSounds :: !(Maybe [Text]) -- ^ "sounds"
  , userPreferencesStrictIpCheck :: !(Maybe Bool) -- ^ "strictIPCheck"
  , userPreferencesStrictTimeout :: !(Maybe Bool) -- ^ "strictTimeout"
  , userPreferencesTickerGroup :: !(Maybe Text) -- ^ "tickerGroup"
  , userPreferencesTickerPinned :: !(Maybe Bool) -- ^ "tickerPinned"
  , userPreferencesTradeLayout :: !(Maybe Text) -- ^ "tradeLayout"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON UserPreferences
instance A.FromJSON UserPreferences where
  parseJSON = A.withObject "UserPreferences" $ \o ->
    UserPreferences
      <$> (o .:? "alertOnLiquidations")
      <*> (o .:? "animationsEnabled")
      <*> (o .:? "announcementsLastSeen")
      <*> (o .:? "chatChannelID")
      <*> (o .:? "colorTheme")
      <*> (o .:? "currency")
      <*> (o .:? "debug")
      <*> (o .:? "disableEmails")
      <*> (o .:? "hideConfirmDialogs")
      <*> (o .:? "hideConnectionModal")
      <*> (o .:? "hideFromLeaderboard")
      <*> (o .:? "hideNameFromLeaderboard")
      <*> (o .:? "hideNotifications")
      <*> (o .:? "locale")
      <*> (o .:? "msgsSeen")
      <*> (o .:? "orderBookBinning")
      <*> (o .:? "orderBookType")
      <*> (o .:? "orderClearImmediate")
      <*> (o .:? "orderControlsPlusMinus")
      <*> (o .:? "sounds")
      <*> (o .:? "strictIPCheck")
      <*> (o .:? "strictTimeout")
      <*> (o .:? "tickerGroup")
      <*> (o .:? "tickerPinned")
      <*> (o .:? "tradeLayout")

-- | ToJSON UserPreferences
instance A.ToJSON UserPreferences where
  toJSON UserPreferences {..} =
   _omitNulls
      [ "alertOnLiquidations" .= userPreferencesAlertOnLiquidations
      , "animationsEnabled" .= userPreferencesAnimationsEnabled
      , "announcementsLastSeen" .= userPreferencesAnnouncementsLastSeen
      , "chatChannelID" .= userPreferencesChatChannelId
      , "colorTheme" .= userPreferencesColorTheme
      , "currency" .= userPreferencesCurrency
      , "debug" .= userPreferencesDebug
      , "disableEmails" .= userPreferencesDisableEmails
      , "hideConfirmDialogs" .= userPreferencesHideConfirmDialogs
      , "hideConnectionModal" .= userPreferencesHideConnectionModal
      , "hideFromLeaderboard" .= userPreferencesHideFromLeaderboard
      , "hideNameFromLeaderboard" .= userPreferencesHideNameFromLeaderboard
      , "hideNotifications" .= userPreferencesHideNotifications
      , "locale" .= userPreferencesLocale
      , "msgsSeen" .= userPreferencesMsgsSeen
      , "orderBookBinning" .= userPreferencesOrderBookBinning
      , "orderBookType" .= userPreferencesOrderBookType
      , "orderClearImmediate" .= userPreferencesOrderClearImmediate
      , "orderControlsPlusMinus" .= userPreferencesOrderControlsPlusMinus
      , "sounds" .= userPreferencesSounds
      , "strictIPCheck" .= userPreferencesStrictIpCheck
      , "strictTimeout" .= userPreferencesStrictTimeout
      , "tickerGroup" .= userPreferencesTickerGroup
      , "tickerPinned" .= userPreferencesTickerPinned
      , "tradeLayout" .= userPreferencesTradeLayout
      ]


-- | Construct a value of type 'UserPreferences' (by applying it's required fields, if any)
mkUserPreferences
  :: UserPreferences
mkUserPreferences =
  UserPreferences
  { userPreferencesAlertOnLiquidations = Nothing
  , userPreferencesAnimationsEnabled = Nothing
  , userPreferencesAnnouncementsLastSeen = Nothing
  , userPreferencesChatChannelId = Nothing
  , userPreferencesColorTheme = Nothing
  , userPreferencesCurrency = Nothing
  , userPreferencesDebug = Nothing
  , userPreferencesDisableEmails = Nothing
  , userPreferencesHideConfirmDialogs = Nothing
  , userPreferencesHideConnectionModal = Nothing
  , userPreferencesHideFromLeaderboard = Nothing
  , userPreferencesHideNameFromLeaderboard = Nothing
  , userPreferencesHideNotifications = Nothing
  , userPreferencesLocale = Nothing
  , userPreferencesMsgsSeen = Nothing
  , userPreferencesOrderBookBinning = Nothing
  , userPreferencesOrderBookType = Nothing
  , userPreferencesOrderClearImmediate = Nothing
  , userPreferencesOrderControlsPlusMinus = Nothing
  , userPreferencesSounds = Nothing
  , userPreferencesStrictIpCheck = Nothing
  , userPreferencesStrictTimeout = Nothing
  , userPreferencesTickerGroup = Nothing
  , userPreferencesTickerPinned = Nothing
  , userPreferencesTradeLayout = Nothing
  }

-- ** Wallet
-- | Wallet
data Wallet = Wallet
  { walletAccount :: !(Double) -- ^ /Required/ "account"
  , walletCurrency :: !(Text) -- ^ /Required/ "currency"
  , walletPrevDeposited :: !(Maybe Double) -- ^ "prevDeposited"
  , walletPrevWithdrawn :: !(Maybe Double) -- ^ "prevWithdrawn"
  , walletPrevTransferIn :: !(Maybe Double) -- ^ "prevTransferIn"
  , walletPrevTransferOut :: !(Maybe Double) -- ^ "prevTransferOut"
  , walletPrevAmount :: !(Maybe Double) -- ^ "prevAmount"
  , walletPrevTimestamp :: !(Maybe DateTime) -- ^ "prevTimestamp"
  , walletDeltaDeposited :: !(Maybe Double) -- ^ "deltaDeposited"
  , walletDeltaWithdrawn :: !(Maybe Double) -- ^ "deltaWithdrawn"
  , walletDeltaTransferIn :: !(Maybe Double) -- ^ "deltaTransferIn"
  , walletDeltaTransferOut :: !(Maybe Double) -- ^ "deltaTransferOut"
  , walletDeltaAmount :: !(Maybe Double) -- ^ "deltaAmount"
  , walletDeposited :: !(Maybe Double) -- ^ "deposited"
  , walletWithdrawn :: !(Maybe Double) -- ^ "withdrawn"
  , walletTransferIn :: !(Maybe Double) -- ^ "transferIn"
  , walletTransferOut :: !(Maybe Double) -- ^ "transferOut"
  , walletAmount :: !(Maybe Double) -- ^ "amount"
  , walletPendingCredit :: !(Maybe Double) -- ^ "pendingCredit"
  , walletPendingDebit :: !(Maybe Double) -- ^ "pendingDebit"
  , walletConfirmedDebit :: !(Maybe Double) -- ^ "confirmedDebit"
  , walletTimestamp :: !(Maybe DateTime) -- ^ "timestamp"
  , walletAddr :: !(Maybe Text) -- ^ "addr"
  , walletScript :: !(Maybe Text) -- ^ "script"
  , walletWithdrawalLock :: !(Maybe [Text]) -- ^ "withdrawalLock"
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON Wallet
instance A.FromJSON Wallet where
  parseJSON = A.withObject "Wallet" $ \o ->
    Wallet
      <$> (o .:  "account")
      <*> (o .:  "currency")
      <*> (o .:? "prevDeposited")
      <*> (o .:? "prevWithdrawn")
      <*> (o .:? "prevTransferIn")
      <*> (o .:? "prevTransferOut")
      <*> (o .:? "prevAmount")
      <*> (o .:? "prevTimestamp")
      <*> (o .:? "deltaDeposited")
      <*> (o .:? "deltaWithdrawn")
      <*> (o .:? "deltaTransferIn")
      <*> (o .:? "deltaTransferOut")
      <*> (o .:? "deltaAmount")
      <*> (o .:? "deposited")
      <*> (o .:? "withdrawn")
      <*> (o .:? "transferIn")
      <*> (o .:? "transferOut")
      <*> (o .:? "amount")
      <*> (o .:? "pendingCredit")
      <*> (o .:? "pendingDebit")
      <*> (o .:? "confirmedDebit")
      <*> (o .:? "timestamp")
      <*> (o .:? "addr")
      <*> (o .:? "script")
      <*> (o .:? "withdrawalLock")

-- | ToJSON Wallet
instance A.ToJSON Wallet where
  toJSON Wallet {..} =
   _omitNulls
      [ "account" .= walletAccount
      , "currency" .= walletCurrency
      , "prevDeposited" .= walletPrevDeposited
      , "prevWithdrawn" .= walletPrevWithdrawn
      , "prevTransferIn" .= walletPrevTransferIn
      , "prevTransferOut" .= walletPrevTransferOut
      , "prevAmount" .= walletPrevAmount
      , "prevTimestamp" .= walletPrevTimestamp
      , "deltaDeposited" .= walletDeltaDeposited
      , "deltaWithdrawn" .= walletDeltaWithdrawn
      , "deltaTransferIn" .= walletDeltaTransferIn
      , "deltaTransferOut" .= walletDeltaTransferOut
      , "deltaAmount" .= walletDeltaAmount
      , "deposited" .= walletDeposited
      , "withdrawn" .= walletWithdrawn
      , "transferIn" .= walletTransferIn
      , "transferOut" .= walletTransferOut
      , "amount" .= walletAmount
      , "pendingCredit" .= walletPendingCredit
      , "pendingDebit" .= walletPendingDebit
      , "confirmedDebit" .= walletConfirmedDebit
      , "timestamp" .= walletTimestamp
      , "addr" .= walletAddr
      , "script" .= walletScript
      , "withdrawalLock" .= walletWithdrawalLock
      ]


-- | Construct a value of type 'Wallet' (by applying it's required fields, if any)
mkWallet
  :: Double -- ^ 'walletAccount' 
  -> Text -- ^ 'walletCurrency' 
  -> Wallet
mkWallet walletAccount walletCurrency =
  Wallet
  { walletAccount
  , walletCurrency
  , walletPrevDeposited = Nothing
  , walletPrevWithdrawn = Nothing
  , walletPrevTransferIn = Nothing
  , walletPrevTransferOut = Nothing
  , walletPrevAmount = Nothing
  , walletPrevTimestamp = Nothing
  , walletDeltaDeposited = Nothing
  , walletDeltaWithdrawn = Nothing
  , walletDeltaTransferIn = Nothing
  , walletDeltaTransferOut = Nothing
  , walletDeltaAmount = Nothing
  , walletDeposited = Nothing
  , walletWithdrawn = Nothing
  , walletTransferIn = Nothing
  , walletTransferOut = Nothing
  , walletAmount = Nothing
  , walletPendingCredit = Nothing
  , walletPendingDebit = Nothing
  , walletConfirmedDebit = Nothing
  , walletTimestamp = Nothing
  , walletAddr = Nothing
  , walletScript = Nothing
  , walletWithdrawalLock = Nothing
  }

-- ** XAny
-- | XAny
data XAny = XAny
  {
  } deriving (P.Show, P.Eq, P.Typeable)

-- | FromJSON XAny
instance A.FromJSON XAny where
  parseJSON = A.withObject "XAny" $ \o ->
    pure XAny


-- | ToJSON XAny
instance A.ToJSON XAny where
  toJSON XAny  =
   _omitNulls
      [
      ]


-- | Construct a value of type 'XAny' (by applying it's required fields, if any)
mkXAny
  :: XAny
mkXAny =
  XAny
  {
  }


-- * Enums


-- ** E'Type

-- | Enum of 'Text'
data E'Type
  = E'Type'Success -- ^ @"success"@
  | E'Type'Error -- ^ @"error"@
  | E'Type'Info -- ^ @"info"@
  deriving (P.Show, P.Eq, P.Typeable, P.Ord, P.Bounded, P.Enum)

instance A.ToJSON E'Type where toJSON = A.toJSON . fromE'Type
instance A.FromJSON E'Type where parseJSON o = P.either P.fail (pure . P.id) . toE'Type =<< A.parseJSON o
instance WH.ToHttpApiData E'Type where toQueryParam = WH.toQueryParam . fromE'Type
instance WH.FromHttpApiData E'Type where parseQueryParam o = WH.parseQueryParam o >>= P.left T.pack . toE'Type
instance MimeRender MimeMultipartFormData E'Type where mimeRender _ = mimeRenderDefaultMultipartFormData

-- | unwrap 'E'Type' enum
fromE'Type :: E'Type -> Text
fromE'Type = \case
  E'Type'Success -> "success"
  E'Type'Error -> "error"
  E'Type'Info -> "info"

-- | parse 'E'Type' enum
toE'Type :: Text -> P.Either String E'Type
toE'Type = \case
  "success" -> P.Right E'Type'Success
  "error" -> P.Right E'Type'Error
  "info" -> P.Right E'Type'Info
  s -> P.Left $ "toE'Type: enum parse failure: " P.++ P.show s