-- SPDX-License-Identifier: Apache-2.0

module Main (main) where

import Control.Monad.Extra (unless, when)
import Data.Maybe (fromMaybe)
import SimpleCmd (cmd_, cmdBool, cmdFull, cmdLines, cmdN, warning, (+-+))
import SimpleCmdArgs
import System.IO (BufferMode(NoBuffering), hSetBuffering, stdout)

import Backup
import Config
import Error
import Paths_encapsule (version)
import qualified Run
import Run hiding (RunOpts(..))

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  simpleCmdArgs (Just version)
    progname
    ("Run a toolbox image in an isolated podman container" +-+
     "https://github.com/juhp/encapsule#readme") $
    subcommands
    -- FIXME add/separate: create/enter/run
    [ Subcommand "list" "List encapsule images and containers" $
      pure listCmd
    , Subcommand "list-caps" "List available capabilities" $
      pure listCapsCmd
    , Subcommand "rm" "Remove an encapsule container" $
      removeCmd
      <$> strArg "TOOLBOX"
      <*> optional projectNameOpt
    , Subcommand "rmi" "Remove an encapsule image" $
      removeImageCmd
      <$> dryrunOpt
      <*> strArg "TOOLBOX"
    , Subcommand "stop" "Stop an encapsule container" $
      stopCmd
      <$> strArg "TOOLBOX"
      <*> optional projectNameOpt
    , Subcommand "backup" "Create a tarball backup of a directory" $
      backupCmd
      <$> dryrunOpt
      <*> switchWith 'y' "yes" "Don't prompt for large directories"
      <*> optional (strOptionWith 'o' "output" "FILE" "Output tarball (default: DIR-<timestamp>.tar.gz)")
      <*> strArg "DIR"
    , Subcommand "commit" "Commit an encapsule image from a container" $
      commitCmd
      <$> dryrunOpt
      <*> optional (strOptionWith 'n' "name" "NAME" "Optional image name (prefix with '^' to skip 'encapsule-' prefix)")
      <*> strArg "TOOLBOX"
    , Subcommand "create" "Create an encapsule container" $
      runCmd <$> runOpts True False
    , Subcommand "enter" "Connect to a encapsule container" $
      enterCmd
      <$> dryrunOpt
      <*> debugOpt
      <*> pure True
      <*> optional (strArg "TOOLBOX")
      <*> optional projectNameOpt
    , Subcommand "run" "Run a temporary encapsule container" $
      runCmd <$> runOpts False True
    ]
  where
    dryrunOpt = switchLongWith "dryrun" "Print the podman command instead of running it"

    projectOpt = strOptionWith 'p' "project" "DIR[:opts]"

    nameOpt = strOptionWith 'n' "name" "NAME" "Optional container name (prefix with '^' prefix to skip 'encapsule-' prefix)"

    projectNameOpt = Project <$> projectOpt "Project name or path" <|>
                     Name <$> nameOpt

    backupDirOpt s l m h =
      let pair fs sn = (fs,sn) in
        pair
        <$> strOptionWith s l m h
        <*> switchLongWith ("backup-" ++ l) ("Tarball" +-+ l +-+ "directory before starting")

    debugOpt = switchLongWith "debug" "Show debug output"

    runOpts keep unique =
      Run.RunOpts
      <$> strArg "IMAGE"
      <*> many (strOptionWith 'v' "volume" "HOST:CONTAINER[:opts]" "Bind mount (user's files default to selinux :z)")
      <*> many (strOptionWith 'e' "env" "KEY[=VALUE]" "Set or pass through an environment variable")
      <*> many (strOptionLongWith "path" "DIR" "Prepend a directory to PATH inside the container")
      <*> many (strOptionWith 'i' "init" "CMD" "A bash snippet run when creating the encapsule container")
      <*> many (strOptionLongWith "cap" "NAME" "Enable a capability from the config file")
      <*> switchLongWith "pull" "Pull newer container image"
      <*> optional (strOptionLongWith "user" "USER" "Override container user [default: host/image user with host UID]")
      <*> optional (backupDirOpt 'H' "home" "DIR[:opts]" "Mount a directory as a writable home (created if missing; use DIR:O to overlay)")
      <*> optional (backupDirOpt 'p' "project" "DIR[:opts]" "Mount a (project) directory as workdir (use DIR:O to overlay)")
      <*> optional nameOpt
      <*> pure keep
      <*> switchLongWith "readonly" "Make the encapsule container filesystem read-only"
      <*> switchLongWith "no-network" "Disable network access"
      <*> switchLongWith "no-sudo" "Skip passwordless sudo setup"
      <*> switchLongWith "no-skel" "Don't copy /etc/skel into an empty home"
      <*> pure unique
      <*> many (strOptionLongWith "podman-opt" "OPTION" "Pass an option directly to podman")
      <*> debugOpt
      <*> dryrunOpt
      <*> many (strArg "CMD")

listCmd :: IO ()
listCmd = do
  cmd_ "podman" ["images",
                 "--filter", "reference=" ++ progname ++ "-*",
                 "--format", "{{.Repository}}:{{.Tag}}  {{.Size}}  {{.Created}}"]
  putChar '\n'
  cmd_ "podman" ["ps", "-a",
                 "--filter", "name=^" ++ progname +=+ "",
                 "--format", "{{.Names}}  {{.Status}}"]

removeCmd :: String -> Maybe ProjectName -> IO ()
removeCmd toolbox mprojectname = do
  containerName <- mkContainerName toolbox mprojectname
  exists <- cmdBool "podman" ["container", "exists", containerName]
  if exists
    then do
      (_, out, _) <- cmdFull "podman"
        ["container", "inspect", "-f", "{{.State.Running}}", containerName] ""
      when (take 4 out == "true") $ do
        putStr "stopping "
        cmd_ "podman" ["stop", containerName]
      putStr "rm "
      cmd_ "podman" ["rm", containerName]
    else warning $ "container" +-+ containerName +-+ "not found"

removeImageCmd :: Bool -> String -> IO ()
removeImageCmd dryrun name =
  when dryrun $
  removeImage (progname +=+ name)

-- FIXME dryrun
stopCmd :: String -> Maybe ProjectName -> IO ()
stopCmd name mprojectname = do
  containerName <- mkContainerName name mprojectname
  exists <- cmdBool "podman" ["container", "exists", containerName]
  if exists
    then do
      putStr "stop "
      cmd_ "podman" ["stop", containerName]
    else warning $ "container" +-+ containerName +-+ "not found"

enterCmd :: Bool -> Bool -> Bool -> Maybe String -> Maybe ProjectName -> IO ()
enterCmd dryrun debug running mbase mprojectname = do
  regexp <-
    case mprojectname of
      Nothing -> return $ progname +=+ fromMaybe "" mbase
      Just (Name n) -> return $ progname ++ '-' : n
      Just (Project p) -> do
        projectDir <- resolveProject p
        return $ progname ++ '-' : fromMaybe ".*" mbase ++ '-' : workProjectName projectDir
  ps <- cmdLines "podman" $ "ps" :
        ["-a" | not running] ++
        ["--filter", "name=" ++ '^' : regexp,
         "--format", "{{.Names}}"]
  case ps of
    [] ->
      if running
      then do
        enterCmd dryrun debug False mbase mprojectname
      else error' "encapsule container not found"
    [c] -> do
      unless running $
        warning "no running encapsule container found"
      enterContainer dryrun debug True c []
    _ -> error' $ "multiple" +-+ (if running then  "running" else "") +-+ "containers match:\n" ++ unlines ps

-- image management

commitCmd :: Bool -> Maybe String -> String -> IO ()
commitCmd dryrun mname toolbox = do
  containerExists <- cmdBool "podman" ["container", "exists", toolbox]
  unless containerExists $
    error' $ "container '" ++ toolbox ++ "' not found"
  let image = maybe (progname +=+ toolbox) encapsuleName mname
      encapsuleName ('^':n) = n
      encapsuleName n = progname +=+ n
  imageExists <- cmdBool "podman" ["image", "exists", image]
  unless imageExists $
    putStrLn $ "creating new image:" +-+ image
  let buildah_args = ["commit", "--disable-compression", toolbox, image]
  if dryrun
    then cmdN "buildah" buildah_args
    else do
      putStr "writing image "
      cmd_ "buildah" buildah_args

removeImage :: String -> IO ()
removeImage image = do
  putStr "rmi "
  cmd_ "podman" ["rmi", image]


-- path and env expansion

-- container naming



-- utilities