115 lines
2.9 KiB
Haskell
115 lines
2.9 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
|
|
module Main where
|
|
|
|
import Soostone ( app, middleWare, AppState(AppState, sqliteFile, stmMap) )
|
|
|
|
import Control.Monad ( void, when )
|
|
import Data.Version (showVersion)
|
|
import Database.SQLite.Simple ( execute_, open, Connection )
|
|
import Network.Wai.Handler.Warp ( run )
|
|
import Options.Applicative
|
|
( fullDesc,
|
|
execParser,
|
|
progDesc,
|
|
helper,
|
|
(<**>),
|
|
info,
|
|
command,
|
|
subparser,
|
|
strOption,
|
|
value,
|
|
showDefault,
|
|
metavar,
|
|
eitherReader,
|
|
option,
|
|
hidden,
|
|
help,
|
|
long,
|
|
infoOption,
|
|
Parser )
|
|
import Paths_soostone ( version )
|
|
import Prometheus ( register )
|
|
import Prometheus.Metric.GHC ( ghcMetrics )
|
|
import Prometheus.Metric.Proc ( procMetrics )
|
|
import Text.Read ( readEither )
|
|
import qualified StmContainers.Map as SM
|
|
|
|
|
|
versioner :: Parser (a -> a)
|
|
versioner = infoOption (showVersion version) (long "version" <> help "Show version" <> hidden)
|
|
|
|
data Command = Run ServerConfig
|
|
| Create ServerConfig
|
|
|
|
data Config = Config {
|
|
serverCommand :: Command
|
|
}
|
|
|
|
parseConfig :: Parser Config
|
|
parseConfig = Config <$> parseCommands
|
|
|
|
data ServerConfig = ServerConfig {
|
|
serverPort :: Int
|
|
, sqliteDB :: FilePath
|
|
}
|
|
|
|
parseServerConf :: Parser ServerConfig
|
|
parseServerConf = ServerConfig
|
|
<$> option
|
|
(eitherReader (readEither @Int))
|
|
(long "server-port" <> metavar "SERVER_PORT" <> help
|
|
"Port to use for the REST server"
|
|
<> showDefault
|
|
<> value 9000
|
|
)
|
|
<*> strOption
|
|
( long "sqlite-db"
|
|
<> metavar "SQLITE_DB"
|
|
<> help "SQLite relation/database"
|
|
<> showDefault
|
|
<> value "soostone.sqlite3"
|
|
)
|
|
|
|
parseCommands :: Parser Command
|
|
parseCommands = subparser $
|
|
command
|
|
"run"
|
|
(info
|
|
(Run <$> parseServerConf <**> helper)
|
|
( progDesc "Run the REST API webserver"
|
|
)
|
|
)
|
|
<>
|
|
command
|
|
"create-tables"
|
|
(info
|
|
(Create <$> parseServerConf <**> helper)
|
|
( progDesc "Create the database"
|
|
)
|
|
)
|
|
|
|
|
|
main :: IO ()
|
|
main = do
|
|
Config{ .. } <-
|
|
execParser (info (parseConfig <**> helper <**> versioner) (fullDesc <> progDesc "Soostone"))
|
|
|
|
case serverCommand of
|
|
Run ServerConfig{..} -> do
|
|
when (sqliteDB == ":memory:") $ fail "In-memory DB is not supported!"
|
|
m <- SM.newIO
|
|
let appState = AppState { sqliteFile = sqliteDB, stmMap = m }
|
|
void $ register ghcMetrics
|
|
void $ register procMetrics
|
|
run serverPort (middleWare $ app appState)
|
|
Create ServerConfig{..} -> do
|
|
when (sqliteDB == ":memory:") $ fail "In-memory DB is not supported!"
|
|
con <- open sqliteDB
|
|
createTables con
|
|
where
|
|
createTables :: Connection -> IO ()
|
|
createTables con = do
|
|
execute_ con "CREATE TABLE IF NOT EXISTS keys (id INTEGER PRIMARY KEY, key TEXT, count INTEGER)"
|