diff options
Diffstat (limited to '')
| -rw-r--r-- | haskell/src/SpaceTraders/APIClient/Agent.hs | 2 | ||||
| -rw-r--r-- | haskell/src/SpaceTraders/APIClient/Client.hs | 29 | ||||
| -rw-r--r-- | haskell/src/SpaceTraders/APIClient/Errors.hs | 42 | ||||
| -rw-r--r-- | haskell/src/SpaceTraders/Model/Agent.hs | 7 |
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 |