content: {-# LANGUAGE ConstraintKinds #-}
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE GADTs #-}
  {-# LANGUAGE TypeApplications #-}
  {-# LANGUAGE TypeOperators #-}
  
  {-|
  
  Create and manage Kubernetes clusters via [Minikube](https://minikube.sigs.k8s.io).
  
  -}
  
  module Test.Sandwich.Contexts.Kubernetes.MinikubeCluster (
    -- * Introducing a cluster via Minikube
    introduceMinikubeClusterViaNix
    , introduceMinikubeClusterViaEnvironment
    , introduceMinikubeCluster'
  
    -- * Bracket-style functions
    , withMinikubeCluster
    , withMinikubeCluster'
    , withMinikubeCluster''
  
    -- * Image management
    -- | These are lower-level and Minikube-specific; prefer working with the functions in "Test.Sandwich.Contexts.Kubernetes.Images".
    , Images.clusterContainsImageMinikube
    , Images.getLoadedImagesMinikube
    , Images.loadImageMinikube
  
    -- * Re-exported cluster types
    , kubernetesCluster
    , KubernetesClusterContext (..)
    , HasKubernetesClusterContext
  
    -- * Types
    , MinikubeClusterOptions (..)
    , defaultMinikubeClusterOptions
    ) where
  
  import Control.Monad
  import Control.Monad.IO.Unlift
  import Control.Monad.Logger
  import qualified Data.List as L
  import Data.String.Interpolate
  import Data.Text as T
  import Kubernetes.Client.Config
  import Relude hiding (withFile)
  import System.Exit
  import System.FilePath
  import System.IO.Temp
  import Test.Sandwich
  import Test.Sandwich.Contexts.Files
  import qualified Test.Sandwich.Contexts.Kubernetes.MinikubeCluster.Images as Images
  import Test.Sandwich.Contexts.Kubernetes.Types
  import Test.Sandwich.Contexts.Kubernetes.Util.UUID
  import Test.Sandwich.Contexts.Nix
  import UnliftIO.Environment
  import UnliftIO.Exception
  import UnliftIO.IO
  import UnliftIO.Process
  
  
  data MinikubeClusterOptions = MinikubeClusterOptions {
    minikubeClusterNumNodes :: Int
    , minikubeClusterExtraFlags :: [Text]
    , minikubeClusterNamePrefix :: Maybe Text
    , minikubeClusterDriver :: Maybe Text
    , minikubeClusterCpus :: Maybe Text
    , minikubeClusterMemory :: Maybe Text
    }
  defaultMinikubeClusterOptions :: MinikubeClusterOptions
  defaultMinikubeClusterOptions = MinikubeClusterOptions {
    minikubeClusterNumNodes = 3
    , minikubeClusterExtraFlags = []
    , minikubeClusterNamePrefix = Nothing
    , minikubeClusterDriver = Nothing
    , minikubeClusterCpus = Nothing
    , minikubeClusterMemory = Nothing
    }
  
  -- * Introduce
  
  type MinikubeClusterContext context =
    LabelValue "kubernetesCluster" KubernetesClusterContext
    :> LabelValue "file-minikube" (EnvironmentFile "minikube")
    :> context
  
  -- | Introduce a Minikube cluster, deriving the @minikube@ binary from the Nix context.
  introduceMinikubeClusterViaNix :: (
    HasBaseContext context, MonadUnliftIO m, HasNixContext context
    )
    -- | Options
    => MinikubeClusterOptions
    -- | Child spec
    -> SpecFree (MinikubeClusterContext context) m ()
    -- | Parent spec
    -> SpecFree context m ()
  introduceMinikubeClusterViaNix minikubeClusterOptions spec =
    introduceBinaryViaNixPackage @"minikube" "minikube" $
      introduceWith "introduce minikube cluster" kubernetesCluster (void . withMinikubeCluster minikubeClusterOptions) spec
  
  -- | Introduce a Minikube cluster, deriving the @minikube@ binary from the PATH.
  introduceMinikubeClusterViaEnvironment :: (
    HasBaseContext context, MonadUnliftIO m
    )
    -- | Options
    => MinikubeClusterOptions
    -> SpecFree (MinikubeClusterContext context) m ()
    -> SpecFree context m ()
  introduceMinikubeClusterViaEnvironment minikubeClusterOptions spec =
    introduceBinaryViaEnvironment @"minikube" $
      introduceWith "introduce minikube cluster" kubernetesCluster (void . withMinikubeCluster minikubeClusterOptions) spec
  
  -- | Introduce a Minikube cluster, passing in the @minikube@ binary path.
  introduceMinikubeCluster' :: (
    HasBaseContext context, MonadUnliftIO m
    )
    -- | Path to @minikube@ binary
    => FilePath
    -> MinikubeClusterOptions
    -> SpecFree (MinikubeClusterContext context) m ()
    -> SpecFree context m ()
  introduceMinikubeCluster' minikubeBinary minikubeClusterOptions spec =
    introduceFile @"minikube" minikubeBinary $
      introduceWith "introduce minikube cluster" kubernetesCluster (void . withMinikubeCluster minikubeClusterOptions) $
        spec
  
  -- * Implementation
  
  -- | Bracket-style variant for introducing a Minikube cluster, using a @HasFile context "minikube"@ constraint.
  withMinikubeCluster :: (
    HasBaseContextMonad context m, HasFile context "minikube"
    , MonadLoggerIO m, MonadUnliftIO m, MonadFail m
    )
    -- | Options
    => MinikubeClusterOptions
    -> (KubernetesClusterContext -> m a)
    -> m a
  withMinikubeCluster options action = do
    minikubeBinary <- askFile @"minikube"
    withMinikubeCluster' minikubeBinary options action
  
  -- | Same as 'withMinikubeCluster', but allows you to pass the path to the @minikube@ binary.
  withMinikubeCluster' :: (
    HasBaseContextMonad context m
    , MonadLoggerIO m, MonadUnliftIO m, MonadFail m
    )
    -- | Path to @minikube@ binary
    => FilePath
    -> MinikubeClusterOptions
    -> (KubernetesClusterContext -> m a)
    -> m a
  withMinikubeCluster' minikubeBinary options@(MinikubeClusterOptions {..}) action = do
    let prefix = fromMaybe "test-minikube-cluster" minikubeClusterNamePrefix
    clusterID <- makeUUID' 5
    let clusterName = [i|#{prefix}-#{clusterID}|]
    withMinikubeCluster'' clusterName minikubeBinary options action
  
  -- | Same as 'withMinikubeCluster'', but allows you to pass the cluster name.
  withMinikubeCluster'' :: (
    HasBaseContextMonad context m
    , MonadLoggerIO m, MonadUnliftIO m, MonadFail m
    )
    -- | Cluster name
    => String
    -> FilePath
    -> MinikubeClusterOptions
    -> (KubernetesClusterContext -> m a)
    -> m a
  withMinikubeCluster'' clusterName minikubeBinary options@(MinikubeClusterOptions {..}) action = do
    Just dir <- getCurrentFolder
  
    minikubeDir <- liftIO $ createTempDirectory dir "minikube"
  
    let minikubeKubeConfigFile = minikubeDir </> "minikube-config"
    writeFile minikubeKubeConfigFile ""
  
    let startLogFile = minikubeDir </> "minikube-start.log"
    let deleteLogFile = minikubeDir </> "minikube-delete.log"
  
    withFile startLogFile WriteMode $ \logH ->
      (bracket (startMinikubeCluster minikubeBinary logH clusterName minikubeKubeConfigFile options)
               (\_ -> do
                   info [i|Deleting minikube cluster: #{clusterName}|]
  
                   let extraFlags = case "--rootless" `L.elem` minikubeClusterExtraFlags of
                         True -> ["--rootless"]
                         False -> []
  
                   withFile deleteLogFile WriteMode $ \deleteH -> do
                     let deleteCp = (proc minikubeBinary (["delete"
                                                          , "--profile", clusterName
                                                          , "--logtostderr"
                                                          ] <> extraFlags)) {
                           delegate_ctlc = True
                           , create_group = True
                           , std_out = UseHandle deleteH
                           , std_err = UseHandle deleteH
                           }
                     withCreateProcess deleteCp $ \_ _ _ p ->
                       waitForProcess p >>= \case
                         ExitSuccess -> return ()
                         ExitFailure n -> warn [i|Minikube cluster delete failed with code #{n}.|]
               ))
               (\p -> do
                   waitForProcess p >>= \case
                     ExitSuccess -> return ()
                     ExitFailure n -> expectationFailure [i|Minikube cluster creation failed with code #{n}.|]
  
                   oidcCache <- newTVarIO mempty
                   (m, c) <- liftIO $ mkKubeClientConfig oidcCache $ KubeConfigFile minikubeKubeConfigFile
  
                   action $ KubernetesClusterContext {
                     kubernetesClusterName = toText clusterName
                     , kubernetesClusterKubeConfigPath = minikubeKubeConfigFile
                     , kubernetesClusterNumNodes = minikubeClusterNumNodes
                     , kubernetesClusterClientConfig = (m, c)
                     , kubernetesClusterType = KubernetesClusterMinikube {
                         kubernetesClusterTypeMinikubeBinary = minikubeBinary
                         , kubernetesClusterTypeMinikubeProfileName = toText clusterName
                         , kubernetesClusterTypeMinikubeFlags = minikubeClusterExtraFlags
                         }
                     }
               )
  
  startMinikubeCluster :: (
    MonadLoggerIO m
    ) => FilePath -> Handle -> String -> String -> MinikubeClusterOptions -> m ProcessHandle
  startMinikubeCluster minikubeBinary logH clusterName minikubeKubeConfigFile (MinikubeClusterOptions {..}) = do
    baseEnv <- getEnvironment
    let env = L.nubBy (\x y -> fst x == fst y) (("KUBECONFIG", minikubeKubeConfigFile) : baseEnv)
  
    -- Note: this doesn't actually work! These options actually go to the docker daemon, not the "start" operation.
    -- It may not be possible to get a label on the Docker container in current minikube.
    -- let labelArgs = case dockerLabels of
    --       x | M.null x -> []
    --       xs -> "--docker-opt" : [[i|label=#{k}=#{v}|] | (k, v) <- M.toList xs]
  
    let driverAndResourceFlags = case minikubeClusterDriver of
          Nothing -> ["--driver=docker"
                     , [i|--memory=#{fromMaybe "16000mb" minikubeClusterMemory}|]
                     , [i|--cpus=#{fromMaybe "max" minikubeClusterCpus}|]
                     ]
          Just d -> [[i|--driver=#{d}|]
                    , [i|--memory=#{fromMaybe "16000mb" minikubeClusterMemory}|]
                    , [i|--cpus=#{fromMaybe "8" minikubeClusterCpus}|]
                    ]
  
    let args = ["start"
               , "--profile", clusterName
               , "--logtostderr"
               -- , "--addons=ingress"
               , "--extra-config=kubelet.streaming-connection-idle-timeout=5h"
               ]
               <> driverAndResourceFlags
               <> (fmap toString minikubeClusterExtraFlags)
  
    info [i|export KUBECONFIG='#{minikubeKubeConfigFile}'|]
    debug [i|Starting minikube with args: #{minikubeBinary} #{T.unwords $ fmap toText args}|]
  
    (_, _, _, p) <- createProcess (
      (proc minikubeBinary args) {
          delegate_ctlc = True
          , create_group = True
          , env = Just env
          , std_out = UseHandle logH
          , std_err = UseHandle logH
          })
    return p
  
  -- Debugging (in case of certificate issues such as https://github.com/channable/vaultenv/issues/99)
  -- import Kubernetes.Client.Auth.OIDC
  -- oidcCache :: OIDCCache <- Relude.newTVarIO mempty
  -- (m, c) <- mkKubeClientConfig oidcCache $ KubeConfigFile "/tmp/test-minikube-cluster-config-e695417a5bf81acf/minikube-kube-config"
  -- import Kubernetes.OpenAPI.Core
  -- import Kubernetes.OpenAPI.API.AppsV1 as Kubernetes
  -- import Kubernetes.OpenAPI.API.BatchV1 as Kubernetes
  -- import Kubernetes.OpenAPI.API.CoreV1 as Kubernetes
  -- import Kubernetes.OpenAPI.Core as Kubernetes
  -- import Kubernetes.OpenAPI.MimeTypes
  -- import Kubernetes.OpenAPI.Model as Kubernetes
  -- import Kubernetes.OpenAPI.Client as Kubernetes
  -- MimeResult parsedResult _httpResponse <- liftIO (dispatchMime m c (listNamespacedPod (Accept MimeJSON) (Namespace "default")))
  