summaryrefslogtreecommitdiff
path: root/haskell
diff options
context:
space:
mode:
Diffstat (limited to 'haskell')
-rw-r--r--haskell/app/Main.hs37
-rw-r--r--haskell/package.yaml4
-rw-r--r--haskell/src/SpaceTraders.hs23
-rw-r--r--haskell/src/SpaceTraders/APIClient/Agent.hs9
-rw-r--r--haskell/src/SpaceTraders/APIClient/Errors.hs10
-rw-r--r--haskell/src/SpaceTraders/Automation/Init.hs58
6 files changed, 110 insertions, 31 deletions
diff --git a/haskell/app/Main.hs b/haskell/app/Main.hs
index 38e6b0d..e22988c 100644
--- a/haskell/app/Main.hs
+++ b/haskell/app/Main.hs
@@ -3,36 +3,19 @@
module Main (main) where
import Control.Exception
-import qualified Database.SQLite.Simple as S
-import qualified Data.Text as T
-import SpaceTraders.APIClient.Agent
+import SpaceTraders
+import SpaceTraders.Automation.Init
+import SpaceTraders.APIClient.Agent(myAgent)
import SpaceTraders.APIClient.Systems
-import SpaceTraders.Database
-import SpaceTraders.Database.Agents
-import SpaceTraders.Database.Contracts
-import SpaceTraders.Database.Ships
-import SpaceTraders.Database.Tokens
main :: IO ()
main = do
- conn <- open
- t <- getToken conn `catch` registerNow conn
- ma <- myAgent t
+ config <- initST
+ ma <- runSpaceTradersT myAgent config
print ma
- s <- listSystems t conn
- print s
- close conn
- where
- registerNow :: S.Connection -> SomeException -> IO (T.Text)
- registerNow conn _ = do
- r <- register "ADYXAX" "COSMIC"
- case r of
- Right r' -> do
- setAgent conn $ agent r'
- addContract conn $ contract r'
- addShip conn $ ship r'
- let t = token r'
- setToken conn $ t
- return t
- Left e' -> throwIO e'
+ s <- listSystems (token config) (conn config)
+ case s of
+ Left e -> throwIO e
+ Right s' -> print $ length s'
+ deinitST config
diff --git a/haskell/package.yaml b/haskell/package.yaml
index c464ad9..567b06c 100644
--- a/haskell/package.yaml
+++ b/haskell/package.yaml
@@ -19,12 +19,14 @@ dependencies:
- aeson
- base >= 4.7 && < 5
- bytestring
+- directory
- http-conduit
- http-types
+- raw-strings-qq
- sqlite-simple
- text
- time
-- raw-strings-qq
+- transformers
ghc-options:
- -Wall
diff --git a/haskell/src/SpaceTraders.hs b/haskell/src/SpaceTraders.hs
new file mode 100644
index 0000000..d93116d
--- /dev/null
+++ b/haskell/src/SpaceTraders.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module SpaceTraders
+ ( SpaceTradersT
+ , runSpaceTradersT
+ , Config(..)
+ , ask
+ , liftIO
+ ) where
+
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Reader
+import qualified Database.SQLite.Simple as S
+import qualified Data.Text as T
+
+type SpaceTradersT a = ReaderT Config IO a
+
+runSpaceTradersT :: SpaceTradersT a -> Config -> IO a
+runSpaceTradersT = runReaderT
+
+data Config = Config { conn :: S.Connection
+ , token :: T.Text
+ }
diff --git a/haskell/src/SpaceTraders/APIClient/Agent.hs b/haskell/src/SpaceTraders/APIClient/Agent.hs
index 7773972..023a4f4 100644
--- a/haskell/src/SpaceTraders/APIClient/Agent.hs
+++ b/haskell/src/SpaceTraders/APIClient/Agent.hs
@@ -13,14 +13,17 @@ import GHC.Generics
import qualified Data.Text as T
import Network.HTTP.Simple
+import qualified SpaceTraders as ST
import SpaceTraders.APIClient.Client
import SpaceTraders.Model.Agent(Agent)
import SpaceTraders.Model.Ship(Ship)
import SpaceTraders.Model.Contract
-myAgent :: T.Text -> IO (APIResponse Agent)
-myAgent t = send $ setRequestPath "/v2/my/agent"
- $ tokenReq t
+myAgent :: ST.SpaceTradersT (APIResponse Agent)
+myAgent = do
+ c <- ST.ask
+ ST.liftIO $ send $ setRequestPath "/v2/my/agent"
+ $ tokenReq (ST.token c)
data RegisterRequest = RegisterRequest { faction :: T.Text
, symbol :: T.Text
diff --git a/haskell/src/SpaceTraders/APIClient/Errors.hs b/haskell/src/SpaceTraders/APIClient/Errors.hs
index a7f5d21..2b74784 100644
--- a/haskell/src/SpaceTraders/APIClient/Errors.hs
+++ b/haskell/src/SpaceTraders/APIClient/Errors.hs
@@ -1,17 +1,22 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module SpaceTraders.APIClient.Errors
( APIError(..)
, RateLimit(..)
+ , ResetHappened(..)
) where
import Control.Exception
import Data.Aeson
import Data.Time
import qualified Data.Text as T
+import GHC.Generics
data APIError = APIError Int T.Text Value
| APIRateLimit RateLimit
+ | APIResetHappened ResetHappened
deriving Show
instance Exception APIError
instance FromJSON APIError where
@@ -20,6 +25,7 @@ instance FromJSON APIError where
code <- e .: "code"
d <- e .: "data"
case code of
+ 401 -> APIResetHappened <$> parseJSON d
429 -> APIRateLimit <$> parseJSON d
_ -> APIError <$> pure code
<*> e .: "message"
@@ -40,3 +46,7 @@ instance FromJSON RateLimit where
<*> o .: "remaining"
<*> o .: "reset"
<*> o .: "retryAfter"
+
+data ResetHappened = ResetHappened { actual :: T.Text
+ , expected :: T.Text
+ } deriving (FromJSON, Generic, Show, ToJSON)
diff --git a/haskell/src/SpaceTraders/Automation/Init.hs b/haskell/src/SpaceTraders/Automation/Init.hs
new file mode 100644
index 0000000..8e90fca
--- /dev/null
+++ b/haskell/src/SpaceTraders/Automation/Init.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module SpaceTraders.Automation.Init
+ ( deinitST
+ , initST
+ ) where
+
+import Control.Exception
+import qualified Database.SQLite.Simple as S
+import qualified Data.Text as T
+import System.Directory
+
+import SpaceTraders
+import qualified SpaceTraders.APIClient.Agent as STAA
+import SpaceTraders.APIClient.Errors
+import SpaceTraders.Database
+import SpaceTraders.Database.Agents
+import SpaceTraders.Database.Contracts
+import SpaceTraders.Database.Ships
+import SpaceTraders.Database.Tokens
+
+deinitST :: Config -> IO ()
+deinitST config = do
+ close $ conn config
+
+initST :: IO Config
+initST = do
+ c <- open
+ t <- getToken c `catch` handleNoToken c
+ ma <- runSpaceTradersT STAA.myAgent (Config c t)
+ case ma of
+ Left (APIResetHappened _) -> wipe c
+ Left e -> throwIO e
+ _ -> return $ Config c t
+ where
+ handleNoToken :: S.Connection -> SomeException -> IO T.Text
+ handleNoToken c _ = register c
+
+register :: S.Connection -> IO (T.Text)
+register c = do
+ r <- STAA.register "ADYXAX" "COSMIC"
+ case r of
+ Right r' -> do
+ setAgent c $ STAA.agent r'
+ addContract c $ STAA.contract r'
+ addShip c $ STAA.ship r'
+ let t = STAA.token r'
+ setToken c $ t
+ return t
+ Left e' -> throwIO e'
+
+wipe :: S.Connection -> IO Config
+wipe c = do
+ close c
+ removeFile "spacetraders.db"
+ conn' <- open
+ t <- register conn'
+ return $ Config conn' t
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-22 05:04:57 +0000