{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
# LANGUAGE GeneralizedNewtypeDeriving #
{-# LANGUAGE OverloadedStrings          #-}
# LANGUAGE RecordWildCards             #


module Coinbase.Exchange.Types.Socket where

-------------------------------------------------------------------------------
import           Control.Applicative
import           Control.DeepSeq
import           Control.Monad
import           Data.Aeson.Types             hiding (Error)
import           Data.Data
import           Data.Hashable
import qualified Data.HashMap.Strict          as H
import           Data.Text                    (Text)
import           Data.Time
import           Data.Word
import           GHC.Generics
-------------------------------------------------------------------------------
import           Coinbase.Exchange.Types.Core hiding (OrderStatus (..))
-------------------------------------------------------------------------------



-------------------------------------------------------------------------------
-- | Messages we can send to the exchange
data SendExchangeMessage
    = Subscribe [ProductId]
    | SetHeartbeat Bool
    deriving (Eq, Show, Read, Data, Typeable, Generic)

instance NFData SendExchangeMessage



-------------------------------------------------------------------------------
-- | Messages they send back to us
data ExchangeMessage
    = Heartbeat
        { msgTime        :: UTCTime
        , msgProductId   :: ProductId
        , msgSequence    :: Sequence
        , msgLastTradeId :: TradeId
        }
    | ReceivedLimit
        { msgTime      :: UTCTime
        , msgProductId :: ProductId
        , msgSequence  :: Sequence
        , msgOrderId   :: OrderId
        , msgSide      :: Side
        , msgClientOid :: Maybe ClientOrderId
        --
        , msgPrice     :: Price
        , msgSize      :: Size
        }
    | ReceivedMarket
        { msgTime         :: UTCTime
        , msgProductId    :: ProductId
        , msgSequence     :: Sequence
        , msgOrderId      :: OrderId
        , msgSide         :: Side
        , msgClientOid    :: Maybe ClientOrderId
        -- market orders have no price and are bounded by either size, funds or both
        , msgMarketBounds :: (Either Size (Maybe Size, Cost))
        }
    | Open
        { msgTime          :: UTCTime
        , msgProductId     :: ProductId
        , msgSequence      :: Sequence
        , msgOrderId       :: OrderId
        , msgSide          :: Side
        , msgRemainingSize :: Size
        , msgPrice         :: Price
        }
    | Match
        { msgTime         :: UTCTime
        , msgProductId    :: ProductId
        , msgSequence     :: Sequence
        , msgSide         :: Side
        , msgTradeId      :: TradeId
        , msgMakerOrderId :: OrderId
        , msgTakerOrderId :: OrderId
        , msgSize         :: Size
        , msgPrice        :: Price
        }
    | Done
        { msgTime         :: UTCTime
        , msgProductId    :: ProductId
        , msgSequence     :: Sequence
        , msgOrderId      :: OrderId
        , msgSide         :: Side
        , msgReason       :: Reason
  It is possible for these next two fields to be Nothing separately
        -- Filled market orders limited by funds will not have a price but may have remaining_size
  Filled limit orders may have a price but not a remaining_size ( assumed zero )
        -- CURRENTLY ** `remaining_size` reported in Done messages is sometimes incorrect **
        -- This appears to be bug at GDAX. I've told them about it.
        , msgMaybePrice   :: Maybe Price
        , msgMaybeRemSize :: Maybe Size
        }
    | ChangeLimit
        { msgTime       :: UTCTime
        , msgProductId  :: ProductId
        , msgSequence   :: Sequence
        , msgOrderId    :: OrderId
        , msgSide       :: Side
  Observation has revealed Price is not always present in
        -- change messages with old_size and new_size. This may be
        -- self trade prevention or something of the sort.
        , msgMaybePrice :: Maybe Price
        , msgNewSize    :: Size
        , msgOldSize    :: Size
        }
    | ChangeMarket
        { msgTime      :: UTCTime
        , msgProductId :: ProductId
        , msgSequence  :: Sequence
        , msgOrderId   :: OrderId
        , msgSide      :: Side
        , msgNewFunds  :: Cost
        , msgOldFunds  :: Cost
        }
    | Error
        { msgMessage :: Text
        }
    deriving (Eq, Show, Read, Data, Typeable, Generic)

instance NFData ExchangeMessage

-----------------------------
instance FromJSON ExchangeMessage where
    parseJSON (Object m) = do
        msgtype <- m .: "type"
        -- TO DO: `HeartbeatReq` and `Subscribe` message types are missing as those are
        -- never received by the client.
        case (msgtype :: String) of
            "hearbeat"-> Heartbeat
                <$> m .: "time"
                <*> m .: "product_id"
                <*> m .: "sequence"
                <*> m .: "last_trade_id"
            "open" -> Open
                <$> m .: "time"
                <*> m .: "product_id"
                <*> m .: "sequence"
                <*> m .: "order_id"
                <*> m .: "side"
                <*> m .: "remaining_size"
                <*> m .: "price"
            "done" -> Done
                <$> m .: "time"
                <*> m .: "product_id"
                <*> m .: "sequence"
                <*> m .: "order_id"
                <*> m .: "side"
                <*> m .: "reason"
                <*> m .:? "price"
                <*> m .:? "remaining_size"
            "match" -> Match
                <$> m .: "time"
                <*> m .: "product_id"
                <*> m .: "sequence"
                <*> m .: "side"
                <*> m .: "trade_id"
                <*> m .: "maker_order_id"
                <*> m .: "taker_order_id"
                <*> m .: "size"
                <*> m .: "price"
            "change" -> do
                ms <- m .:? "price"
                let market = ChangeMarket
                                <$> m .: "time"
                                <*> m .: "product_id"
                                <*> m .: "sequence"
                                <*> m .: "order_id"
                                <*> m .: "side"
                                <*> m .: "new_funds"
                                <*> m .: "old_funds"
                    limit = ChangeLimit
                                <$> m .: "time"
                                <*> m .: "product_id"
                                <*> m .: "sequence"
                                <*> m .: "order_id"
                                <*> m .: "side"
                                <*> m .: "price"
                                <*> m .: "new_size"
                                <*> m .: "old_size"
                case (ms :: Maybe Price) of
                    Nothing -> market <|> limit
                    Just _ -> limit <|> market
            "received" -> do
                typ  <- m .:  "order_type"
                mcid <- m .:? "client_oid"
                case typ of
                    Limit -> ReceivedLimit
                                <$> m .: "time"
                                <*> m .: "product_id"
                                <*> m .: "sequence"
                                <*> m .: "order_id"
                                <*> m .: "side"
                                <*> pure (mcid :: Maybe ClientOrderId)
                                <*> m .: "price"
                                <*> m .: "size"
                    Market -> ReceivedMarket
                                <$> m .: "time"
                                <*> m .: "product_id"
                                <*> m .: "sequence"
                                <*> m .: "order_id"
                                <*> m .: "side"
                                <*> pure mcid
                                <*> (do
  I ca n't try to parse " size " or " funds " with ( . : ? ) here , their type is CoinScientific
  but the fields may be " size":null and that will fail the ( m . : ? " size " ) parser .
                                        ms <- m .:?? "size"
                                        mf <- m .:?? "funds"
                                        case (ms,mf) of
                                            (Nothing, Nothing) -> mzero
                                            (Just s , Nothing) -> return $ Left  s
                                            (Nothing, Just f ) -> return $ Right (Nothing, f)
                                            (Just s , Just f ) -> return $ Right (Just s , f)
                                            )
            "error" -> error (show m)

    parseJSON _ = mzero

---------------------------
  This is based on the code for  's ( . : ? ) operator . Except , we 're more
-- lax than (.:?) and also return 'Nothing' when the field is (JSON) null.
(.:??) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)
obj .:?? key = case H.lookup key obj of
               Nothing -> pure Nothing
               Just v  -> if v == Null
                   then pure Nothing
                   else obj .:? key


-------------------------------------------------------------------------------
instance ToJSON SendExchangeMessage where
    toJSON (Subscribe pids) = object
        [ "type"       .= ("subscribe" :: Text)
        , "product_ids" .= pids
        ]
    toJSON (SetHeartbeat b) = object
        [ "type"       .= ("heartbeat" :: Text)
        , "on"         .= b]


-------------------------------------------------------------------------------
-- | Convenience/storage instance; never sent to exchange
instance ToJSON ExchangeMessage where
    toJSON Open{..} = object
        [ "type"       .= ("open" :: Text)
        , "time"       .= msgTime
        , "product_id" .= msgProductId
        , "sequence"   .= msgSequence
        , "order_id"   .= msgOrderId
        , "side"       .= msgSide
        , "remaining_size" .= msgRemainingSize
        , "price"      .= msgPrice
        ]
    toJSON Done{..} = object
        ([ "type"      .= ("done" :: Text)
        , "time"       .= msgTime
        , "product_id" .= msgProductId
        , "sequence"   .= msgSequence
        , "order_id"   .= msgOrderId
        , "side"       .= msgSide
        , "reason"     .= msgReason
        ]
        ++ case msgMaybePrice of
                Nothing -> []
                Just  p -> ["price" .= p]
        ++ case msgMaybeRemSize of
                Nothing -> []
                Just  s -> ["remaining_size" .= s]
        )
    toJSON Match{..} = object
        [ "type"       .= ("match" :: Text)
        , "time"       .= msgTime
        , "product_id" .= msgProductId
        , "sequence"   .= msgSequence
        , "side"       .= msgSide
        , "trade_id"   .= msgTradeId
        , "maker_order_id" .= msgMakerOrderId
        , "taker_order_id" .= msgTakerOrderId
        , "size"       .= msgSize
        , "price"      .= msgPrice
        ]
    toJSON Error{..} = object
        [ "type" .= ("error" :: Text)
        , "message" .= msgMessage
        ]
    toJSON ChangeLimit{..} = object $
        [ "type"       .= ("change" :: Text)
        , "time"       .= msgTime
        , "product_id" .= msgProductId
        , "sequence"   .= msgSequence
        , "order_id"   .= msgOrderId
        , "side"       .= msgSide
        , "new_size"   .= msgNewSize
        , "old_size"   .= msgOldSize
        ] ++ maybe [] (return . ("price" .= )) msgMaybePrice
    toJSON ChangeMarket{..} = object
        [ "type"       .= ("change" :: Text)
        , "time"       .= msgTime
        , "product_id" .= msgProductId
        , "sequence"   .= msgSequence
        , "order_id"   .= msgOrderId
        , "side"       .= msgSide
        , "new_funds"  .= msgNewFunds
        , "old_funds"  .= msgOldFunds
        ]

    toJSON ReceivedLimit{..} = object (
        [ "type"       .= ("received" :: Text)
        , "time"       .= msgTime
        , "product_id" .= msgProductId
        , "sequence"   .= msgSequence
        , "order_id"   .= msgOrderId
        , "side"       .= msgSide
        , "size"       .= msgSize
        , "price"      .= msgPrice
        , "order_type" .= Limit
        ] ++ clientID)
            where
                clientID = case msgClientOid of
                    Nothing -> []
                    Just ci -> ["client_oid" .= msgClientOid ]

    toJSON ReceivedMarket{..} = object (
        ["type"       .= ("received" :: Text)
        , "time"       .= msgTime
        , "product_id" .= msgProductId
        , "sequence"   .= msgSequence
        , "order_id"   .= msgOrderId
        , "side"       .= msgSide
        , "order_type" .= Market
        ] ++ clientID ++ size ++ funds)
            where
                clientID = case msgClientOid of
                    Nothing -> []
                    Just ci -> ["client_oid" .= msgClientOid ]
                (size,funds) = case msgMarketBounds of
                    Left  s -> (["size" .= s],[])
                    Right (ms,f) -> case ms of
                                Nothing -> ( []            , ["funds" .= f] )
                                Just s' -> ( ["size" .= s'], ["funds" .= f] )

# LANGUAGE DeriveDataTypeable         #
# LANGUAGE DeriveGeneric              #
# LANGUAGE OverloadedStrings          #
-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
 | Messages we can send to the exchange
-----------------------------------------------------------------------------
 | Messages they send back to us

 market orders have no price and are bounded by either size, funds or both
 Filled market orders limited by funds will not have a price but may have remaining_size
 CURRENTLY ** `remaining_size` reported in Done messages is sometimes incorrect **
 This appears to be bug at GDAX. I've told them about it.
 change messages with old_size and new_size. This may be
 self trade prevention or something of the sort.
---------------------------
 TO DO: `HeartbeatReq` and `Subscribe` message types are missing as those are
 never received by the client.
-------------------------
 lax than (.:?) and also return 'Nothing' when the field is (JSON) null.
-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
 | Convenience/storage instance; never sent to exchange
# LANGUAGE GeneralizedNewtypeDeriving #
# LANGUAGE RecordWildCards             #


module Coinbase.Exchange.Types.Socket where

import           Control.Applicative
import           Control.DeepSeq
import           Control.Monad
import           Data.Aeson.Types             hiding (Error)
import           Data.Data
import           Data.Hashable
import qualified Data.HashMap.Strict          as H
import           Data.Text                    (Text)
import           Data.Time
import           Data.Word
import           GHC.Generics
import           Coinbase.Exchange.Types.Core hiding (OrderStatus (..))



data SendExchangeMessage
    = Subscribe [ProductId]
    | SetHeartbeat Bool
    deriving (Eq, Show, Read, Data, Typeable, Generic)

instance NFData SendExchangeMessage



data ExchangeMessage
    = Heartbeat
        { msgTime        :: UTCTime
        , msgProductId   :: ProductId
        , msgSequence    :: Sequence
        , msgLastTradeId :: TradeId
        }
    | ReceivedLimit
        { msgTime      :: UTCTime
        , msgProductId :: ProductId
        , msgSequence  :: Sequence
        , msgOrderId   :: OrderId
        , msgSide      :: Side
        , msgClientOid :: Maybe ClientOrderId
        , msgPrice     :: Price
        , msgSize      :: Size
        }
    | ReceivedMarket
        { msgTime         :: UTCTime
        , msgProductId    :: ProductId
        , msgSequence     :: Sequence
        , msgOrderId      :: OrderId
        , msgSide         :: Side
        , msgClientOid    :: Maybe ClientOrderId
        , msgMarketBounds :: (Either Size (Maybe Size, Cost))
        }
    | Open
        { msgTime          :: UTCTime
        , msgProductId     :: ProductId
        , msgSequence      :: Sequence
        , msgOrderId       :: OrderId
        , msgSide          :: Side
        , msgRemainingSize :: Size
        , msgPrice         :: Price
        }
    | Match
        { msgTime         :: UTCTime
        , msgProductId    :: ProductId
        , msgSequence     :: Sequence
        , msgSide         :: Side
        , msgTradeId      :: TradeId
        , msgMakerOrderId :: OrderId
        , msgTakerOrderId :: OrderId
        , msgSize         :: Size
        , msgPrice        :: Price
        }
    | Done
        { msgTime         :: UTCTime
        , msgProductId    :: ProductId
        , msgSequence     :: Sequence
        , msgOrderId      :: OrderId
        , msgSide         :: Side
        , msgReason       :: Reason
  It is possible for these next two fields to be Nothing separately
  Filled limit orders may have a price but not a remaining_size ( assumed zero )
        , msgMaybePrice   :: Maybe Price
        , msgMaybeRemSize :: Maybe Size
        }
    | ChangeLimit
        { msgTime       :: UTCTime
        , msgProductId  :: ProductId
        , msgSequence   :: Sequence
        , msgOrderId    :: OrderId
        , msgSide       :: Side
  Observation has revealed Price is not always present in
        , msgMaybePrice :: Maybe Price
        , msgNewSize    :: Size
        , msgOldSize    :: Size
        }
    | ChangeMarket
        { msgTime      :: UTCTime
        , msgProductId :: ProductId
        , msgSequence  :: Sequence
        , msgOrderId   :: OrderId
        , msgSide      :: Side
        , msgNewFunds  :: Cost
        , msgOldFunds  :: Cost
        }
    | Error
        { msgMessage :: Text
        }
    deriving (Eq, Show, Read, Data, Typeable, Generic)

instance NFData ExchangeMessage

instance FromJSON ExchangeMessage where
    parseJSON (Object m) = do
        msgtype <- m .: "type"
        case (msgtype :: String) of
            "hearbeat"-> Heartbeat
                <$> m .: "time"
                <*> m .: "product_id"
                <*> m .: "sequence"
                <*> m .: "last_trade_id"
            "open" -> Open
                <$> m .: "time"
                <*> m .: "product_id"
                <*> m .: "sequence"
                <*> m .: "order_id"
                <*> m .: "side"
                <*> m .: "remaining_size"
                <*> m .: "price"
            "done" -> Done
                <$> m .: "time"
                <*> m .: "product_id"
                <*> m .: "sequence"
                <*> m .: "order_id"
                <*> m .: "side"
                <*> m .: "reason"
                <*> m .:? "price"
                <*> m .:? "remaining_size"
            "match" -> Match
                <$> m .: "time"
                <*> m .: "product_id"
                <*> m .: "sequence"
                <*> m .: "side"
                <*> m .: "trade_id"
                <*> m .: "maker_order_id"
                <*> m .: "taker_order_id"
                <*> m .: "size"
                <*> m .: "price"
            "change" -> do
                ms <- m .:? "price"
                let market = ChangeMarket
                                <$> m .: "time"
                                <*> m .: "product_id"
                                <*> m .: "sequence"
                                <*> m .: "order_id"
                                <*> m .: "side"
                                <*> m .: "new_funds"
                                <*> m .: "old_funds"
                    limit = ChangeLimit
                                <$> m .: "time"
                                <*> m .: "product_id"
                                <*> m .: "sequence"
                                <*> m .: "order_id"
                                <*> m .: "side"
                                <*> m .: "price"
                                <*> m .: "new_size"
                                <*> m .: "old_size"
                case (ms :: Maybe Price) of
                    Nothing -> market <|> limit
                    Just _ -> limit <|> market
            "received" -> do
                typ  <- m .:  "order_type"
                mcid <- m .:? "client_oid"
                case typ of
                    Limit -> ReceivedLimit
                                <$> m .: "time"
                                <*> m .: "product_id"
                                <*> m .: "sequence"
                                <*> m .: "order_id"
                                <*> m .: "side"
                                <*> pure (mcid :: Maybe ClientOrderId)
                                <*> m .: "price"
                                <*> m .: "size"
                    Market -> ReceivedMarket
                                <$> m .: "time"
                                <*> m .: "product_id"
                                <*> m .: "sequence"
                                <*> m .: "order_id"
                                <*> m .: "side"
                                <*> pure mcid
                                <*> (do
  I ca n't try to parse " size " or " funds " with ( . : ? ) here , their type is CoinScientific
  but the fields may be " size":null and that will fail the ( m . : ? " size " ) parser .
                                        ms <- m .:?? "size"
                                        mf <- m .:?? "funds"
                                        case (ms,mf) of
                                            (Nothing, Nothing) -> mzero
                                            (Just s , Nothing) -> return $ Left  s
                                            (Nothing, Just f ) -> return $ Right (Nothing, f)
                                            (Just s , Just f ) -> return $ Right (Just s , f)
                                            )
            "error" -> error (show m)

    parseJSON _ = mzero

  This is based on the code for  's ( . : ? ) operator . Except , we 're more
(.:??) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)
obj .:?? key = case H.lookup key obj of
               Nothing -> pure Nothing
               Just v  -> if v == Null
                   then pure Nothing
                   else obj .:? key


instance ToJSON SendExchangeMessage where
    toJSON (Subscribe pids) = object
        [ "type"       .= ("subscribe" :: Text)
        , "product_ids" .= pids
        ]
    toJSON (SetHeartbeat b) = object
        [ "type"       .= ("heartbeat" :: Text)
        , "on"         .= b]


instance ToJSON ExchangeMessage where
    toJSON Open{..} = object
        [ "type"       .= ("open" :: Text)
        , "time"       .= msgTime
        , "product_id" .= msgProductId
        , "sequence"   .= msgSequence
        , "order_id"   .= msgOrderId
        , "side"       .= msgSide
        , "remaining_size" .= msgRemainingSize
        , "price"      .= msgPrice
        ]
    toJSON Done{..} = object
        ([ "type"      .= ("done" :: Text)
        , "time"       .= msgTime
        , "product_id" .= msgProductId
        , "sequence"   .= msgSequence
        , "order_id"   .= msgOrderId
        , "side"       .= msgSide
        , "reason"     .= msgReason
        ]
        ++ case msgMaybePrice of
                Nothing -> []
                Just  p -> ["price" .= p]
        ++ case msgMaybeRemSize of
                Nothing -> []
                Just  s -> ["remaining_size" .= s]
        )
    toJSON Match{..} = object
        [ "type"       .= ("match" :: Text)
        , "time"       .= msgTime
        , "product_id" .= msgProductId
        , "sequence"   .= msgSequence
        , "side"       .= msgSide
        , "trade_id"   .= msgTradeId
        , "maker_order_id" .= msgMakerOrderId
        , "taker_order_id" .= msgTakerOrderId
        , "size"       .= msgSize
        , "price"      .= msgPrice
        ]
    toJSON Error{..} = object
        [ "type" .= ("error" :: Text)
        , "message" .= msgMessage
        ]
    toJSON ChangeLimit{..} = object $
        [ "type"       .= ("change" :: Text)
        , "time"       .= msgTime
        , "product_id" .= msgProductId
        , "sequence"   .= msgSequence
        , "order_id"   .= msgOrderId
        , "side"       .= msgSide
        , "new_size"   .= msgNewSize
        , "old_size"   .= msgOldSize
        ] ++ maybe [] (return . ("price" .= )) msgMaybePrice
    toJSON ChangeMarket{..} = object
        [ "type"       .= ("change" :: Text)
        , "time"       .= msgTime
        , "product_id" .= msgProductId
        , "sequence"   .= msgSequence
        , "order_id"   .= msgOrderId
        , "side"       .= msgSide
        , "new_funds"  .= msgNewFunds
        , "old_funds"  .= msgOldFunds
        ]

    toJSON ReceivedLimit{..} = object (
        [ "type"       .= ("received" :: Text)
        , "time"       .= msgTime
        , "product_id" .= msgProductId
        , "sequence"   .= msgSequence
        , "order_id"   .= msgOrderId
        , "side"       .= msgSide
        , "size"       .= msgSize
        , "price"      .= msgPrice
        , "order_type" .= Limit
        ] ++ clientID)
            where
                clientID = case msgClientOid of
                    Nothing -> []
                    Just ci -> ["client_oid" .= msgClientOid ]

    toJSON ReceivedMarket{..} = object (
        ["type"       .= ("received" :: Text)
        , "time"       .= msgTime
        , "product_id" .= msgProductId
        , "sequence"   .= msgSequence
        , "order_id"   .= msgOrderId
        , "side"       .= msgSide
        , "order_type" .= Market
        ] ++ clientID ++ size ++ funds)
            where
                clientID = case msgClientOid of
                    Nothing -> []
                    Just ci -> ["client_oid" .= msgClientOid ]
                (size,funds) = case msgMarketBounds of
                    Left  s -> (["size" .= s],[])
                    Right (ms,f) -> case ms of
                                Nothing -> ( []            , ["funds" .= f] )
                                Just s' -> ( ["size" .= s'], ["funds" .= f] )
