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

module CoinbasePro.Authenticated.Orders
  ( Status (..)
  , Statuses (..)
  , Order (..)
  , STP (..)
  , TimeInForce (..)
  , PlaceOrderBody (..)
  , StopLossSide (..)

  , statuses
  ) where


import           Data.Aeson        (FromJSON, ToJSON, parseJSON, withText)
import           Data.Aeson.Casing (snakeCase)
import           Data.Aeson.TH     (constructorTagModifier, defaultOptions,
                                    deriveJSON, fieldLabelModifier,
                                    omitNothingFields)
import qualified Data.Char         as Char
import           Data.Set          (Set, fromList)
import           Data.Text         (pack, toLower, unpack)
import           Web.HttpApiData   (ToHttpApiData (..))

import           CoinbasePro.Types (ClientOrderId, CreatedAt, Funds, OrderId,
                                    OrderType, Price, ProductId, Side, Size,
                                    filterOrderFieldName)


-- TODO: All is not a status
data Status = Open | Pending | Active | Done | All
    deriving (Status -> Status -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c== :: Status -> Status -> Bool
Eq, Eq Status
Status -> Status -> Bool
Status -> Status -> Ordering
Status -> Status -> Status
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Status -> Status -> Status
$cmin :: Status -> Status -> Status
max :: Status -> Status -> Status
$cmax :: Status -> Status -> Status
>= :: Status -> Status -> Bool
$c>= :: Status -> Status -> Bool
> :: Status -> Status -> Bool
$c> :: Status -> Status -> Bool
<= :: Status -> Status -> Bool
$c<= :: Status -> Status -> Bool
< :: Status -> Status -> Bool
$c< :: Status -> Status -> Bool
compare :: Status -> Status -> Ordering
$ccompare :: Status -> Status -> Ordering
Ord)


instance Show Status where
  show :: Status -> String
show Status
Open    = String
"open"
  show Status
Pending = String
"pending"
  show Status
Active  = String
"active"
  show Status
Done    = String
"done"
  show Status
All     = String
"all"


instance ToHttpApiData Status where
    toUrlPiece :: Status -> Text
toUrlPiece   = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
    toQueryParam :: Status -> Text
toQueryParam = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show


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


statuses :: [Status] -> Statuses
statuses :: [Status] -> Statuses
statuses = Set Status -> Statuses
Statuses forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
fromList


data TimeInForce = GTC | GTT | IOC | FOK
    deriving (TimeInForce -> TimeInForce -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeInForce -> TimeInForce -> Bool
$c/= :: TimeInForce -> TimeInForce -> Bool
== :: TimeInForce -> TimeInForce -> Bool
$c== :: TimeInForce -> TimeInForce -> Bool
Eq, Eq TimeInForce
TimeInForce -> TimeInForce -> Bool
TimeInForce -> TimeInForce -> Ordering
TimeInForce -> TimeInForce -> TimeInForce
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TimeInForce -> TimeInForce -> TimeInForce
$cmin :: TimeInForce -> TimeInForce -> TimeInForce
max :: TimeInForce -> TimeInForce -> TimeInForce
$cmax :: TimeInForce -> TimeInForce -> TimeInForce
>= :: TimeInForce -> TimeInForce -> Bool
$c>= :: TimeInForce -> TimeInForce -> Bool
> :: TimeInForce -> TimeInForce -> Bool
$c> :: TimeInForce -> TimeInForce -> Bool
<= :: TimeInForce -> TimeInForce -> Bool
$c<= :: TimeInForce -> TimeInForce -> Bool
< :: TimeInForce -> TimeInForce -> Bool
$c< :: TimeInForce -> TimeInForce -> Bool
compare :: TimeInForce -> TimeInForce -> Ordering
$ccompare :: TimeInForce -> TimeInForce -> Ordering
Ord, Int -> TimeInForce -> ShowS
[TimeInForce] -> ShowS
TimeInForce -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeInForce] -> ShowS
$cshowList :: [TimeInForce] -> ShowS
show :: TimeInForce -> String
$cshow :: TimeInForce -> String
showsPrec :: Int -> TimeInForce -> ShowS
$cshowsPrec :: Int -> TimeInForce -> ShowS
Show)


instance ToHttpApiData TimeInForce where
    toUrlPiece :: TimeInForce -> Text
toUrlPiece   = Text -> Text
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
    toQueryParam :: TimeInForce -> Text
toQueryParam = Text -> Text
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show


data STP = DC | CO | CN | CB
    deriving (STP -> STP -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: STP -> STP -> Bool
$c/= :: STP -> STP -> Bool
== :: STP -> STP -> Bool
$c== :: STP -> STP -> Bool
Eq, Eq STP
STP -> STP -> Bool
STP -> STP -> Ordering
STP -> STP -> STP
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: STP -> STP -> STP
$cmin :: STP -> STP -> STP
max :: STP -> STP -> STP
$cmax :: STP -> STP -> STP
>= :: STP -> STP -> Bool
$c>= :: STP -> STP -> Bool
> :: STP -> STP -> Bool
$c> :: STP -> STP -> Bool
<= :: STP -> STP -> Bool
$c<= :: STP -> STP -> Bool
< :: STP -> STP -> Bool
$c< :: STP -> STP -> Bool
compare :: STP -> STP -> Ordering
$ccompare :: STP -> STP -> Ordering
Ord, Int -> STP -> ShowS
[STP] -> ShowS
STP -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [STP] -> ShowS
$cshowList :: [STP] -> ShowS
show :: STP -> String
$cshow :: STP -> String
showsPrec :: Int -> STP -> ShowS
$cshowsPrec :: Int -> STP -> ShowS
Show)


instance ToHttpApiData STP where
    toUrlPiece :: STP -> Text
toUrlPiece   = Text -> Text
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
    toQueryParam :: STP -> Text
toQueryParam = Text -> Text
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show


deriveJSON defaultOptions {constructorTagModifier = fmap Char.toLower} ''Status
deriveJSON defaultOptions ''TimeInForce
deriveJSON defaultOptions {constructorTagModifier = fmap Char.toLower} ''STP


newtype FillFees = FillFees { FillFees -> Double
unFillFees :: Double }
    deriving (FillFees -> FillFees -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FillFees -> FillFees -> Bool
$c/= :: FillFees -> FillFees -> Bool
== :: FillFees -> FillFees -> Bool
$c== :: FillFees -> FillFees -> Bool
Eq, Eq FillFees
FillFees -> FillFees -> Bool
FillFees -> FillFees -> Ordering
FillFees -> FillFees -> FillFees
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FillFees -> FillFees -> FillFees
$cmin :: FillFees -> FillFees -> FillFees
max :: FillFees -> FillFees -> FillFees
$cmax :: FillFees -> FillFees -> FillFees
>= :: FillFees -> FillFees -> Bool
$c>= :: FillFees -> FillFees -> Bool
> :: FillFees -> FillFees -> Bool
$c> :: FillFees -> FillFees -> Bool
<= :: FillFees -> FillFees -> Bool
$c<= :: FillFees -> FillFees -> Bool
< :: FillFees -> FillFees -> Bool
$c< :: FillFees -> FillFees -> Bool
compare :: FillFees -> FillFees -> Ordering
$ccompare :: FillFees -> FillFees -> Ordering
Ord, Int -> FillFees -> ShowS
[FillFees] -> ShowS
FillFees -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FillFees] -> ShowS
$cshowList :: [FillFees] -> ShowS
show :: FillFees -> String
$cshow :: FillFees -> String
showsPrec :: Int -> FillFees -> ShowS
$cshowsPrec :: Int -> FillFees -> ShowS
Show, [FillFees] -> Encoding
[FillFees] -> Value
FillFees -> Encoding
FillFees -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FillFees] -> Encoding
$ctoEncodingList :: [FillFees] -> Encoding
toJSONList :: [FillFees] -> Value
$ctoJSONList :: [FillFees] -> Value
toEncoding :: FillFees -> Encoding
$ctoEncoding :: FillFees -> Encoding
toJSON :: FillFees -> Value
$ctoJSON :: FillFees -> Value
ToJSON)


instance FromJSON FillFees where
    parseJSON :: Value -> Parser FillFees
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"fill_fees" forall a b. (a -> b) -> a -> b
$ \Text
t ->
      forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> FillFees
FillFees forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
t


newtype ExecutedValue = ExecutedValue { ExecutedValue -> Double
unExecutedValue :: Double }
    deriving (ExecutedValue -> ExecutedValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExecutedValue -> ExecutedValue -> Bool
$c/= :: ExecutedValue -> ExecutedValue -> Bool
== :: ExecutedValue -> ExecutedValue -> Bool
$c== :: ExecutedValue -> ExecutedValue -> Bool
Eq, Eq ExecutedValue
ExecutedValue -> ExecutedValue -> Bool
ExecutedValue -> ExecutedValue -> Ordering
ExecutedValue -> ExecutedValue -> ExecutedValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ExecutedValue -> ExecutedValue -> ExecutedValue
$cmin :: ExecutedValue -> ExecutedValue -> ExecutedValue
max :: ExecutedValue -> ExecutedValue -> ExecutedValue
$cmax :: ExecutedValue -> ExecutedValue -> ExecutedValue
>= :: ExecutedValue -> ExecutedValue -> Bool
$c>= :: ExecutedValue -> ExecutedValue -> Bool
> :: ExecutedValue -> ExecutedValue -> Bool
$c> :: ExecutedValue -> ExecutedValue -> Bool
<= :: ExecutedValue -> ExecutedValue -> Bool
$c<= :: ExecutedValue -> ExecutedValue -> Bool
< :: ExecutedValue -> ExecutedValue -> Bool
$c< :: ExecutedValue -> ExecutedValue -> Bool
compare :: ExecutedValue -> ExecutedValue -> Ordering
$ccompare :: ExecutedValue -> ExecutedValue -> Ordering
Ord, Int -> ExecutedValue -> ShowS
[ExecutedValue] -> ShowS
ExecutedValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecutedValue] -> ShowS
$cshowList :: [ExecutedValue] -> ShowS
show :: ExecutedValue -> String
$cshow :: ExecutedValue -> String
showsPrec :: Int -> ExecutedValue -> ShowS
$cshowsPrec :: Int -> ExecutedValue -> ShowS
Show, [ExecutedValue] -> Encoding
[ExecutedValue] -> Value
ExecutedValue -> Encoding
ExecutedValue -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ExecutedValue] -> Encoding
$ctoEncodingList :: [ExecutedValue] -> Encoding
toJSONList :: [ExecutedValue] -> Value
$ctoJSONList :: [ExecutedValue] -> Value
toEncoding :: ExecutedValue -> Encoding
$ctoEncoding :: ExecutedValue -> Encoding
toJSON :: ExecutedValue -> Value
$ctoJSON :: ExecutedValue -> Value
ToJSON)


instance FromJSON ExecutedValue where
    parseJSON :: Value -> Parser ExecutedValue
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"executed_value" forall a b. (a -> b) -> a -> b
$ \Text
t ->
      forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ExecutedValue
ExecutedValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
t

data StopLossSide = Loss | Entry
    deriving (StopLossSide -> StopLossSide -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopLossSide -> StopLossSide -> Bool
$c/= :: StopLossSide -> StopLossSide -> Bool
== :: StopLossSide -> StopLossSide -> Bool
$c== :: StopLossSide -> StopLossSide -> Bool
Eq, Eq StopLossSide
StopLossSide -> StopLossSide -> Bool
StopLossSide -> StopLossSide -> Ordering
StopLossSide -> StopLossSide -> StopLossSide
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StopLossSide -> StopLossSide -> StopLossSide
$cmin :: StopLossSide -> StopLossSide -> StopLossSide
max :: StopLossSide -> StopLossSide -> StopLossSide
$cmax :: StopLossSide -> StopLossSide -> StopLossSide
>= :: StopLossSide -> StopLossSide -> Bool
$c>= :: StopLossSide -> StopLossSide -> Bool
> :: StopLossSide -> StopLossSide -> Bool
$c> :: StopLossSide -> StopLossSide -> Bool
<= :: StopLossSide -> StopLossSide -> Bool
$c<= :: StopLossSide -> StopLossSide -> Bool
< :: StopLossSide -> StopLossSide -> Bool
$c< :: StopLossSide -> StopLossSide -> Bool
compare :: StopLossSide -> StopLossSide -> Ordering
$ccompare :: StopLossSide -> StopLossSide -> Ordering
Ord, Int -> StopLossSide -> ShowS
[StopLossSide] -> ShowS
StopLossSide -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopLossSide] -> ShowS
$cshowList :: [StopLossSide] -> ShowS
show :: StopLossSide -> String
$cshow :: StopLossSide -> String
showsPrec :: Int -> StopLossSide -> ShowS
$cshowsPrec :: Int -> StopLossSide -> ShowS
Show)


instance ToHttpApiData StopLossSide where
    toUrlPiece :: StopLossSide -> Text
toUrlPiece   = Text -> Text
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
    toQueryParam :: StopLossSide -> Text
toQueryParam = Text -> Text
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show


deriveJSON defaultOptions {constructorTagModifier = fmap Char.toLower} ''StopLossSide


-- TODO: This might need to be split up into different order types.
data Order = Order
    { Order -> OrderId
id            :: OrderId
    , Order -> Maybe Price
price         :: Maybe Price
    , Order -> Maybe Size
size          :: Maybe Size
    , Order -> ProductId
productId     :: ProductId
    , Order -> Side
side          :: Side
    , Order -> Maybe STP
stp           :: Maybe STP
    , Order -> OrderType
orderType     :: OrderType
    , Order -> Maybe TimeInForce
timeInForce   :: Maybe TimeInForce
    , Order -> Maybe Bool
postOnly      :: Maybe Bool
    , Order -> CreatedAt
createdAt     :: CreatedAt
    , Order -> FillFees
fillFees      :: FillFees
    , Order -> Size
filledSize    :: Size
    , Order -> Maybe ExecutedValue
executedValue :: Maybe ExecutedValue
    , Order -> Status
status        :: Status
    , Order -> Bool
settled       :: Bool
    , Order -> Maybe StopLossSide
stop          :: Maybe StopLossSide
    , Order -> Maybe Price
stopPrice     :: Maybe Price
    } deriving (Order -> Order -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Order -> Order -> Bool
$c/= :: Order -> Order -> Bool
== :: Order -> Order -> Bool
$c== :: Order -> Order -> Bool
Eq, Int -> Order -> ShowS
[Order] -> ShowS
Order -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Order] -> ShowS
$cshowList :: [Order] -> ShowS
show :: Order -> String
$cshow :: Order -> String
showsPrec :: Int -> Order -> ShowS
$cshowsPrec :: Int -> Order -> ShowS
Show)


deriveJSON defaultOptions {fieldLabelModifier = filterOrderFieldName . snakeCase} ''Order




data PlaceOrderBody = PlaceOrderBody
    { PlaceOrderBody -> Maybe ClientOrderId
bClientOid   :: Maybe ClientOrderId
    , PlaceOrderBody -> ProductId
bProductId   :: ProductId
    , PlaceOrderBody -> Side
bSide        :: Side
    , PlaceOrderBody -> Maybe Size
bSize        :: Maybe Size
    , PlaceOrderBody -> Maybe Funds
bFunds       :: Maybe Funds
    , PlaceOrderBody -> Maybe Price
bPrice       :: Maybe Price
    , PlaceOrderBody -> Maybe Bool
bPostOnly    :: Maybe Bool
    , PlaceOrderBody -> Maybe OrderType
bOrderType   :: Maybe OrderType
    , PlaceOrderBody -> Maybe STP
bStp         :: Maybe STP
    , PlaceOrderBody -> Maybe TimeInForce
bTimeInForce :: Maybe TimeInForce
    , PlaceOrderBody -> Maybe StopLossSide
bStop        :: Maybe StopLossSide
    , PlaceOrderBody -> Maybe Price
bStopPrice   :: Maybe Price
    } deriving (PlaceOrderBody -> PlaceOrderBody -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlaceOrderBody -> PlaceOrderBody -> Bool
$c/= :: PlaceOrderBody -> PlaceOrderBody -> Bool
== :: PlaceOrderBody -> PlaceOrderBody -> Bool
$c== :: PlaceOrderBody -> PlaceOrderBody -> Bool
Eq, Int -> PlaceOrderBody -> ShowS
[PlaceOrderBody] -> ShowS
PlaceOrderBody -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlaceOrderBody] -> ShowS
$cshowList :: [PlaceOrderBody] -> ShowS
show :: PlaceOrderBody -> String
$cshow :: PlaceOrderBody -> String
showsPrec :: Int -> PlaceOrderBody -> ShowS
$cshowsPrec :: Int -> PlaceOrderBody -> ShowS
Show)

deriveJSON defaultOptions {fieldLabelModifier = snakeCase . drop 1, omitNothingFields = True} ''PlaceOrderBody