{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

module Main
  ( main
  ) where

import           Control.Monad                   (when)
import           Control.Monad.IO.Class          (liftIO)
import qualified Data.ByteString.Char8           as B (pack)
import qualified Data.ByteString.Lazy            as LB (empty, fromStrict,
                                                        toStrict)
import           Data.Default.Class              (def)
import           Data.List                       (isPrefixOf)
import           Data.Maybe                      (fromMaybe)
import           Data.Streaming.Network.Internal (HostPreference (Host))
import           Data.String                     (fromString)
import           Metro.Class                     (Transport)
import           Metro.Socket                    (getHost, getService)
import           Metro.TP.Socket                 (socket)
import           Metro.TP.TLS                    (makeClientParams', tlsConfig)
import           Metro.TP.WebSockets             (clientConfig)
import           Metro.TP.XOR                    (xorConfig)
import           Network.HTTP.Types              (status204, status500)
import           Network.Wai.Handler.Warp        (setHost, setPort)
import           Periodic.Trans.ClientPool
import           Periodic.Types.Job
import           System.Environment              (getArgs, lookupEnv)
import           System.Exit                     (exitSuccess)
import           Web.Scotty                      (ActionM, ScottyM, body, get,
                                                  param, post, raw, rescue,
                                                  scottyOpts, settings)
import qualified Web.Scotty                      as WS (status)


data Options = Options
    { host     :: String
    , xorFile  :: FilePath
    , useTls   :: Bool
    , useWs    :: Bool
    , hostName :: String
    , certKey  :: FilePath
    , cert     :: FilePath
    , caStore  :: FilePath
    , httpHost :: String
    , httpPort :: Int
    , poolSize :: Int
    , showHelp :: Bool
    }

options :: Maybe String -> Maybe String -> Options
options h f = Options
  { host     = fromMaybe "unix:///tmp/periodic.sock" h
  , xorFile  = fromMaybe "" f
  , useTls   = False
  , useWs    = False
  , hostName = "localhost"
  , certKey  = "client-key.pem"
  , cert     = "client.pem"
  , caStore  = "ca.pem"
  , httpHost = "127.0.0.1"
  , httpPort = 8080
  , poolSize = 10
  , showHelp  = False
  }

parseOptions :: [String] -> Options -> Options
parseOptions []                   opt = opt
parseOptions ("-H":x:xs)          opt = parseOptions xs opt { host = x }
parseOptions ("--host":x:xs)      opt = parseOptions xs opt { host = x }
parseOptions ("--xor":x:xs)       opt = parseOptions xs opt { xorFile = x }
parseOptions ("--tls":xs)         opt = parseOptions xs opt { useTls = True }
parseOptions ("--ws":xs)          opt = parseOptions xs opt { useWs = True }
parseOptions ("--hostname":x:xs)  opt = parseOptions xs opt { hostName = x }
parseOptions ("--cert-key":x:xs)  opt = parseOptions xs opt { certKey = x }
parseOptions ("--cert":x:xs)      opt = parseOptions xs opt { cert = x }
parseOptions ("--ca":x:xs)        opt = parseOptions xs opt { caStore = x }
parseOptions ("--http-host":x:xs) opt = parseOptions xs opt { httpHost = x }
parseOptions ("--http-port":x:xs) opt = parseOptions xs opt { httpPort = read x }
parseOptions ("--pool-size":x:xs) opt = parseOptions xs opt { poolSize = read x }
parseOptions ("--help":xs)        opt = parseOptions xs opt { showHelp = True }
parseOptions ("-h":xs)            opt = parseOptions xs opt { showHelp = True }
parseOptions (_:xs)               opt = parseOptions xs opt

printHelp :: IO ()
printHelp = do
  putStrLn "periodic-http-bridge - Periodic task system client http bridge"
  putStrLn ""
  putStrLn "Usage: periodic [--host|-H HOST] [--http-host HOST] [--http-port PORT] [--pool-size SIZE] [--xor FILE|--ws|--tls [--hostname HOSTNAME] [--cert-key FILE] [--cert FILE] [--ca FILE]]"
  putStrLn ""
  putStrLn "Available options:"
  putStrLn "  -H --host      Socket path [$PERIODIC_PORT]"
  putStrLn "                 eg: tcp://:5000 (optional: unix:///tmp/periodic.sock) "
  putStrLn "     --xor       XOR Transport encode file [$XOR_FILE]"
  putStrLn "     --tls       Use tls transport"
  putStrLn "     --ws        Use websockets transport"
  putStrLn "     --hostname  Host name"
  putStrLn "     --cert-key  Private key associated"
  putStrLn "     --cert      Public certificate (X.509 format)"
  putStrLn "     --ca        trusted certificates"
  putStrLn "     --http-host HTTP host (optional: 127.0.0.1)"
  putStrLn "     --http-port HTTP port (optional: 8080)"
  putStrLn "     --pool-size Connection pool size"
  putStrLn "  -h --help       Display help message"
  putStrLn ""
  putStrLn "Version: v1.1.7.1"
  putStrLn ""
  exitSuccess

main :: IO ()
main = do
  h <- lookupEnv "PERIODIC_PORT"
  f <- lookupEnv "XOR_FILE"

  opts@Options{..} <- flip parseOptions (options h f) <$> getArgs

  when showHelp printHelp

  when (not ("tcp" `isPrefixOf` host) && not ("unix" `isPrefixOf` host)) $ do
    putStrLn $ "Invalid host " ++ host
    printHelp

  run opts def
    { settings = setPort httpPort
               $ setHost (Host httpHost) (settings def)}

run Options {useTls = True, ..} sopts = do
  prms <- makeClientParams' cert [] certKey caStore (hostName, B.pack $ fromMaybe "" $ getService host)
  clientEnv <- openPool (tlsConfig prms (socket host)) poolSize
  scottyOpts sopts $ application clientEnv

run Options {useWs = True, ..} sopts = do
  clientEnv <- openPool (clientConfig (socket host) (fromMaybe "0.0.0.0" $ getHost host) (fromMaybe "" $ getService host)) poolSize
  scottyOpts sopts $ application clientEnv

run Options {xorFile = "", ..} sopts = do
  clientEnv <- openPool (socket host) poolSize
  scottyOpts sopts $ application clientEnv

run Options {..} sopts = do
  clientEnv <- openPool (xorConfig xorFile $ socket host) poolSize
  scottyOpts sopts $ application clientEnv

application :: Transport tp => ClientPoolEnv tp ->  ScottyM ()
application clientEnv = do
  get "/periodic/status/" $ statusHandler clientEnv
  post "/periodic/submit/:func_name/:job_name/" $ submitJobHandler clientEnv
  post "/periodic/run/:func_name/:job_name/" $ runJobHandler clientEnv
  post "/periodic/remove/:func_name/:job_name/" $ removeJobHandler clientEnv
  post "/periodic/drop/:func_name/" $ dropFuncHandler clientEnv

paramJob :: ActionM (FuncName, JobName)
paramJob = do
  fn <- fromString <$> param "func_name"
  jn <- fromString <$> param "job_name"
  return (fn, jn)

paramJob_ :: ActionM Job
paramJob_ = do
  (fn, jn) <- paramJob
  schedAt <- param "sched_at" `rescue` const (return 0)
  timeout <- param "timeout" `rescue` const (return 0)
  wb <- Workload . LB.toStrict <$> body
  pure $ setSchedAt schedAt $ setTimeout timeout $ setWorkload wb $ initJob fn jn

sampleRet :: Bool -> ActionM ()
sampleRet r = do
  WS.status $ if r then status204 else status500
  raw LB.empty

submitJobHandler :: Transport tp => ClientPoolEnv tp -> ActionM ()
submitJobHandler clientEnv = do
  job <- paramJob_
  r <- liftIO $ runClientPoolT clientEnv $ submitJob_ job
  sampleRet r

removeJobHandler :: Transport tp => ClientPoolEnv tp -> ActionM ()
removeJobHandler clientEnv = do
  (fn, jn) <- paramJob
  r <- liftIO $ runClientPoolT clientEnv $ removeJob fn jn
  sampleRet r

runJobHandler :: Transport tp => ClientPoolEnv tp -> ActionM ()
runJobHandler clientEnv = do
  job <- paramJob_
  r <- liftIO $ runClientPoolT clientEnv $ runJob_ job
  case r of
    Nothing -> do
      WS.status status500
      raw "error"
    Just bs -> raw $ LB.fromStrict bs

dropFuncHandler :: Transport tp => ClientPoolEnv tp -> ActionM ()
dropFuncHandler clientEnv = do
  fn <- fromString <$> param "func_name"
  r <- liftIO $ runClientPoolT clientEnv $ dropFunc fn
  sampleRet r

statusHandler :: Transport tp => ClientPoolEnv tp -> ActionM ()
statusHandler clientEnv = do
  r <- liftIO $ runClientPoolT clientEnv status
  raw $ LB.fromStrict r