From 961625c363193905e58221bdc895a19f9f153cce Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Sat, 29 Jul 2023 00:32:36 +0200
Subject: [haskell] implemented dock and orbit api calls

---
 haskell/app/Main.hs                         |  5 ++++-
 haskell/src/SpaceTraders/APIClient/Ships.hs | 33 +++++++++++++++++++++++++++--
 2 files changed, 35 insertions(+), 3 deletions(-)

diff --git a/haskell/app/Main.hs b/haskell/app/Main.hs
index 85b07da..a7774e5 100644
--- a/haskell/app/Main.hs
+++ b/haskell/app/Main.hs
@@ -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
diff --git a/haskell/src/SpaceTraders/APIClient/Ships.hs b/haskell/src/SpaceTraders/APIClient/Ships.hs
index e2cf15c..f4b7290 100644
--- a/haskell/src/SpaceTraders/APIClient/Ships.hs
+++ b/haskell/src/SpaceTraders/APIClient/Ships.hs
@@ -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
-- 
cgit v1.2.3