2024-05-22 03:27:21 +03:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
|
2024-04-25 23:11:11 +03:00
|
|
|
-- |
|
|
|
|
-- SPDX-License-Identifier: BSD-3-Clause
|
|
|
|
module Main where
|
|
|
|
|
|
|
|
import Control.Monad.Trans.Reader (runReaderT)
|
|
|
|
import Data.Maybe (fromMaybe)
|
2024-05-22 03:27:21 +03:00
|
|
|
import Data.Yaml (decodeFileThrow)
|
|
|
|
import Database.SQLite.Simple (execute_, withConnection)
|
2024-04-25 23:11:11 +03:00
|
|
|
import Network.Wai.Handler.Warp (Port)
|
|
|
|
import Options.Applicative
|
|
|
|
import Swarm.Game.State (Sha1 (..))
|
|
|
|
import Swarm.Web.Tournament
|
|
|
|
import Swarm.Web.Tournament.Database.Query
|
2024-05-22 03:27:21 +03:00
|
|
|
import Swarm.Web.Tournament.Type (UserAlias (..))
|
2024-04-25 23:11:11 +03:00
|
|
|
|
|
|
|
data AppOpts = AppOpts
|
|
|
|
{ userWebPort :: Maybe Port
|
|
|
|
-- ^ Explicit port on which to run the web API
|
|
|
|
, gameGitVersion :: Sha1
|
2024-05-22 03:27:21 +03:00
|
|
|
, deploymentEnv :: DeploymentEnvironment
|
2024-04-25 23:11:11 +03:00
|
|
|
}
|
|
|
|
|
|
|
|
webPort :: Parser (Maybe Int)
|
|
|
|
webPort =
|
|
|
|
optional $
|
|
|
|
option
|
|
|
|
auto
|
|
|
|
( long "port"
|
|
|
|
<> metavar "PORT"
|
|
|
|
<> help ("Set the web service port (or disable it with 0). Default to " <> show defaultPort <> ".")
|
|
|
|
)
|
|
|
|
|
|
|
|
gameVersion :: Parser Sha1
|
|
|
|
gameVersion =
|
|
|
|
Sha1
|
|
|
|
<$> option
|
|
|
|
str
|
|
|
|
( long "version"
|
|
|
|
<> metavar "VERSION"
|
|
|
|
<> help "Set the git version of the game"
|
|
|
|
)
|
|
|
|
|
2024-05-22 03:27:21 +03:00
|
|
|
parseRunningLocally :: Parser DeploymentEnvironment
|
|
|
|
parseRunningLocally =
|
|
|
|
flag
|
|
|
|
ProdDeployment
|
|
|
|
(LocalDevelopment $ UserAlias "local-user")
|
|
|
|
(long "local" <> help "Running locally for development")
|
2024-04-25 23:11:11 +03:00
|
|
|
|
|
|
|
cliParser :: Parser AppOpts
|
2024-05-22 03:27:21 +03:00
|
|
|
cliParser = AppOpts <$> webPort <*> gameVersion <*> parseRunningLocally
|
2024-04-25 23:11:11 +03:00
|
|
|
|
|
|
|
cliInfo :: ParserInfo AppOpts
|
|
|
|
cliInfo =
|
|
|
|
info
|
|
|
|
(cliParser <**> helper)
|
|
|
|
( header "Swarm tournament"
|
|
|
|
<> progDesc "Hosts a tournament server."
|
|
|
|
<> fullDesc
|
|
|
|
)
|
|
|
|
|
|
|
|
main :: IO ()
|
|
|
|
main = do
|
|
|
|
opts <- execParser cliInfo
|
2024-05-22 03:27:21 +03:00
|
|
|
|
|
|
|
creds <- case deploymentEnv opts of
|
|
|
|
LocalDevelopment _ -> return $ GitHubCredentials "" ""
|
|
|
|
ProdDeployment -> decodeFileThrow "swarm-github-app-credentials.yaml"
|
|
|
|
|
2024-04-25 23:11:11 +03:00
|
|
|
webMain
|
2024-05-22 03:27:21 +03:00
|
|
|
(AppData (gameGitVersion opts) creds persistenceFunctions (deploymentEnv opts))
|
2024-04-25 23:11:11 +03:00
|
|
|
(fromMaybe defaultPort $ userWebPort opts)
|
|
|
|
where
|
2024-05-12 23:45:08 +03:00
|
|
|
persistenceFunctions =
|
2024-04-25 23:11:11 +03:00
|
|
|
PersistenceLayer
|
2024-05-22 03:27:21 +03:00
|
|
|
{ scenarioStorage =
|
2024-04-25 23:11:11 +03:00
|
|
|
ScenarioPersistence
|
2024-05-22 03:27:21 +03:00
|
|
|
{ lookupCache = withConn lookupScenarioSolution
|
|
|
|
, storeCache = withConn insertScenario
|
|
|
|
, getContent = withConn lookupScenarioContent
|
2024-04-25 23:11:11 +03:00
|
|
|
}
|
|
|
|
, solutionStorage =
|
|
|
|
ScenarioPersistence
|
2024-05-22 03:27:21 +03:00
|
|
|
{ lookupCache = withConn lookupSolutionSubmission
|
|
|
|
, storeCache = withConn insertSolutionSubmission
|
|
|
|
, getContent = withConn lookupSolutionContent
|
|
|
|
}
|
|
|
|
, authenticationStorage =
|
|
|
|
AuthenticationStorage
|
|
|
|
{ usernameFromCookie = withConn getUsernameFromCookie
|
|
|
|
, cookieFromUsername = withConn insertCookie
|
2024-04-25 23:11:11 +03:00
|
|
|
}
|
|
|
|
}
|
|
|
|
where
|
2024-05-22 03:27:21 +03:00
|
|
|
withConn f x =
|
|
|
|
withConnection databaseFilename $ \conn -> do
|
|
|
|
execute_ conn "PRAGMA foreign_keys = ON;"
|
|
|
|
runReaderT (f x) conn
|