diff options
Diffstat (limited to 'haskell/src/SpaceTraders/APIClient')
| -rw-r--r-- | haskell/src/SpaceTraders/APIClient/Agent.hs | 39 | ||||
| -rw-r--r-- | haskell/src/SpaceTraders/APIClient/Client.hs | 50 | ||||
| -rw-r--r-- | haskell/src/SpaceTraders/APIClient/Contracts.hs | 16 | ||||
| -rw-r--r-- | haskell/src/SpaceTraders/APIClient/Errors.hs | 31 | ||||
| -rw-r--r-- | haskell/src/SpaceTraders/APIClient/Pagination.hs | 9 | ||||
| -rw-r--r-- | haskell/src/SpaceTraders/APIClient/Ships.hs | 35 | ||||
| -rw-r--r-- | haskell/src/SpaceTraders/APIClient/Systems.hs | 22 |
7 files changed, 101 insertions, 101 deletions
diff --git a/haskell/src/SpaceTraders/APIClient/Agent.hs b/haskell/src/SpaceTraders/APIClient/Agent.hs index 7b367f6..cdd04e6 100644 --- a/haskell/src/SpaceTraders/APIClient/Agent.hs +++ b/haskell/src/SpaceTraders/APIClient/Agent.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} module SpaceTraders.APIClient.Agent @@ -8,28 +8,33 @@ module SpaceTraders.APIClient.Agent , register ) where -import Control.Monad.Reader -import Data.Aeson -import GHC.Generics -import qualified Data.Text as T -import Network.HTTP.Simple +import Control.Monad.Reader +import Data.Aeson +import qualified Data.Text as T +import GHC.Generics +import Network.HTTP.Simple -import SpaceTraders -import SpaceTraders.APIClient.Client -import SpaceTraders.Model.Agent(Agent) -import SpaceTraders.Model.Ship(Ship) -import SpaceTraders.Model.Contract +import SpaceTraders +import SpaceTraders.APIClient.Client +import SpaceTraders.Database.Agents +import SpaceTraders.Model.Agent (Agent) +import SpaceTraders.Model.Contract +import SpaceTraders.Model.Ship (Ship) myAgent :: SpaceTradersT (APIResponse Agent) -myAgent = send $ setRequestPath "/v2/my/agent" +myAgent = do + a@(Right ag) <- send $ setRequestPath "/v2/my/agent" + setAgent ag + return a + data RegisterRequest = RegisterRequest { faction :: T.Text - , symbol :: T.Text + , symbol :: T.Text } deriving (ToJSON, Generic, Show) -data RegisterMessage = RegisterMessage { agent :: Agent +data RegisterMessage = RegisterMessage { agent :: Agent , contract :: Contract - , ship :: Ship - , token :: T.Text + , ship :: Ship + , token :: T.Text } deriving (FromJSON, Generic, Show) register :: (HasRequest env, MonadIO m, MonadReader env m) => T.Text -> T.Text -> m (APIResponse RegisterMessage) diff --git a/haskell/src/SpaceTraders/APIClient/Client.hs b/haskell/src/SpaceTraders/APIClient/Client.hs index 9229813..7f28fde 100644 --- a/haskell/src/SpaceTraders/APIClient/Client.hs +++ b/haskell/src/SpaceTraders/APIClient/Client.hs @@ -1,5 +1,5 @@ {-# LANGUAGE NumericUnderscores #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} module SpaceTraders.APIClient.Client ( APIMessage(..) @@ -11,27 +11,27 @@ module SpaceTraders.APIClient.Client , tokenReq ) where -import Control.Concurrent.Thread.Delay -import Control.Monad -import Control.Monad.Reader -import Data.Aeson -import Data.IORef -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import Network.HTTP.Simple -import Network.HTTP.Types.Status -import System.Directory -import System.Environment -import System.Posix.Process +import Control.Concurrent.Thread.Delay +import Control.Monad +import Control.Monad.Reader +import Data.Aeson +import Data.IORef +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Network.HTTP.Simple +import Network.HTTP.Types.Status +import System.Directory +import System.Environment +import System.Posix.Process -import SpaceTraders -import SpaceTraders.APIClient.Errors -import SpaceTraders.APIClient.Pagination -import SpaceTraders.Utils +import SpaceTraders +import SpaceTraders.APIClient.Errors +import SpaceTraders.APIClient.Pagination +import SpaceTraders.Utils -data FromJSON a => APIMessage a = APIMessage { messageData :: a - , messagePagination :: Maybe Pagination - } deriving (Show) +data APIMessage a = APIMessage { messageData :: a + , messagePagination :: Maybe Pagination + } deriving (Show) instance FromJSON a => FromJSON (APIMessage a) where parseJSON = withObject "APIMessage" $ \o -> APIMessage <$> o .: "data" @@ -45,7 +45,7 @@ defaultReq = setRequestHost "api.spacetraders.io" $ setRequestPort 443 $ setRequestSecure True $ setRequestHeader "Content-Type" ["application/json"] - $ defaultRequest + defaultRequest tokenReq :: T.Text -> Request tokenReq token = setRequestHeader "Authorization" [T.encodeUtf8 $ "Bearer " <> token] defaultReq @@ -54,7 +54,7 @@ send :: (FromJSON a, HasRequest env, MonadIO m, MonadReader env m) => (Request - send requestBuilder = do response <- sendPaginated Nothing requestBuilder case response of - Left e -> return $ Left e + Left e -> return $ Left e Right (APIMessage d _) -> return $ Right d sendPaginated :: (FromJSON a, HasRequest env, MonadIO m, MonadReader env m) => Maybe Pagination -> (Request -> Request) -> m (APIPaginatedResponse a) @@ -63,7 +63,7 @@ sendPaginated pagination requestBuilder = do let request = requestBuilder $ getRequest env request' = case pagination of Just myPage -> setRequestQueryString [("limit", Just . int2ByteString $ limit myPage), ("page", Just . int2ByteString $ page myPage)] - $ request + request Nothing -> request sendPaginated' request' where @@ -82,12 +82,12 @@ sendPaginated pagination requestBuilder = do 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 + Left e -> return . Left $ APIError (-1000) (T.pack $ "Error decoding JSON APIMessage: " ++ e) Null 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 - liftIO $ delay (1_000_000 * (round $ retryAfter r)) + liftIO $ delay (1_000_000 * round (retryAfter r)) sendPaginated' request Right (APIResetHappened _) -> liftIO $ do removeFile "spacetraders.db" diff --git a/haskell/src/SpaceTraders/APIClient/Contracts.hs b/haskell/src/SpaceTraders/APIClient/Contracts.hs index a62eb26..9c5bf02 100644 --- a/haskell/src/SpaceTraders/APIClient/Contracts.hs +++ b/haskell/src/SpaceTraders/APIClient/Contracts.hs @@ -1,18 +1,16 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} module SpaceTraders.APIClient.Contracts ( myContracts ) where -import Network.HTTP.Simple +import Network.HTTP.Simple -import SpaceTraders -import SpaceTraders.APIClient.Client -import SpaceTraders.APIClient.Pagination -import SpaceTraders.Database.Contracts -import SpaceTraders.Model.Contract(Contract) +import SpaceTraders +import SpaceTraders.APIClient.Client +import SpaceTraders.APIClient.Pagination +import SpaceTraders.Database.Contracts +import SpaceTraders.Model.Contract (Contract) myContracts :: SpaceTradersT (APIResponse [Contract]) myContracts = do @@ -25,6 +23,6 @@ myContracts = do Left e -> return $ Left e Right (APIMessage r (Just p')) -> do mapM_ setContract r - if (limit p' * page p' < total p') then listContracts' (nextPage p') + if limit p' * page p' < total p' then listContracts' (nextPage p') else Right <$> getContracts _ -> undefined diff --git a/haskell/src/SpaceTraders/APIClient/Errors.hs b/haskell/src/SpaceTraders/APIClient/Errors.hs index 2b74784..eb87daa 100644 --- a/haskell/src/SpaceTraders/APIClient/Errors.hs +++ b/haskell/src/SpaceTraders/APIClient/Errors.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} module SpaceTraders.APIClient.Errors @@ -8,11 +8,11 @@ module SpaceTraders.APIClient.Errors , ResetHappened(..) ) where -import Control.Exception -import Data.Aeson -import Data.Time -import qualified Data.Text as T -import GHC.Generics +import Control.Exception +import Data.Aeson +import qualified Data.Text as T +import Data.Time +import GHC.Generics data APIError = APIError Int T.Text Value | APIRateLimit RateLimit @@ -27,16 +27,15 @@ instance FromJSON APIError where case code of 401 -> APIResetHappened <$> parseJSON d 429 -> APIRateLimit <$> parseJSON d - _ -> APIError <$> pure code - <*> e .: "message" - <*> pure d + _ -> APIError code <$> e .: "message" + <*> pure d -data RateLimit = RateLimit { limitBurst :: Int +data RateLimit = RateLimit { limitBurst :: Int , limitPerSecond :: Int - , rateLimitType :: T.Text - , remaining :: Int - , reset :: UTCTime - , retryAfter :: Double + , rateLimitType :: T.Text + , remaining :: Int + , reset :: UTCTime + , retryAfter :: Double } deriving Show instance FromJSON RateLimit where parseJSON = withObject "RateLimit" $ \o -> @@ -47,6 +46,6 @@ instance FromJSON RateLimit where <*> o .: "reset" <*> o .: "retryAfter" -data ResetHappened = ResetHappened { actual :: T.Text +data ResetHappened = ResetHappened { actual :: T.Text , expected :: T.Text } deriving (FromJSON, Generic, Show, ToJSON) diff --git a/haskell/src/SpaceTraders/APIClient/Pagination.hs b/haskell/src/SpaceTraders/APIClient/Pagination.hs index bb9bcd1..e6a2d44 100644 --- a/haskell/src/SpaceTraders/APIClient/Pagination.hs +++ b/haskell/src/SpaceTraders/APIClient/Pagination.hs @@ -1,17 +1,16 @@ {-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric #-} module SpaceTraders.APIClient.Pagination ( Pagination(..) , nextPage ) where -import Data.Aeson -import GHC.Generics +import Data.Aeson +import GHC.Generics data Pagination = Pagination { limit :: Int - , page :: Int + , page :: Int , total :: Int } deriving (FromJSON, Generic, Show) diff --git a/haskell/src/SpaceTraders/APIClient/Ships.hs b/haskell/src/SpaceTraders/APIClient/Ships.hs index 87c5ecb..4ce9371 100644 --- a/haskell/src/SpaceTraders/APIClient/Ships.hs +++ b/haskell/src/SpaceTraders/APIClient/Ships.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} module SpaceTraders.APIClient.Ships @@ -8,19 +8,20 @@ module SpaceTraders.APIClient.Ships , orbit ) where -import Data.Aeson.Types -import qualified Data.Text.Encoding as T -import GHC.Generics -import Network.HTTP.Simple +import Data.Aeson.Types +import qualified Data.Text.Encoding as T +import GHC.Generics +import Network.HTTP.Simple -import SpaceTraders -import SpaceTraders.APIClient.Client -import SpaceTraders.APIClient.Pagination -import SpaceTraders.Database.Ships -import SpaceTraders.Model.Nav -import SpaceTraders.Model.Ship +import SpaceTraders +import SpaceTraders.APIClient.Client +import SpaceTraders.APIClient.Pagination +import SpaceTraders.Database.Ships +import SpaceTraders.Model.Nav +import SpaceTraders.Model.Ship + +newtype NavMessage = NavMessage { nav :: Nav } deriving (FromJSON, Generic, Show) -data NavMessage = NavMessage { nav :: Nav } deriving (FromJSON, Generic, Show) dock :: Ship -> SpaceTradersT (APIResponse Ship) dock ship = do resp <- send $ setRequestPath (T.encodeUtf8 $ mconcat ["/v2/my/ships/", symbol ship, "/dock"]) @@ -29,7 +30,7 @@ dock ship = do Left e -> return $ Left e Right (NavMessage n) -> do let s = ship{SpaceTraders.Model.Ship.nav=n} - updateShip s + setShip s return $ Right s myShips :: SpaceTradersT (APIResponse [Ship]) @@ -43,8 +44,8 @@ myShips = do Left e -> return $ Left e Right (APIMessage r (Just p')) -> do mapM_ setShip r - if (limit p' * page p' < total p') then listShips' (nextPage p') - else Right <$> getShips + if limit p' * page p' < total p' then listShips' (nextPage p') + else Right <$> getShips _ -> undefined orbit :: Ship -> SpaceTradersT (APIResponse Ship) @@ -55,5 +56,5 @@ orbit ship = do Left e -> return $ Left e Right (NavMessage n) -> do let s = ship{SpaceTraders.Model.Ship.nav=n} - updateShip s + setShip s return $ Right s diff --git a/haskell/src/SpaceTraders/APIClient/Systems.hs b/haskell/src/SpaceTraders/APIClient/Systems.hs index eb15b4d..e2690ac 100644 --- a/haskell/src/SpaceTraders/APIClient/Systems.hs +++ b/haskell/src/SpaceTraders/APIClient/Systems.hs @@ -1,24 +1,22 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} module SpaceTraders.APIClient.Systems ( initSystems ) where -import Control.Exception -import Network.HTTP.Simple +import Control.Exception +import Network.HTTP.Simple -import SpaceTraders -import SpaceTraders.APIClient.Client -import SpaceTraders.APIClient.Pagination -import SpaceTraders.Database.Systems -import SpaceTraders.Model.System(System) +import SpaceTraders +import SpaceTraders.APIClient.Client +import SpaceTraders.APIClient.Pagination +import SpaceTraders.Database.Systems +import SpaceTraders.Model.System (System) initSystems :: SpaceTradersT (APIResponse [System]) initSystems = do s <- getSystems - listSystems' Pagination{limit=20, page=((length s) `div` 20) + 1, total=0} + listSystems' Pagination{limit=20, page=(length s `div` 20) + 1, total=0} where listSystems' :: Pagination -> SpaceTradersT (APIResponse [System]) listSystems' p = do @@ -27,6 +25,6 @@ initSystems = do Left e -> throw e Right (APIMessage r (Just p')) -> do addSystems r - if (limit p' * page p' < total p') then listSystems' (nextPage p') - else Right <$> getSystems + if limit p' * page p' < total p' then listSystems' (nextPage p') + else Right <$> getSystems _ -> undefined |