summaryrefslogtreecommitdiff
path: root/haskell/src/SpaceTraders/APIClient
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--haskell/src/SpaceTraders/APIClient/Agent.hs39
-rw-r--r--haskell/src/SpaceTraders/APIClient/Client.hs50
-rw-r--r--haskell/src/SpaceTraders/APIClient/Contracts.hs16
-rw-r--r--haskell/src/SpaceTraders/APIClient/Errors.hs31
-rw-r--r--haskell/src/SpaceTraders/APIClient/Pagination.hs9
-rw-r--r--haskell/src/SpaceTraders/APIClient/Ships.hs35
-rw-r--r--haskell/src/SpaceTraders/APIClient/Systems.hs22
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-27 03:47:12 +0000