From 7bd1c116c26d0c2147aa787b04f6e7de85d44133 Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Tue, 11 Jul 2023 21:55:55 +0200
Subject: [haskell] Implemented pagination and systems list api call

---
 haskell/src/SpaceTraders/APIClient/Client.hs | 39 ++++++++++++++++++++++++----
 1 file changed, 34 insertions(+), 5 deletions(-)

(limited to 'haskell/src/SpaceTraders/APIClient/Client.hs')

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
-- 
cgit v1.2.3