blob: 5c70a1dca0914e1b737c714f632ab1252d49b785 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
{-# LANGUAGE OverloadedStrings #-}
module SpaceTraders.Automation.Init
( deinitST
, initST
) where
import Control.Exception
import Control.Monad.Reader
import qualified Database.SQLite.Simple as S
import qualified Data.Text as T
import System.Directory
import SpaceTraders
import SpaceTraders.APIClient.Agent
import SpaceTraders.APIClient.Client
import SpaceTraders.APIClient.Contracts
import SpaceTraders.APIClient.Errors
import SpaceTraders.APIClient.Ships
import SpaceTraders.Database
import SpaceTraders.Database.Agents
import SpaceTraders.Database.Contracts
import SpaceTraders.Database.Tokens
deinitST :: Env -> IO ()
deinitST env = do
close $ getConn env
initST :: IO Env
initST = do
conn <- open
t <- runReaderT getToken conn `catch` handleNoToken conn
env <- newEnv conn (tokenReq t)
ma <- runReaderT getAgent conn -- We compare the agent state in the database
ma' <- runSpaceTradersT myAgent env -- with the one on the servers
case ma' of
Left (APIResetHappened _) -> wipe conn
Left e -> throwIO e
Right ma'' -> do
when (ma /= ma'') $ do
_ <- runReaderT myContracts env -- refresh contracts
_ <- runReaderT myShips env -- refresh ships
runReaderT (setAgent ma'') conn -- store the fresh agent state
return $ env
where
handleNoToken :: S.Connection -> SomeException -> IO T.Text
handleNoToken conn _ = newEnv conn defaultReq >>= runReaderT registerST
registerST :: SpaceTradersT (T.Text)
registerST = do
r <- register "ADYXAX" "COSMIC"
case r of
Right r' -> do
addAgent $ agent r'
addContract $ contract r'
_ <- myShips -- in order to fetch the starting probe that is not advertised in the register message
let t = token r'
addToken t
return t
Left e' -> throw e'
wipe :: S.Connection -> IO Env
wipe c = do
close c
removeFile "spacetraders.db"
conn' <- open
t <- newEnv conn' defaultReq >>= runReaderT registerST
newEnv conn' (tokenReq t)
|
