adyxax/spacetraders
1
0
Fork 0
Code Issues Activity

[haskell] implemented dock and orbit api calls

Browse source
This commit is contained in:
Julien Dessaux 2023-07-29 00:32:36 +02:00
parent 20d4381c9c
commit 961625c363
Signed by: adyxax
GPG key ID: F92E51B86E07177E
2 changed files with 35 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
haskell/app/Main.hs
View file

@ -9,6 +9,7 @@ import System.Posix.Process
import SpaceTraders
import SpaceTraders.Automation.Init
import SpaceTraders.APIClient.Errors
import SpaceTraders.APIClient.Ships
import SpaceTraders.APIClient.Systems
import SpaceTraders.Database.Agents
import SpaceTraders.Database.Contracts
@ -28,5 +29,7 @@ main = do
Left e -> throwIO e
Right s' -> print $ length s'
runSpaceTradersT getContracts env >>= print
runSpaceTradersT getShips env >>= print
ss <- runSpaceTradersT getShips env
runSpaceTradersT (dock $ head ss) env >>= print
runSpaceTradersT (orbit $ head ss) env >>= print
deinitST env

33
haskell/src/SpaceTraders/APIClient/Ships.hs
View file

@ -3,16 +3,34 @@
{-# LANGUAGE OverloadedStrings #-}
module SpaceTraders.APIClient.Ships
( myShips
( dock
, myShips
, orbit
) where
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.Ship(Ship)
import SpaceTraders.Model.Nav
import SpaceTraders.Model.Ship
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"])
. setRequestMethod "POST" :: SpaceTradersT (APIResponse NavMessage)
case resp of
Left e -> return $ Left e
Right (NavMessage n) -> do
let s = ship{SpaceTraders.Model.Ship.nav=n}
updateShip s Nothing
return $ Right s
myShips :: SpaceTradersT (APIResponse [Ship])
myShips = do
@ -28,3 +46,14 @@ myShips = do
if (limit p' * page p' < total p') then listShips' (nextPage p')
else Right <$> getShips
_ -> undefined
orbit :: Ship -> SpaceTradersT (APIResponse Ship)
orbit ship = do
resp <- send $ setRequestPath (T.encodeUtf8 $ mconcat ["/v2/my/ships/", symbol ship, "/orbit"])
. setRequestMethod "POST" :: SpaceTradersT (APIResponse NavMessage)
case resp of
Left e -> return $ Left e
Right (NavMessage n) -> do
let s = ship{SpaceTraders.Model.Ship.nav=n}
updateShip s Nothing
return $ Right s