{-# LANGUAGE OverloadedStrings #-} module Main where import Control.Applicative ((<|>)) import Control.Lens ((.=), (.~), (%=), (&), set) import Control.Monad (void) import Control.Monad.Failable import Control.Monad.State.Strict (evalStateT, execStateT, lift, modify) import CLI.Types import CLI.Commands import Data.Char (isSpace) import Data.Default (def) import Data.List (unwords) import Data.Text (Text, pack, unpack) import System.Console.Haskeline (defaultSettings, getPassword, runInputT) import System.Console.StructuredCLI hiding (Commands) import System.Environment (getArgs) import StrongSwan.SQL hiding (Settings) import qualified Data.Attoparsec.Text as A import qualified StrongSwan.SQL as SQL usage :: IO () usage = putStrLn "Usage: strongswan-sql\n\t[--user|-u ]\n\t[--ask-password | -a]\n\t[--host|-h ]\n\t[--db | -d ]\n\t[--help | -?]" main :: IO () main = do args <- pack . unwords <$> getArgs opt@Options{..} <- hoist BadArguments $ A.parseOnly (execStateT arguments def) args password <- if _askPassword then runInputT defaultSettings $ getPassword (Just '*') "Password: " else return Nothing if _requestedHelp then usage else if _badInput /= "" then do putStrLn $ "Bad arguments at or around " ++ unpack _badInput usage else do let options' = maybe opt (\s -> opt & settings . dbPassword .~ s) password db <- mkContext' options' let state = AppState { _options = options', _dbContext = db, _ipsecSettings = def, _flush = Nothing, _identity = def, _secretStr = "" } runCLI "strongswan SQL" cliSettings commands `evalStateT` state >>= hoist FatalError where mkContext' Options{..} = SQL.mkContext _settings cliSettings = def { getHistory = Just ".strongswan-sql.history" } modifySettings :: (SQL.Settings -> SQL.Settings) -> ArgsParser () modifySettings = (settings %=) arguments :: ArgsParser () arguments = do void . A.many' $ userOption <|> dbOption <|> withPasswordOption <|> hostOption <|> helpOption remaining <- lift A.takeText badInput .= remaining option0' :: Text -> Text -> (Options -> Options) -> ArgsParser () option0' long short f = lift (A.skipSpace *> (A.string long <|> A.string short)) *> modify f option1 :: Text -> Text -> (Text -> SQL.Settings -> SQL.Settings) -> ArgsParser () option1 long short f = do val <- lift $ A.skipSpace *> keyword *> A.skipSpace *> A.takeWhile (not . isSpace) modifySettings $ f val where keyword = A.string long <|> A.string short userOption :: ArgsParser () userOption = option1 "--user" "-u" $ set dbUser . unpack dbOption :: ArgsParser () dbOption = option1 "--db" "-d" $ set dbName . unpack hostOption :: ArgsParser () hostOption = option1 "--host" "-h" $ set dbHost . unpack withPasswordOption :: ArgsParser () withPasswordOption = option0' "--ask-password" "-a" $ set askPassword True helpOption :: ArgsParser () helpOption = option0' "--help" "-?" $ set requestedHelp True