[haskell] Implemented pagination and systems list api call

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}

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

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

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