summaryrefslogtreecommitdiff
path: root/haskell/src/SpaceTraders
diff options
context:
space:
mode:
Diffstat (limited to 'haskell/src/SpaceTraders')
-rw-r--r--haskell/src/SpaceTraders/APIClient/Agent.hs2
-rw-r--r--haskell/src/SpaceTraders/APIClient/Client.hs29
-rw-r--r--haskell/src/SpaceTraders/APIClient/Errors.hs42
-rw-r--r--haskell/src/SpaceTraders/Model/Agent.hs7
4 files changed, 60 insertions, 20 deletions
diff --git a/haskell/src/SpaceTraders/APIClient/Agent.hs b/haskell/src/SpaceTraders/APIClient/Agent.hs
index 4ac550c..865764f 100644
--- a/haskell/src/SpaceTraders/APIClient/Agent.hs
+++ b/haskell/src/SpaceTraders/APIClient/Agent.hs
@@ -14,7 +14,7 @@ import qualified Data.Text as T
import Network.HTTP.Simple
import SpaceTraders.APIClient.Client
-import SpaceTraders.Model.Agent
+import SpaceTraders.Model.Agent(Agent)
import SpaceTraders.Model.Ship(Ship)
import SpaceTraders.Model.Contract
diff --git a/haskell/src/SpaceTraders/APIClient/Client.hs b/haskell/src/SpaceTraders/APIClient/Client.hs
index e4744aa..4e9e9d1 100644
--- a/haskell/src/SpaceTraders/APIClient/Client.hs
+++ b/haskell/src/SpaceTraders/APIClient/Client.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
module SpaceTraders.APIClient.Client
@@ -9,6 +10,7 @@ module SpaceTraders.APIClient.Client
, tokenReq
) where
+import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.Aeson
@@ -18,16 +20,7 @@ import qualified Data.Text.Encoding as T
import Network.HTTP.Simple
import Network.HTTP.Types.Status
-data APIError = APIError { apiErrorCode :: Int
- , apiErrorMessage :: T.Text
- } deriving Show
-instance Exception APIError
-instance FromJSON APIError where
- parseJSON (Object o) = do
- e <- o .: "error"
- APIError <$> e .: "code"
- <*> e .: "message"
- parseJSON _ = mzero
+import SpaceTraders.APIClient.Errors
data APIMessage = APIMessage { data_ :: Value } deriving (Show)
instance FromJSON APIMessage where
@@ -55,13 +48,21 @@ send request = do
body = getResponseBody response
if status >= 200 && status <= 299
then case eitherDecode body of
- Left e -> return $ Left APIError{apiErrorCode = -1000, apiErrorMessage = T.pack $ concat ["Error decoding JSON APIMessage: ", e]}
+ Left e -> return . Left $ APIError (-1000) Null (T.pack $ concat ["Error decoding JSON APIMessage: ", e])
Right r -> case fromJSONValue (data_ r) of
- Left e -> return $ Left APIError{apiErrorCode = -1001, apiErrorMessage = T.pack $ concat ["Error decoding JSON message contents: ", e]}
+ Left e -> return . Left $ APIError (-1001) Null (T.pack $ concat ["Error decoding JSON message contents: ", e])
Right m -> return $ Right m
else case eitherDecode body of
- Left e -> return $ Left APIError{apiErrorCode = -status, apiErrorMessage = T.pack $ concat ["Error decoding JSON APIError: ", e, ". Got HTTP body: ", show body]}
- Right e -> return $ Left e
+ Left e -> return . Left $ APIError (-status) Null (T.pack $ concat ["Error decoding JSON APIError: ", e, ". Got HTTP body: ", show body])
+ Right e -> case apiErrorCode e of
+ 429 -> do -- We are being rate limited
+ let d = apiErrorData e
+ w <- case fromJSONValue d of
+ Left _ -> throwIO e
+ Right e' -> return $ retryAfter e'
+ threadDelay (1_000_000 * (round w))
+ send request
+ _ -> return $ Left e
--handleAPIError :: SomeException -> IO (Maybe RegisterMessage)
--handleAPIError e = do
diff --git a/haskell/src/SpaceTraders/APIClient/Errors.hs b/haskell/src/SpaceTraders/APIClient/Errors.hs
new file mode 100644
index 0000000..4ab47bc
--- /dev/null
+++ b/haskell/src/SpaceTraders/APIClient/Errors.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module SpaceTraders.APIClient.Errors
+ ( APIError(..)
+ , RateLimit(..)
+ ) where
+
+import Control.Exception
+import Control.Monad
+import Data.Aeson
+import Data.Time
+import qualified Data.Text as T
+
+data APIError = APIError { apiErrorCode :: Int
+ , apiErrorData :: Value
+ , apiErrorMessage :: T.Text
+ } deriving Show
+instance Exception APIError
+instance FromJSON APIError where
+ parseJSON (Object o) = do
+ e <- o .: "error"
+ APIError <$> e .: "code"
+ <*> e .: "data"
+ <*> e .: "message"
+ parseJSON _ = mzero
+
+data RateLimit = RateLimit { limitBurst :: Int
+ , limitPerSecond :: Int
+ , rateLimitType :: T.Text
+ , remaining :: Int
+ , reset :: UTCTime
+ , retryAfter :: Double
+ } deriving Show
+instance FromJSON RateLimit where
+ parseJSON (Object o) = do
+ RateLimit <$> o .: "limitBurst"
+ <*> o .: "limitPerSecond"
+ <*> o .: "type"
+ <*> o .: "remaining"
+ <*> o .: "reset"
+ <*> o .: "retryAfter"
+ parseJSON _ = mzero
diff --git a/haskell/src/SpaceTraders/Model/Agent.hs b/haskell/src/SpaceTraders/Model/Agent.hs
index be97ac4..3852107 100644
--- a/haskell/src/SpaceTraders/Model/Agent.hs
+++ b/haskell/src/SpaceTraders/Model/Agent.hs
@@ -3,8 +3,7 @@
{-# LANGUAGE OverloadedStrings #-}
module SpaceTraders.Model.Agent
- ( Agent(accountId, credits, headquarters)
- , agentSymbol
+ ( Agent(..)
) where
import Data.Aeson
@@ -13,10 +12,8 @@ import qualified Data.Text as T
data Agent = Agent { accountId :: T.Text
, credits :: Integer
+ --, faction :: Faction
, headquarters :: T.Text
, startingFaction :: T.Text
, symbol :: T.Text
} deriving (FromJSON, Generic, Show, ToJSON)
-
-agentSymbol :: Agent -> T.Text
-agentSymbol = symbol