-- | @todo-haskell --socket <path> --db <path>@ on Carloku, or
-- @todo-haskell --listen 127.0.0.1:<port> --db <path>@ locally.
module Main (main) where

import Control.Exception (bracket, catch, throwIO)
import Control.Monad (forM_, unless)
import Data.ByteString.Char8 qualified as B8
import Data.Text qualified as T
import Data.Word (Word8)
import Network.Socket
import Network.Wai.Handler.Warp
import System.Environment (getArgs, lookupEnv)
import System.Exit (exitWith, ExitCode (..))
import System.IO (hPutStrLn, stderr)
import System.IO.Error (isDoesNotExistError)
import System.Posix.Files (removeLink)
import System.Posix.Signals (Handler (CatchOnce), installHandler, sigINT, sigTERM)
import Text.Read (readMaybe)

import Todo.App
import Todo.Db qualified as Db

data Bind
  = UnixSocket FilePath
  | Loopback (Word8, Word8, Word8, Word8) PortNumber

data Options = Options
  { optBind :: Maybe Bind
  , optDb :: Maybe FilePath
  }

main :: IO ()
main = do
  args <- getArgs
  (target, dbPath) <- case parseArgs args (Options Nothing Nothing) of
    Right (Options (Just b) (Just d)) -> pure (b, d)
    Right _ -> usage "both --db and one of --socket or --listen are required"
    Left err -> usage err
  host <- lookupEnv "CARLOS_HOST"
  let config = case target of
        -- On Carloku the edge serves https://$CARLOS_HOST.
        UnixSocket _ -> Config (B8.pack . ("https://" <>) <$> host) True
        Loopback addr port -> Config (Just (B8.pack ("http://" <> showAddr addr port))) False
  bracket (Db.open dbPath) Db.close $ \db ->
    bracket (listenOn target) (cleanUp target) $ \sock -> do
      hPutStrLn stderr ("todo-haskell " <> T.unpack version <> " listening on " <> describe target)
      runSettingsSocket settings sock (app config db)
  hPutStrLn stderr "todo-haskell stopped"

-- | Warp closes the listening socket on SIGTERM or SIGINT, lets requests
-- in flight finish (for up to five seconds), and then 'runSettingsSocket'
-- returns, so 'main' closes the database and exits 0.
settings :: Settings
settings =
  setInstallShutdownHandler onSignal
    . setGracefulShutdownTimeout (Just 5)
    $ defaultSettings
  where
    onSignal closeSocket =
      forM_ [sigTERM, sigINT] $ \sig -> installHandler sig (CatchOnce closeSocket) Nothing

listenOn :: Bind -> IO Socket
listenOn = \case
  UnixSocket path -> do
    removeIfExists path
    sock <- socket AF_UNIX Stream defaultProtocol
    bind sock (SockAddrUnix path)
    listen sock 1024
    pure sock
  Loopback addr port -> do
    sock <- socket AF_INET Stream defaultProtocol
    setSocketOption sock ReuseAddr 1
    bind sock (SockAddrInet port (tupleToHostAddress addr))
    listen sock 1024
    pure sock

cleanUp :: Bind -> Socket -> IO ()
cleanUp target sock = do
  close sock
  case target of
    UnixSocket path -> removeIfExists path
    Loopback _ _ -> pure ()

removeIfExists :: FilePath -> IO ()
removeIfExists path = removeLink path `catch` \e -> unless (isDoesNotExistError e) (throwIO e)

parseArgs :: [String] -> Options -> Either String Options
parseArgs args o = case args of
  [] -> Right o
  "--socket" : path : rest -> parseArgs rest o {optBind = Just (UnixSocket path)}
  "--listen" : addr : rest -> do
    b <- parseListen addr
    parseArgs rest o {optBind = Just b}
  "--db" : path : rest -> parseArgs rest o {optDb = Just path}
  flag : _ -> Left ("unexpected argument " <> show flag)

-- | Only 127.0.0.1: this app never listens anywhere else.
parseListen :: String -> Either String Bind
parseListen s = case break (== ':') s of
  ("127.0.0.1", ':' : portText)
    | Just port <- readMaybe portText
    , port > 0 && port < (65536 :: Int) ->
        Right (Loopback (127, 0, 0, 1) (fromIntegral port))
  _ -> Left ("--listen wants 127.0.0.1:<port>, not " <> show s)

showAddr :: (Word8, Word8, Word8, Word8) -> PortNumber -> String
showAddr (a, b, c, d) port = concat [show a, ".", show b, ".", show c, ".", show d, ":", show port]

describe :: Bind -> String
describe = \case
  UnixSocket path -> path
  Loopback addr port -> showAddr addr port

usage :: String -> IO a
usage err = do
  hPutStrLn stderr ("todo-haskell: " <> err)
  hPutStrLn stderr "usage: todo-haskell (--socket <path> | --listen 127.0.0.1:<port>) --db <path>"
  exitWith (ExitFailure 2)