festung-0.9.1.1: prog/Main.hs

{-# LANGUAGE NamedFieldPuns #-}

module Main where

import Festung.Config
import Festung.Frontend           (App(App))
import Festung.Utils              (getVersion)
import Festung.Vault.VaultManager (newManager)
import System.Console.ArgParser
import Yesod                      (warp)


-- FIXME: We pass config all over the place. It looks like this could be a
--        monad to maintain state.
applicationRunner :: Config -> IO ()
applicationRunner config@Config { port } = do
    vaultManager <- newManager config
    warp port (App config vaultManager)


cmdLineInterface :: IO (CmdLnInterface Config)
cmdLineInterface =
    (`setAppDescr` "Remote SQLCipher server.") .
    (`setAppVersion` getVersion) <$>
    mkApp cmdLineParser
        where setAppVersion app v = app { getAppVersion = Just v }


toMicroSeconds :: Int -> Int
toMicroSeconds = (*) (1000 * 1000)


cmdLineParser :: ParserSpec Config
cmdLineParser = constructor
    `parsedBy` reqPos "data_directory" `Descr` "Location of the vaults"
    `andBy` optFlag 2728 "port"        `Descr` "API port"
    `andBy` optFlag 15   "timeout"     `Descr` "Vault timeout"
        where constructor dir port timeout = Config dir (toMicroSeconds timeout) port


main :: IO ()
main = cmdLineInterface >>= flip runApp applicationRunner