strongswan-sql-1.0.0.0: app/Main.hs

{-# 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 <username>]\n\t[--ask-password | -a]\n\t[--host|-h <SQL server>]\n\t[--db | -d <DB name>]\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 }
        runCLI "strongswan SQL" def commands `evalStateT` state >>= hoist FatalError
          where mkContext' Options{..} = SQL.mkContext _settings
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