coinbase-exchange 0.2.0.2 → 0.3.0.0

raw patch · 9 files changed

+502/−114 lines, 9 filesdep +asyncdep +randomdep +unordered-containersdep ~aesondep ~mtldep ~timePVP ok

version bump matches the API change (PVP)

Dependencies added: async, random, unordered-containers

Dependency ranges changed: aeson, mtl, time

API changes (from Hackage documentation)

Files

• coinbase-exchange.cabal +15/−6
• sbox/Main.hs +2/−8
• src/Coinbase/Exchange/Rest.hs +3/−1
• src/Coinbase/Exchange/Socket.hs +1/−1
• src/Coinbase/Exchange/Types/Core.hs +19/−21
• src/Coinbase/Exchange/Types/MarketData.hs +6/−7
• src/Coinbase/Exchange/Types/Private.hs +173/−41
• src/Coinbase/Exchange/Types/Socket.hs +278/−27
• test/Main.hs +5/−2

@@ -1,5 +1,5 @@ name:                coinbase-exchange-version:             0.2.0.2+version:             0.3.0.0 synopsis:            Connector library for the coinbase exchange. description:         Access library for the coinbase exchange. Allows the use                      of both the public market data API as well as the private@@ -11,7 +11,7 @@ maintainer:          andrewrademacher@gmail.com category:            Web build-type:          Simple-cabal-version:       >=1.10+cabal-version:       >=1.20  library     hs-source-dirs:     src@@ -29,19 +29,19 @@     other-modules:      Coinbase.Exchange.Rest      build-depends:      base                ==4.*-                    ,   mtl+                    ,   mtl                 >=2.2                     ,   resourcet                     ,   transformers-base                     ,   conduit                     ,   conduit-extra                     ,   http-conduit-                    ,   aeson+                    ,   aeson               >=0.10.0                     ,   aeson-casing                     ,   http-types                     ,   text                     ,   bytestring                     ,   base64-bytestring-                    ,   time+                    ,   time                >=1.5                     ,   scientific                     ,   uuid                     ,   uuid-aeson@@ -54,6 +54,7 @@                     ,   cryptohash                     ,   byteable                     ,   exceptions+                    ,   unordered-containers                      ,   old-locale @@ -68,7 +69,7 @@                      ,   uuid                     ,   text-                    ,   aeson+                    ,   aeson               >=0.10.0                     ,   bytestring                     ,   time                     ,   old-locale@@ -81,6 +82,7 @@                     ,   network                     ,   wuss                     ,   scientific+                    ,   unordered-containers                      ,   coinbase-exchange @@ -88,6 +90,7 @@     type:               exitcode-stdio-1.0     main-is:            Main.hs     hs-source-dirs:     test+    ghc-options:        -threaded     default-language:   Haskell2010      build-depends:      base                ==4.*@@ -103,5 +106,11 @@                     ,   http-client-tls                     ,   http-conduit                     ,   transformers+                    ,   random+                    ,   scientific+                    ,   async+                    ,   websockets+                    ,   aeson               >=0.10.0+                    ,   unordered-containers                      ,   coinbase-exchange

@@ -24,10 +24,7 @@ import           Coinbase.Exchange.Types.Socket  main :: IO ()-main = putStrLn "Use GHCi."--testCoinbaseTime :: String-testCoinbaseTime = "2015-05-06 21:58:22.84227+0000"+main = printSocket -- putStrLn "Use GHCi."  btc :: ProductId btc = "BTC-USD"@@ -38,9 +35,6 @@ end :: Maybe UTCTime end = Just $ parseTimeOrError True defaultTimeLocale "%FT%X%z" "2015-04-23T20:22:37+0000" -accountId :: AccountId-accountId = AccountId $ fromJust $ fromString "52072cbb-4e76-496f-a479-166cb4d177fa"- withCoinbase :: Exchange a -> IO a withCoinbase act = do         mgr     <- newManager tlsManagerSettings@@ -49,7 +43,7 @@         tPass   <- liftM CBS.pack $ getEnv "COINBASE_PASSPHRASE"          case mkToken tKey tSecret tPass of-            Right tok -> do res <- runExchange (ExchangeConf mgr (Just tok) Sandbox) act+            Right tok -> do res <- runExchange (ExchangeConf mgr (Just tok) Live) act                             case res of                                 Right s -> return s                                 Left  f -> error $ show f

@@ -32,6 +32,8 @@  import           Coinbase.Exchange.Types +-- import Debug.Trace+ type Signed = Bool  voidBody :: Maybe ()@@ -122,7 +124,7 @@                 => Response (ResumableSource m BS.ByteString) -> m b processResponse res =     case responseStatus res of-        s | s == status200 -> do body <- responseBody res $$+- sinkParser (fmap fromJSON json)+        s | s == status200 -> do body <- responseBody res $$+- sinkParser (fmap {-(\x -> trace (show x) fromJSON x)-} fromJSON json)                                  case body of                                      Success b -> return b                                      Error  er -> throwError $ ParseFailure $ T.pack er

@@ -14,7 +14,7 @@ import           Coinbase.Exchange.Types.Core import           Coinbase.Exchange.Types.Socket -subscribe :: ApiType -> ProductId -> WS.ClientApp () -> IO ()+subscribe :: ApiType -> ProductId -> WS.ClientApp a -> IO a subscribe atype pid app = withSocketsDo $         runSecureClient location 443 "/" $ \conn -> do             WS.sendBinaryData conn $ encode (Subscribe pid)

@@ -23,6 +23,7 @@ import           Data.UUID.Aeson     () import           Data.Word import           GHC.Generics+import           Text.Read           (readMaybe)   newtype ProductId = ProductId { unProductId :: Text }@@ -34,12 +35,18 @@ newtype Size = Size { unSize :: CoinScientific }     deriving (Eq, Ord, Num, Fractional, Real, RealFrac, Show, Read, Data, Typeable, Generic, NFData, Hashable, FromJSON, ToJSON) +newtype Cost = Cost { unCost :: CoinScientific }+    deriving (Eq, Ord, Num, Fractional, Real, RealFrac, Show, Read, Data, Typeable, Generic, NFData, Hashable, FromJSON, ToJSON)+ newtype OrderId = OrderId { unOrderId :: UUID }     deriving (Eq, Ord, Show, Read, Data, Typeable, Generic, NFData, Hashable, FromJSON, ToJSON)  newtype Aggregate = Aggregate { unAggregate :: Int64 }     deriving (Eq, Ord, Show, Read, Num, Data, Typeable, Generic, NFData, Hashable, FromJSON, ToJSON) +newtype Sequence = Sequence { unSequence :: Word64 }+    deriving (Eq, Ord, Num, Show, Read, Data, Typeable, Generic, NFData, Hashable, FromJSON, ToJSON)+ --  data Side = Buy | Sell@@ -53,7 +60,18 @@     parseJSON = genericParseJSON coinbaseAesonOptions  --+data OrderType = Limit | Market+    deriving (Eq, Ord, Show, Read, Data, Typeable, Generic) +instance NFData OrderType+instance Hashable OrderType+instance ToJSON OrderType where+    toJSON = genericToJSON coinbaseAesonOptions+instance FromJSON OrderType where+    parseJSON = genericParseJSON coinbaseAesonOptions++--+ newtype TradeId = TradeId { unTradeId :: Word64 }     deriving (Eq, Ord, Num, Show, Read, Data, Typeable, Generic, NFData, Hashable) @@ -111,29 +129,9 @@     toJSON (CoinScientific v) = String . T.pack . show $ v instance FromJSON CoinScientific where     parseJSON = withText "CoinScientific" $ \t ->-        case maybeRead (T.unpack t) of+        case readMaybe (T.unpack t) of             Just  n -> pure $ CoinScientific n             Nothing -> fail "Could not parse string scientific."--maybeRead :: (Read a) => String -> Maybe a-maybeRead = fmap fst . listToMaybe . reads--------newtype CoinbaseTime = CoinbaseTime { unCoinbaseTime :: UTCTime }-    deriving (Eq, Ord, Show, Read, Data, Typeable, NFData)--instance ToJSON CoinbaseTime where-    toJSON (CoinbaseTime t) = String $ T.pack $-        formatTime defaultTimeLocale coinbaseTimeFormat t ++ "00"-instance FromJSON CoinbaseTime where-    parseJSON = withText "Coinbase Time" $ \t ->-        case parseTimeM True defaultTimeLocale coinbaseTimeFormat (T.unpack t ++ "00") of-            Just d -> pure $ CoinbaseTime d-            _      -> fail "could not parse coinbase time format."--coinbaseTimeFormat :: String-coinbaseTimeFormat = "%F %T%Q%z"  ---- 

@@ -16,7 +16,6 @@ import           Data.Data import           Data.Hashable import           Data.Int-import           Data.Scientific import           Data.String import           Data.Text                    (Text) import           Data.Time@@ -35,9 +34,9 @@         { prodId             :: ProductId         , prodBaseCurrency   :: CurrencyId         , prodQuoteCurrency  :: CurrencyId-        , prodBaseMinSize    :: Scientific-        , prodBaseMaxSize    :: Scientific-        , prodQuoteIncrement :: Scientific+        , prodBaseMinSize    :: CoinScientific+        , prodBaseMaxSize    :: CoinScientific+        , prodQuoteIncrement :: CoinScientific         , prodDisplayName    :: Text         }     deriving (Show, Data, Typeable, Generic)@@ -52,7 +51,7 @@  data Book a     = Book-        { bookSequence :: Word64+        { bookSequence :: Sequence         , bookBids     :: [Bid a]         , bookAsks     :: [Ask a]         }@@ -113,14 +112,14 @@  instance NFData Trade instance ToJSON Trade where-    toJSON Trade{..} = object [ "time"      .= CoinbaseTime tradeTime+    toJSON Trade{..} = object [ "time"      .= tradeTime                               , "trade_id"  .= tradeTradeId                               , "price"     .= tradePrice                               , "size"      .= tradeSize                               , "side"      .= tradeSide                               ] instance FromJSON Trade where-    parseJSON (Object m) = Trade <$> liftM unCoinbaseTime (m .: "time")+    parseJSON (Object m) = Trade <$> m .: "time"                                  <*> m .: "trade_id"                                  <*> m .: "price"                                  <*> m .: "size"

@@ -37,7 +37,7 @@         , accAvailable :: CoinScientific         , accCurrency  :: CurrencyId         }-    deriving (Show, Data, Typeable, Generic)+    deriving (Show, Eq, Data, Typeable, Generic)  instance NFData Account instance ToJSON Account where@@ -64,7 +64,7 @@ instance NFData Entry instance ToJSON Entry where     toJSON Entry{..} = object [ "id"         .= entryId-                              , "created_at" .= CoinbaseTime entryCreatedAt+                              , "created_at" .= entryCreatedAt                               , "amount"     .= entryAmount                               , "balance"    .= entryBalance                               , "type"       .= entryType@@ -73,7 +73,7 @@ instance FromJSON Entry where     parseJSON (Object m) = Entry         <$> m .: "id"-        <*> liftM unCoinbaseTime (m .: "created_at")+        <*> m .: "created_at"         <*> m .: "amount"         <*> m .: "balance"         <*> m .: "type"@@ -138,7 +138,25 @@     parseJSON = genericParseJSON coinbaseAesonOptions  -- Orders+data OrderContigency+    = GoodTillCanceled+    | ImmediateOrCancel+    | FillOrKill+    deriving (Eq, Ord, Show, Read, Data, Typeable, Generic) +instance NFData   OrderContigency+instance Hashable OrderContigency++instance ToJSON OrderContigency where+    toJSON GoodTillCanceled  = String "GTC"+    toJSON ImmediateOrCancel = String "IOC"+    toJSON FillOrKill        = String "FOK"+instance FromJSON OrderContigency where+    parseJSON (String "GTC") = return GoodTillCanceled+    parseJSON (String "IOC") = return ImmediateOrCancel+    parseJSON (String "FOK") = return FillOrKill+    parseJSON _ = mzero+ data SelfTrade     = DecrementAndCancel     | CancelOldest@@ -161,22 +179,61 @@     parseJSON _ = mzero  data NewOrder-    = NewOrder-        { noSize      :: Size+    = NewLimitOrder+        { noProductId :: ProductId+        , noSide      :: Side+        , noSelfTrade :: SelfTrade+        , noClientOid :: Maybe ClientOrderId+        ---         , noPrice     :: Price+        , noSize      :: Size+        ,noTimeInForce:: OrderContigency+        , noPostOnly  :: Bool+        }+    | NewMarketOrder+        { noProductId :: ProductId         , noSide      :: Side-        , noProductId :: ProductId+        , noSelfTrade :: SelfTrade         , noClientOid :: Maybe ClientOrderId-        , noSelfTrade :: Maybe SelfTrade+        ---+        , noSizeAndOrFunds  :: Either Size (Maybe Size, Cost)         }     deriving (Show, Data, Typeable, Generic)  instance NFData NewOrder instance ToJSON NewOrder where-    toJSON = genericToJSON coinbaseAesonOptions-instance FromJSON NewOrder where-    parseJSON = genericParseJSON coinbaseAesonOptions+        toJSON NewLimitOrder{..} = object+           ([ "type" .= ("limit" :: Text)+            , "product_id"    .= noProductId+            , "side"          .= noSide+            , "stp"           .= noSelfTrade+            , "price"         .= noPrice+            , "size"          .= noSize+            , "time_in_force" .= noTimeInForce+            , "post_only"     .= noPostOnly+            ] ++ clientID )+            where+                clientID = case noClientOid of+                                Just cid -> [ "client_oid" .= cid ]+                                Nothing  -> [] +        toJSON NewMarketOrder{..} = object+           ([ "type" .= ("market" :: Text)+            , "product_id"    .= noProductId+            , "side"          .= noSide+            , "stp"           .= noSelfTrade+            ] ++ clientID ++ size ++ funds )+            where+                clientID = case noClientOid of+                                Just cid -> [ "client_oid" .= cid ]+                                Nothing  -> []+                (size,funds) = case noSizeAndOrFunds of+                                Left  s -> (["size" .= s],[])+                                Right (ms,f) -> case ms of+                                            Nothing -> ( []            , ["funds" .= f] )+                                            Just s' -> ( ["size" .= s'], ["funds" .= f] )++ data OrderConfirmation     = OrderConfirmation         { ocId :: OrderId@@ -190,52 +247,127 @@     parseJSON = genericParseJSON coinbaseAesonOptions  data Order-    = Order+    = LimitOrder         { orderId         :: OrderId-        , orderSize       :: Size-        , orderPrice      :: Price         , orderProductId  :: ProductId         , orderStatus     :: OrderStatus+        , orderSelfTrade  :: SelfTrade+        , orderSettled    :: Bool+        , orderSide       :: Side+        , orderCreatedAt  :: UTCTime         , orderFilledSize :: Maybe Size         , orderFilledFees :: Maybe Price+        , orderDoneAt     :: Maybe UTCTime+        , orderDoneReason :: Maybe Reason++        , orderPrice      :: Price+        , orderSize       :: Size+        , orderTimeInForce:: OrderContigency+        , orderPostOnly   :: Bool+        }+    | MarketOrder+        { orderId         :: OrderId+        , orderProductId  :: ProductId+        , orderStatus     :: OrderStatus+        , orderSelfTrade  :: SelfTrade         , orderSettled    :: Bool         , orderSide       :: Side         , orderCreatedAt  :: UTCTime+        , orderFilledSize :: Maybe Size+        , orderFilledFees :: Maybe Price         , orderDoneAt     :: Maybe UTCTime         , orderDoneReason :: Maybe Reason++        , orderSizeAndOrFunds  :: Either Size (Maybe Size, Cost)         }     deriving (Show, Data, Typeable, Generic)  instance NFData Order instance ToJSON Order where-    toJSON Order{..} = object-        [ "id"          .= orderId-        , "size"        .= orderSize-        , "price"       .= orderPrice-        , "product_id"  .= orderProductId-        , "status"      .= orderStatus-        , "filled_size" .= orderFilledSize-        , "filled_fees" .= orderFilledFees-        , "settled"     .= orderSettled-        , "side"        .= orderSide-        , "created_at"  .= CoinbaseTime orderCreatedAt-        , "done_at"     .= liftM CoinbaseTime orderDoneAt-        , "done_reason" .= orderDoneReason+    toJSON LimitOrder{..} = object+        [ "type" .= ("limit" :: Text)+        , "id"            .= orderId+        , "product_id"    .= orderProductId+        , "status"        .= orderStatus+        , "stp"           .= orderSelfTrade+        , "settled"       .= orderSettled+        , "side"          .= orderSide+        , "created_at"    .= orderCreatedAt+        , "filled_size"   .= orderFilledSize+        , "filled_fees"   .= orderFilledFees+        , "done_at"       .= orderDoneAt+        , "done_reason"   .= orderDoneReason++        , "price"         .= orderPrice+        , "size"          .= orderSize+        , "time_in_force" .= orderTimeInForce+        , "post_only"     .= orderPostOnly         ]+    toJSON MarketOrder{..} = object+       ([ "type" .= ("market" :: Text)+        , "id"            .= orderId+        , "product_id"    .= orderProductId+        , "status"        .= orderStatus+        , "stp"           .= orderSelfTrade+        , "settled"       .= orderSettled+        , "side"          .= orderSide+        , "created_at"    .= orderCreatedAt+        , "filled_size"   .= orderFilledSize+        , "filled_fees"   .= orderFilledFees+        , "done_at"       .= orderDoneAt+        , "done_reason"   .= orderDoneReason+        ] ++ size ++ funds )+            where (size,funds) = case orderSizeAndOrFunds of+                        Left  s -> (["size" .= s],[])+                        Right (ms,f) -> case ms of+                                    Nothing -> ( []            , ["funds" .= f] )+                                    Just s' -> ( ["size" .= s'], ["funds" .= f] )++ instance FromJSON Order where-    parseJSON (Object m) = Order-        <$> m .: "id"-        <*> m .: "size"-        <*> m .: "price"-        <*> m .: "product_id"-        <*> m .: "status"-        <*> m .:? "filled_size"-        <*> m .:? "filled_fees"-        <*> m .: "settled"-        <*> m .: "side"-        <*> liftM unCoinbaseTime (m .: "created_at")-        <*> liftM (liftM unCoinbaseTime) (m .:? "done_at")-        <*> m .:? "done_reason"+    parseJSON (Object m) = do+        ordertype <- m .: "type"+        case (ordertype :: String) of+            "limit" -> LimitOrder+                <$> m .: "id"+                <*> m .: "product_id"+                <*> m .: "status"+                <*> m .: "stp"+                <*> m .: "settled"+                <*> m .: "side"+                <*> m .: "created_at"+                <*> m .:? "filled_size"+                <*> m .:? "filled_fees"+                <*> m .:? "done_at"+                <*> m .:? "done_reason"+                <*> m .: "price"+                <*> m .: "size"+                <*> m .:? "time_in_force" .!= GoodTillCanceled -- older orders don't seem to have this field+                <*> m .: "post_only"++            "market" -> MarketOrder+                <$> m .: "id"+                <*> m .: "product_id"+                <*> m .: "status"+                <*> m .: "stp"+                <*> m .: "settled"+                <*> m .: "side"+                <*> m .: "created_at"+                <*> m .:? "filled_size"+                <*> m .:? "filled_fees"+                <*> m .:? "done_at"+                <*> m .:? "done_reason"+                <*> (do+                        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)+                            )+            _ -> mzero+     parseJSON _ = mzero  -- Fills@@ -278,7 +410,7 @@         , "price"       .= fillPrice         , "size"        .= fillSize         , "order_id"    .= fillOrderId-        , "created_at"  .= CoinbaseTime fillCreatedAt+        , "created_at"  .= fillCreatedAt         , "liquidity"   .= fillLiquidity         , "fee"         .= fillFee         , "settled"     .= fillSettled@@ -291,7 +423,7 @@         <*> m .: "price"         <*> m .: "size"         <*> m .: "order_id"-        <*> liftM unCoinbaseTime (m .: "created_at")+        <*> m .: "created_at"         <*> m .: "liquidity"         <*> m .: "fee"         <*> m .: "settled"

@@ -2,75 +2,108 @@ {-# LANGUAGE DeriveGeneric              #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE RecordWildCards            #-} + module Coinbase.Exchange.Types.Socket where  import           Control.DeepSeq-import           Data.Aeson.Types+import           Control.Monad+import           Data.Aeson.Types      hiding (Error) import           Data.Data import           Data.Hashable import           Data.Text                    (Text) import           Data.Time import           Data.Word import           GHC.Generics--import           Coinbase.Exchange.Types.Core+import qualified Data.HashMap.Strict as H -newtype Sequence = Sequence { unSequence :: Word64 }-    deriving (Eq, Ord, Num, Show, Read, Data, Typeable, Generic, NFData, Hashable, FromJSON, ToJSON)+import           Coinbase.Exchange.Types.Core  hiding (OrderStatus(..))  data ExchangeMessage     = Subscribe         { msgProductId :: ProductId         }-    | Received+    | ReceivedLimit         { msgTime      :: UTCTime         , msgProductId :: ProductId         , msgSequence  :: Sequence         , msgOrderId   :: OrderId-        , msgSize      :: Size+        , 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-        , msgPrice         :: Price-        , msgRemainingSize :: Size         , msgSide          :: Side-        }-    | Done-        { msgTime      :: UTCTime-        , msgProductId :: ProductId-        , msgSequence  :: Sequence-        , msgPrice     :: Price-        , msgOrderId   :: OrderId-        , msgReason    :: Reason-        , msgSide      :: Side+        , msgRemainingSize :: Size+        , msgPrice         :: Price         }     | Match-        { msgTradeId      :: TradeId+        { msgTime         :: UTCTime+        , msgProductId    :: ProductId         , msgSequence     :: Sequence+        , msgSide         :: Side+        , msgTradeId      :: TradeId         , msgMakerOrderId :: OrderId         , msgTakerOrderId :: OrderId-        , msgTime         :: UTCTime-        , msgProductId    :: ProductId         , msgSize         :: Size         , msgPrice        :: Price-        , msgSide         :: Side         }-    | Change+    | DoneLimit         { msgTime      :: UTCTime+        , msgProductId :: ProductId         , msgSequence  :: Sequence         , msgOrderId   :: OrderId+        , msgSide      :: Side+        , msgRemainingSize :: Size+        , msgPrice     :: Price+        , msgReason    :: Reason+        , msgOrderType :: OrderType+        }+    | DoneMarket+        { msgTime      :: UTCTime         , msgProductId :: ProductId+        , msgSequence  :: Sequence+        , msgOrderId   :: OrderId+        , msgSide      :: Side+        , msgReason    :: Reason+        , msgOrderType :: OrderType+        }+    | ChangeLimit+        { msgTime      :: UTCTime+        , msgProductId :: ProductId+        , msgSequence  :: Sequence+        , msgOrderId   :: OrderId+        , msgSide      :: Side+        , msgPrice     :: Price         , msgNewSize   :: Size         , msgOldSize   :: Size-        , msgPrice     :: Price+        }+    | ChangeMarket+        { msgTime      :: UTCTime+        , msgProductId :: ProductId+        , msgSequence  :: Sequence+        , msgOrderId   :: OrderId         , msgSide      :: Side+        , msgPrice     :: Price+        , msgNewFunds  :: Cost+        , msgOldFunds  :: Cost         }     | Error         { msgMessage :: Text@@ -78,7 +111,225 @@     deriving (Eq, Show, Read, Data, Typeable, Generic)  instance NFData ExchangeMessage-instance ToJSON ExchangeMessage where-    toJSON = genericToJSON coinbaseAesonOptions++----------------------------- instance FromJSON ExchangeMessage where-    parseJSON = genericParseJSON coinbaseAesonOptions+    parseJSON (Object m) = do+        msgtype <- m .: "type"+        case (msgtype :: String) of+            "open" -> Open+                <$> m .: "time"+                <*> m .: "product_id"+                <*> m .: "sequence"+                <*> m .: "order_id"+                <*> m .: "side"+                <*> m .: "remaining_size"+                <*> m .: "price"+            "done" -> do+                typ  <- m .: "order_type"+                case typ of+                    Limit -> DoneLimit+                        <$> m .: "time"+                        <*> m .: "product_id"+                        <*> m .: "sequence"+                        <*> m .: "order_id"+                        <*> m .: "side"+                        <*> m .: "remaining_size"+                        <*> m .: "price"+                        <*> m .: "reason"+                        <*> m .: "order_type"+                    Market -> DoneMarket+                        <$> m .: "time"+                        <*> m .: "product_id"+                        <*> m .: "sequence"+                        <*> m .: "order_id"+                        <*> m .: "side"+                        <*> m .: "reason"+                        <*> m .: "order_type"+            "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 .:? "new_size"+                case (ms :: Maybe Size) of+                    Nothing -> ChangeMarket+                                <$> m .: "time"+                                <*> m .: "product_id"+                                <*> m .: "sequence"+                                <*> m .: "order_id"+                                <*> m .: "side"+                                <*> m .: "price"+                                <*> m .: "new_funds"+                                <*> m .: "old_funds"+                    Just _ -> ChangeLimit+                                <$> m .: "time"+                                <*> m .: "product_id"+                                <*> m .: "sequence"+                                <*> m .: "order_id"+                                <*> m .: "side"+                                <*> m .: "price"+                                <*> m .: "new_size"+                                <*> m .: "old_size"+            "received" -> do+                typ  <- m .:  "order_type"+                mcid <- m .:? "client_id"+                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 can'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)+                                            )++    parseJSON _ = mzero++---------------------------+-- This is based on the code for Aeson'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 ExchangeMessage where+    toJSON Subscribe{..} = object+        [ "type"       .= ("subscribe" :: Text)+        , "product_id" .= msgProductId+        ]+    toJSON Open{..} = object+        [ "type"       .= ("open" :: Text)+        , "time"       .= msgTime+        , "product_id" .= msgProductId+        , "sequence"   .= msgSequence+        , "order_id"   .= msgOrderId+        , "side"       .= msgSide+        , "remaining_size" .= msgRemainingSize+        , "price"      .= msgPrice+        ]+    toJSON DoneLimit{..} = object+        [ "type"       .= ("done" :: Text)+        , "time"       .= msgTime+        , "product_id" .= msgProductId+        , "sequence"   .= msgSequence+        , "order_id"   .= msgOrderId+        , "side"       .= msgSide+        , "remaining_size" .= msgRemainingSize+        , "price"      .= msgPrice+        , "reason"     .= msgReason+        , "order_type" .= Limit+        ]+    toJSON DoneMarket{..} = object+        [ "type"       .= ("done" :: Text)+        , "time"       .= msgTime+        , "product_id" .= msgProductId+        , "sequence"   .= msgSequence+        , "order_id"   .= msgOrderId+        , "side"       .= msgSide+        , "reason"     .= msgReason+        , "order_type" .= Market+        ]+    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+        , "price"      .= msgPrice+        ]+    toJSON ChangeMarket{..} = object+        [ "type"       .= ("change" :: Text)+        , "time"       .= msgTime+        , "product_id" .= msgProductId+        , "sequence"   .= msgSequence+        , "order_id"   .= msgOrderId+        , "side"       .= msgSide+        , "price"      .= msgPrice+        , "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_id" .= 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_id" .= 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] )

@@ -11,6 +11,8 @@  import qualified Coinbase.Exchange.MarketData.Test as MarketData import qualified Coinbase.Exchange.Private.Test    as Private+import qualified Coinbase.Exchange.Socket.Test     as Socket+ main :: IO () main = do         mgr     <- newManager tlsManagerSettings@@ -19,11 +21,12 @@         tPass   <- liftM CBS.pack $ getEnv "COINBASE_PASSPHRASE"          case mkToken tKey tSecret tPass of-            Right tok -> defaultMain (tests $ ExchangeConf mgr (Just tok) Sandbox)+            Right tok -> defaultMain (tests $ ExchangeConf mgr (Just tok) Live)             Left   er -> error $ show er  tests :: ExchangeConf -> TestTree tests conf = testGroup "Tests"         [ MarketData.tests conf-        , Private.tests conf+        , Private.tests    conf+        , Socket.tests     conf         ]