diff options
Diffstat (limited to '')
| -rw-r--r-- | haskell/src/SpaceTraders/APIClient/Agent.hs | 4 | ||||
| -rw-r--r-- | haskell/src/SpaceTraders/APIClient/Client.hs | 39 | ||||
| -rw-r--r-- | haskell/src/SpaceTraders/APIClient/Pagination.hs | 19 | ||||
| -rw-r--r-- | haskell/src/SpaceTraders/APIClient/Systems.hs | 34 |
4 files changed, 89 insertions, 7 deletions
diff --git a/haskell/src/SpaceTraders/APIClient/Agent.hs b/haskell/src/SpaceTraders/APIClient/Agent.hs index 865764f..7773972 100644 --- a/haskell/src/SpaceTraders/APIClient/Agent.hs +++ b/haskell/src/SpaceTraders/APIClient/Agent.hs @@ -18,7 +18,7 @@ import SpaceTraders.Model.Agent(Agent) import SpaceTraders.Model.Ship(Ship) import SpaceTraders.Model.Contract -myAgent :: T.Text -> IO (Either APIError Agent) +myAgent :: T.Text -> IO (APIResponse Agent) myAgent t = send $ setRequestPath "/v2/my/agent" $ tokenReq t @@ -31,7 +31,7 @@ data RegisterMessage = RegisterMessage { agent :: Agent , token :: T.Text } deriving (FromJSON, Generic, Show) -register :: T.Text -> T.Text -> IO (Either APIError RegisterMessage) +register :: T.Text -> T.Text -> IO (APIResponse RegisterMessage) register s f = send $ setRequestPath "/v2/register" $ setRequestMethod "POST" $ setRequestBodyJSON RegisterRequest{symbol = s, faction = f} diff --git a/haskell/src/SpaceTraders/APIClient/Client.hs b/haskell/src/SpaceTraders/APIClient/Client.hs index cbbe422..87147b6 100644 --- a/haskell/src/SpaceTraders/APIClient/Client.hs +++ b/haskell/src/SpaceTraders/APIClient/Client.hs @@ -4,25 +4,39 @@ module SpaceTraders.APIClient.Client ( APIError(..) , APIMessage(..) + , APIPaginatedResponse + , APIResponse , defaultReq , fromJSONValue + , paginatedReq , send + , sendPaginated , tokenReq ) where import Control.Concurrent import Data.Aeson import Data.Aeson.Types +import qualified Data.ByteString as B +import qualified Data.ByteString.Internal as B import qualified Data.Text as T import qualified Data.Text.Encoding as T import Network.HTTP.Simple import Network.HTTP.Types.Status import SpaceTraders.APIClient.Errors +import SpaceTraders.APIClient.Pagination -data FromJSON a => APIMessage a = APIMessage { data_ :: a } deriving (Show) +data FromJSON a => APIMessage a = APIMessage { messageData :: a + , messagePagination :: Maybe Pagination + } deriving (Show) instance FromJSON a => FromJSON (APIMessage a) where - parseJSON = withObject "APIMessage" $ \o -> APIMessage <$> o .: "data" + parseJSON = withObject "APIMessage" $ \o -> + APIMessage <$> o .: "data" + <*> o .:? "meta" + +type APIPaginatedResponse a = Either APIError (APIMessage a) +type APIResponse a = Either APIError a defaultReq :: Request defaultReq = setRequestHost "api.spacetraders.io" @@ -31,6 +45,14 @@ defaultReq = setRequestHost "api.spacetraders.io" $ setRequestHeader "Content-Type" ["application/json"] $ defaultRequest +paginatedReq :: T.Text -> Maybe Pagination -> Request +paginatedReq token Nothing = setRequestQueryString [("limit", Just "20")] + $ tokenReq token +paginatedReq token (Just myPage) = setRequestQueryString [("limit", Just . int2ByteString $ limit myPage), ("page", Just . int2ByteString $ page myPage)] + $ tokenReq token + where + int2ByteString = B.pack . map B.c2w . show + tokenReq :: T.Text -> Request tokenReq token = setRequestHeader "Authorization" [T.encodeUtf8 $ "Bearer " <> token] $ defaultReq @@ -38,18 +60,25 @@ tokenReq token = setRequestHeader "Authorization" [T.encodeUtf8 $ "Bearer " <> t fromJSONValue :: FromJSON a => Value -> Either String a fromJSONValue = parseEither parseJSON -send :: FromJSON a => Request -> IO (Either APIError a) +send :: FromJSON a => Request -> IO (APIResponse a) send request = do + response <- sendPaginated request + case response of + Left e -> return $ Left e + Right (APIMessage d _) -> return $ Right d + +sendPaginated :: FromJSON a => Request -> IO (APIPaginatedResponse a) +sendPaginated request = do response <- httpLbs request let status = statusCode $ getResponseStatus response body = getResponseBody response if status >= 200 && status <= 299 then case eitherDecode body of Left e -> return . Left $ APIError (-1000) (T.pack $ concat ["Error decoding JSON APIMessage: ", e]) Null - Right r -> return . Right $ data_ r + Right r -> return $ Right r else case eitherDecode body of Left e -> return . Left $ APIError (-status) (T.pack $ concat ["Error decoding JSON APIError: ", e, ". Got HTTP body: ", show body]) Null Right (APIRateLimit r) -> do threadDelay (1_000_000 * (round $ retryAfter r)) - send request + sendPaginated request Right e -> return $ Left e diff --git a/haskell/src/SpaceTraders/APIClient/Pagination.hs b/haskell/src/SpaceTraders/APIClient/Pagination.hs new file mode 100644 index 0000000..bb9bcd1 --- /dev/null +++ b/haskell/src/SpaceTraders/APIClient/Pagination.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +module SpaceTraders.APIClient.Pagination + ( Pagination(..) + , nextPage + ) where + +import Data.Aeson +import GHC.Generics + +data Pagination = Pagination { limit :: Int + , page :: Int + , total :: Int + } deriving (FromJSON, Generic, Show) + +nextPage :: Pagination -> Pagination +nextPage (Pagination l p t) = Pagination l (p + 1) t diff --git a/haskell/src/SpaceTraders/APIClient/Systems.hs b/haskell/src/SpaceTraders/APIClient/Systems.hs new file mode 100644 index 0000000..fca2037 --- /dev/null +++ b/haskell/src/SpaceTraders/APIClient/Systems.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +module SpaceTraders.APIClient.Systems + ( listSystems + ) where + +import Control.Exception +import qualified Data.Text as T +import qualified Database.SQLite.Simple as S +import Network.HTTP.Simple + +import SpaceTraders.APIClient.Client +import SpaceTraders.APIClient.Pagination +import SpaceTraders.Database.Systems +import SpaceTraders.Model.System(System) + +listSystems :: T.Text -> S.Connection -> IO (APIResponse [System]) +listSystems t conn = do + s <- getSystems conn + listSystems' Pagination{limit=20, page=((length s) `div` 20) + 1, total=0} + where + listSystems' :: Pagination -> IO (APIResponse [System]) + listSystems' p = do + resp <- sendPaginated $ setRequestPath "/v2/systems" + $ paginatedReq t (Just p) + case resp of + Left e -> throwIO e + Right (APIMessage [] _) -> Right <$> getSystems conn + Right (APIMessage r (Just p')) -> do + addSystems conn r + listSystems' (nextPage p') + _ -> undefined |