{-# 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 {
  MinikubeClusterOptions -> Int
minikubeClusterNumNodes :: Int
  , MinikubeClusterOptions -> [Text]
minikubeClusterExtraFlags :: [Text]
  , MinikubeClusterOptions -> Maybe Text
minikubeClusterNamePrefix :: Maybe Text
  , MinikubeClusterOptions -> Maybe Text
minikubeClusterDriver :: Maybe Text
  , MinikubeClusterOptions -> Maybe Text
minikubeClusterCpus :: Maybe Text
  , MinikubeClusterOptions -> Maybe Text
minikubeClusterMemory :: Maybe Text
  }
defaultMinikubeClusterOptions :: MinikubeClusterOptions
defaultMinikubeClusterOptions :: MinikubeClusterOptions
defaultMinikubeClusterOptions = MinikubeClusterOptions {
  minikubeClusterNumNodes :: Int
minikubeClusterNumNodes = Int
3
  , minikubeClusterExtraFlags :: [Text]
minikubeClusterExtraFlags = []
  , minikubeClusterNamePrefix :: Maybe Text
minikubeClusterNamePrefix = Maybe Text
forall a. Maybe a
Nothing
  , minikubeClusterDriver :: Maybe Text
minikubeClusterDriver = Maybe Text
forall a. Maybe a
Nothing
  , minikubeClusterCpus :: Maybe Text
minikubeClusterCpus = Maybe Text
forall a. Maybe a
Nothing
  , minikubeClusterMemory :: Maybe Text
minikubeClusterMemory = Maybe Text
forall a. Maybe a
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 :: forall context (m :: * -> *).
(HasBaseContext context, MonadUnliftIO m, HasNixContext context) =>
MinikubeClusterOptions
-> SpecFree (MinikubeClusterContext context) m ()
-> SpecFree context m ()
introduceMinikubeClusterViaNix MinikubeClusterOptions
minikubeClusterOptions SpecFree (MinikubeClusterContext context) m ()
spec =
  forall (a :: Symbol) context (m :: * -> *).
(HasBaseContext context, HasNixContext context, MonadUnliftIO m,
 KnownSymbol a) =>
Text
-> SpecFree
     (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
      :> context)
     m
     ()
-> SpecFree context m ()
introduceBinaryViaNixPackage @"minikube" Text
"minikube" (SpecFree
   (LabelValue
      (AppendSymbol "file-" "minikube") (EnvironmentFile "minikube")
    :> context)
   m
   ()
 -> SpecFree context m ())
-> SpecFree
     (LabelValue
        (AppendSymbol "file-" "minikube") (EnvironmentFile "minikube")
      :> context)
     m
     ()
-> SpecFree context m ()
forall a b. (a -> b) -> a -> b
$
    String
-> Label "kubernetesCluster" KubernetesClusterContext
-> ((HasCallStack =>
     KubernetesClusterContext
     -> ExampleT
          (LabelValue
             (AppendSymbol "file-" "minikube") (EnvironmentFile "minikube")
           :> context)
          m
          [Result])
    -> ExampleT
         (LabelValue
            (AppendSymbol "file-" "minikube") (EnvironmentFile "minikube")
          :> context)
         m
         ())
-> SpecFree
     (LabelValue "kubernetesCluster" KubernetesClusterContext
      :> (LabelValue
            (AppendSymbol "file-" "minikube") (EnvironmentFile "minikube")
          :> context))
     m
     ()
-> SpecFree
     (LabelValue
        (AppendSymbol "file-" "minikube") (EnvironmentFile "minikube")
      :> context)
     m
     ()
forall (l :: Symbol) intro context (m :: * -> *).
HasCallStack =>
String
-> Label l intro
-> ((HasCallStack => intro -> ExampleT context m [Result])
    -> ExampleT context m ())
-> SpecFree (LabelValue l intro :> context) m ()
-> SpecFree context m ()
introduceWith String
"introduce minikube cluster" Label "kubernetesCluster" KubernetesClusterContext
kubernetesCluster (ExampleT
  (LabelValue "file-minikube" (EnvironmentFile "minikube")
   :> context)
  m
  [Result]
-> ExampleT
     (LabelValue "file-minikube" (EnvironmentFile "minikube")
      :> context)
     m
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExampleT
   (LabelValue "file-minikube" (EnvironmentFile "minikube")
    :> context)
   m
   [Result]
 -> ExampleT
      (LabelValue "file-minikube" (EnvironmentFile "minikube")
       :> context)
      m
      ())
-> ((KubernetesClusterContext
     -> ExampleT
          (LabelValue "file-minikube" (EnvironmentFile "minikube")
           :> context)
          m
          [Result])
    -> ExampleT
         (LabelValue "file-minikube" (EnvironmentFile "minikube")
          :> context)
         m
         [Result])
-> (KubernetesClusterContext
    -> ExampleT
         (LabelValue "file-minikube" (EnvironmentFile "minikube")
          :> context)
         m
         [Result])
-> ExampleT
     (LabelValue "file-minikube" (EnvironmentFile "minikube")
      :> context)
     m
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MinikubeClusterOptions
-> (KubernetesClusterContext
    -> ExampleT
         (LabelValue "file-minikube" (EnvironmentFile "minikube")
          :> context)
         m
         [Result])
-> ExampleT
     (LabelValue "file-minikube" (EnvironmentFile "minikube")
      :> context)
     m
     [Result]
forall context (m :: * -> *) a.
(HasBaseContextMonad context m, HasFile context "minikube",
 MonadLoggerIO m, MonadUnliftIO m, MonadFail m) =>
MinikubeClusterOptions -> (KubernetesClusterContext -> m a) -> m a
withMinikubeCluster MinikubeClusterOptions
minikubeClusterOptions) SpecFree (MinikubeClusterContext context) m ()
SpecFree
  (LabelValue "kubernetesCluster" KubernetesClusterContext
   :> (LabelValue
         (AppendSymbol "file-" "minikube") (EnvironmentFile "minikube")
       :> context))
  m
  ()
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 :: forall context (m :: * -> *).
(HasBaseContext context, MonadUnliftIO m) =>
MinikubeClusterOptions
-> SpecFree (MinikubeClusterContext context) m ()
-> SpecFree context m ()
introduceMinikubeClusterViaEnvironment MinikubeClusterOptions
minikubeClusterOptions SpecFree (MinikubeClusterContext context) m ()
spec =
  forall (a :: Symbol) context (m :: * -> *).
(MonadUnliftIO m, KnownSymbol a) =>
SpecFree
  (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
   :> context)
  m
  ()
-> SpecFree context m ()
introduceBinaryViaEnvironment @"minikube" (SpecFree
   (LabelValue
      (AppendSymbol "file-" "minikube") (EnvironmentFile "minikube")
    :> context)
   m
   ()
 -> SpecFree context m ())
-> SpecFree
     (LabelValue
        (AppendSymbol "file-" "minikube") (EnvironmentFile "minikube")
      :> context)
     m
     ()
-> SpecFree context m ()
forall a b. (a -> b) -> a -> b
$
    String
-> Label "kubernetesCluster" KubernetesClusterContext
-> ((HasCallStack =>
     KubernetesClusterContext
     -> ExampleT
          (LabelValue
             (AppendSymbol "file-" "minikube") (EnvironmentFile "minikube")
           :> context)
          m
          [Result])
    -> ExampleT
         (LabelValue
            (AppendSymbol "file-" "minikube") (EnvironmentFile "minikube")
          :> context)
         m
         ())
-> SpecFree
     (LabelValue "kubernetesCluster" KubernetesClusterContext
      :> (LabelValue
            (AppendSymbol "file-" "minikube") (EnvironmentFile "minikube")
          :> context))
     m
     ()
-> SpecFree
     (LabelValue
        (AppendSymbol "file-" "minikube") (EnvironmentFile "minikube")
      :> context)
     m
     ()
forall (l :: Symbol) intro context (m :: * -> *).
HasCallStack =>
String
-> Label l intro
-> ((HasCallStack => intro -> ExampleT context m [Result])
    -> ExampleT context m ())
-> SpecFree (LabelValue l intro :> context) m ()
-> SpecFree context m ()
introduceWith String
"introduce minikube cluster" Label "kubernetesCluster" KubernetesClusterContext
kubernetesCluster (ExampleT
  (LabelValue "file-minikube" (EnvironmentFile "minikube")
   :> context)
  m
  [Result]
-> ExampleT
     (LabelValue "file-minikube" (EnvironmentFile "minikube")
      :> context)
     m
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExampleT
   (LabelValue "file-minikube" (EnvironmentFile "minikube")
    :> context)
   m
   [Result]
 -> ExampleT
      (LabelValue "file-minikube" (EnvironmentFile "minikube")
       :> context)
      m
      ())
-> ((KubernetesClusterContext
     -> ExampleT
          (LabelValue "file-minikube" (EnvironmentFile "minikube")
           :> context)
          m
          [Result])
    -> ExampleT
         (LabelValue "file-minikube" (EnvironmentFile "minikube")
          :> context)
         m
         [Result])
-> (KubernetesClusterContext
    -> ExampleT
         (LabelValue "file-minikube" (EnvironmentFile "minikube")
          :> context)
         m
         [Result])
-> ExampleT
     (LabelValue "file-minikube" (EnvironmentFile "minikube")
      :> context)
     m
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MinikubeClusterOptions
-> (KubernetesClusterContext
    -> ExampleT
         (LabelValue "file-minikube" (EnvironmentFile "minikube")
          :> context)
         m
         [Result])
-> ExampleT
     (LabelValue "file-minikube" (EnvironmentFile "minikube")
      :> context)
     m
     [Result]
forall context (m :: * -> *) a.
(HasBaseContextMonad context m, HasFile context "minikube",
 MonadLoggerIO m, MonadUnliftIO m, MonadFail m) =>
MinikubeClusterOptions -> (KubernetesClusterContext -> m a) -> m a
withMinikubeCluster MinikubeClusterOptions
minikubeClusterOptions) SpecFree (MinikubeClusterContext context) m ()
SpecFree
  (LabelValue "kubernetesCluster" KubernetesClusterContext
   :> (LabelValue
         (AppendSymbol "file-" "minikube") (EnvironmentFile "minikube")
       :> context))
  m
  ()
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' :: forall context (m :: * -> *).
(HasBaseContext context, MonadUnliftIO m) =>
String
-> MinikubeClusterOptions
-> SpecFree (MinikubeClusterContext context) m ()
-> SpecFree context m ()
introduceMinikubeCluster' String
minikubeBinary MinikubeClusterOptions
minikubeClusterOptions SpecFree (MinikubeClusterContext context) m ()
spec =
  forall (a :: Symbol) context (m :: * -> *).
(MonadUnliftIO m, KnownSymbol a) =>
String
-> SpecFree
     (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
      :> context)
     m
     ()
-> SpecFree context m ()
introduceFile @"minikube" String
minikubeBinary (SpecFree
   (LabelValue
      (AppendSymbol "file-" "minikube") (EnvironmentFile "minikube")
    :> context)
   m
   ()
 -> SpecFree context m ())
-> SpecFree
     (LabelValue
        (AppendSymbol "file-" "minikube") (EnvironmentFile "minikube")
      :> context)
     m
     ()
-> SpecFree context m ()
forall a b. (a -> b) -> a -> b
$
    String
-> Label "kubernetesCluster" KubernetesClusterContext
-> ((HasCallStack =>
     KubernetesClusterContext
     -> ExampleT
          (LabelValue "file-minikube" (EnvironmentFile "minikube")
           :> context)
          m
          [Result])
    -> ExampleT
         (LabelValue "file-minikube" (EnvironmentFile "minikube")
          :> context)
         m
         ())
-> SpecFree (MinikubeClusterContext context) m ()
-> SpecFree
     (LabelValue "file-minikube" (EnvironmentFile "minikube")
      :> context)
     m
     ()
forall (l :: Symbol) intro context (m :: * -> *).
HasCallStack =>
String
-> Label l intro
-> ((HasCallStack => intro -> ExampleT context m [Result])
    -> ExampleT context m ())
-> SpecFree (LabelValue l intro :> context) m ()
-> SpecFree context m ()
introduceWith String
"introduce minikube cluster" Label "kubernetesCluster" KubernetesClusterContext
kubernetesCluster (ExampleT
  (LabelValue "file-minikube" (EnvironmentFile "minikube")
   :> context)
  m
  [Result]
-> ExampleT
     (LabelValue "file-minikube" (EnvironmentFile "minikube")
      :> context)
     m
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExampleT
   (LabelValue "file-minikube" (EnvironmentFile "minikube")
    :> context)
   m
   [Result]
 -> ExampleT
      (LabelValue "file-minikube" (EnvironmentFile "minikube")
       :> context)
      m
      ())
-> ((KubernetesClusterContext
     -> ExampleT
          (LabelValue "file-minikube" (EnvironmentFile "minikube")
           :> context)
          m
          [Result])
    -> ExampleT
         (LabelValue "file-minikube" (EnvironmentFile "minikube")
          :> context)
         m
         [Result])
-> (KubernetesClusterContext
    -> ExampleT
         (LabelValue "file-minikube" (EnvironmentFile "minikube")
          :> context)
         m
         [Result])
-> ExampleT
     (LabelValue "file-minikube" (EnvironmentFile "minikube")
      :> context)
     m
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MinikubeClusterOptions
-> (KubernetesClusterContext
    -> ExampleT
         (LabelValue "file-minikube" (EnvironmentFile "minikube")
          :> context)
         m
         [Result])
-> ExampleT
     (LabelValue "file-minikube" (EnvironmentFile "minikube")
      :> context)
     m
     [Result]
forall context (m :: * -> *) a.
(HasBaseContextMonad context m, HasFile context "minikube",
 MonadLoggerIO m, MonadUnliftIO m, MonadFail m) =>
MinikubeClusterOptions -> (KubernetesClusterContext -> m a) -> m a
withMinikubeCluster MinikubeClusterOptions
minikubeClusterOptions) (SpecFree (MinikubeClusterContext context) m ()
 -> SpecFree
      (LabelValue "file-minikube" (EnvironmentFile "minikube")
       :> context)
      m
      ())
-> SpecFree (MinikubeClusterContext context) m ()
-> SpecFree
     (LabelValue "file-minikube" (EnvironmentFile "minikube")
      :> context)
     m
     ()
forall a b. (a -> b) -> a -> b
$
      SpecFree (MinikubeClusterContext context) m ()
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 :: forall context (m :: * -> *) a.
(HasBaseContextMonad context m, HasFile context "minikube",
 MonadLoggerIO m, MonadUnliftIO m, MonadFail m) =>
MinikubeClusterOptions -> (KubernetesClusterContext -> m a) -> m a
withMinikubeCluster MinikubeClusterOptions
options KubernetesClusterContext -> m a
action = do
  minikubeBinary <- forall (a :: Symbol) context (m :: * -> *).
(MonadReader context m, HasFile context a) =>
m String
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' :: forall context (m :: * -> *) a.
(HasBaseContextMonad context m, MonadLoggerIO m, MonadUnliftIO m,
 MonadFail m) =>
String
-> MinikubeClusterOptions
-> (KubernetesClusterContext -> m a)
-> m a
withMinikubeCluster' String
minikubeBinary options :: MinikubeClusterOptions
options@(MinikubeClusterOptions {Int
[Text]
Maybe Text
minikubeClusterNumNodes :: MinikubeClusterOptions -> Int
minikubeClusterExtraFlags :: MinikubeClusterOptions -> [Text]
minikubeClusterNamePrefix :: MinikubeClusterOptions -> Maybe Text
minikubeClusterDriver :: MinikubeClusterOptions -> Maybe Text
minikubeClusterCpus :: MinikubeClusterOptions -> Maybe Text
minikubeClusterMemory :: MinikubeClusterOptions -> Maybe Text
minikubeClusterNumNodes :: Int
minikubeClusterExtraFlags :: [Text]
minikubeClusterNamePrefix :: Maybe Text
minikubeClusterDriver :: Maybe Text
minikubeClusterCpus :: Maybe Text
minikubeClusterMemory :: Maybe Text
..}) KubernetesClusterContext -> m a
action = do
  let prefix :: Text
prefix = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"test-minikube-cluster" Maybe Text
minikubeClusterNamePrefix
  clusterID <- Int -> m Text
forall (m :: * -> *). MonadIO m => Int -> m Text
makeUUID' Int
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'' :: forall context (m :: * -> *) a.
(HasBaseContextMonad context m, MonadLoggerIO m, MonadUnliftIO m,
 MonadFail m) =>
String
-> String
-> MinikubeClusterOptions
-> (KubernetesClusterContext -> m a)
-> m a
withMinikubeCluster'' String
clusterName String
minikubeBinary options :: MinikubeClusterOptions
options@(MinikubeClusterOptions {Int
[Text]
Maybe Text
minikubeClusterNumNodes :: MinikubeClusterOptions -> Int
minikubeClusterExtraFlags :: MinikubeClusterOptions -> [Text]
minikubeClusterNamePrefix :: MinikubeClusterOptions -> Maybe Text
minikubeClusterDriver :: MinikubeClusterOptions -> Maybe Text
minikubeClusterCpus :: MinikubeClusterOptions -> Maybe Text
minikubeClusterMemory :: MinikubeClusterOptions -> Maybe Text
minikubeClusterNumNodes :: Int
minikubeClusterExtraFlags :: [Text]
minikubeClusterNamePrefix :: Maybe Text
minikubeClusterDriver :: Maybe Text
minikubeClusterCpus :: Maybe Text
minikubeClusterMemory :: Maybe Text
..}) KubernetesClusterContext -> m a
action = do
  Just dir <- m (Maybe String)
forall context (m :: * -> *).
HasBaseContextMonad context m =>
m (Maybe String)
getCurrentFolder

  minikubeDir <- liftIO $ createTempDirectory dir "minikube"

  let minikubeKubeConfigFile = String
minikubeDir String -> String -> String
</> String
"minikube-config"
  writeFile minikubeKubeConfigFile ""

  let startLogFile = String
minikubeDir String -> String -> String
</> String
"minikube-start.log"
  let deleteLogFile = String
minikubeDir String -> String -> String
</> String
"minikube-delete.log"

  withFile startLogFile WriteMode $ \Handle
logH ->
    (m ProcessHandle
-> (ProcessHandle -> m ()) -> (ProcessHandle -> m a) -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (String
-> Handle
-> String
-> String
-> MinikubeClusterOptions
-> m ProcessHandle
forall (m :: * -> *).
MonadLoggerIO m =>
String
-> Handle
-> String
-> String
-> MinikubeClusterOptions
-> m ProcessHandle
startMinikubeCluster String
minikubeBinary Handle
logH String
clusterName String
minikubeKubeConfigFile MinikubeClusterOptions
options)
             (\ProcessHandle
_ -> do
                 Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
info [i|Deleting minikube cluster: #{clusterName}|]

                 let extraFlags :: [String]
extraFlags = case Text
"--rootless" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`L.elem` [Text]
minikubeClusterExtraFlags of
                       Bool
True -> [String
"--rootless"]
                       Bool
False -> []

                 String -> IOMode -> (Handle -> m ()) -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> IOMode -> (Handle -> m a) -> m a
withFile String
deleteLogFile IOMode
WriteMode ((Handle -> m ()) -> m ()) -> (Handle -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Handle
deleteH -> do
                   let deleteCp :: CreateProcess
deleteCp = (String -> [String] -> CreateProcess
proc String
minikubeBinary ([String
"delete"
                                                        , String
"--profile", String
clusterName
                                                        , String
"--logtostderr"
                                                        ] [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
extraFlags)) {
                         delegate_ctlc = True
                         , create_group = True
                         , std_out = UseHandle deleteH
                         , std_err = UseHandle deleteH
                         }
                   CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> m ())
-> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> m a)
-> m a
withCreateProcess CreateProcess
deleteCp ((Maybe Handle
  -> Maybe Handle -> Maybe Handle -> ProcessHandle -> m ())
 -> m ())
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> m ())
-> m ()
forall a b. (a -> b) -> a -> b
$ \Maybe Handle
_ Maybe Handle
_ Maybe Handle
_ ProcessHandle
p ->
                     ProcessHandle -> m ExitCode
forall (m :: * -> *). MonadIO m => ProcessHandle -> m ExitCode
waitForProcess ProcessHandle
p m ExitCode -> (ExitCode -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                       ExitCode
ExitSuccess -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                       ExitFailure Int
n -> Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
warn [i|Minikube cluster delete failed with code #{n}.|]
             ))
             (\ProcessHandle
p -> do
                 ProcessHandle -> m ExitCode
forall (m :: * -> *). MonadIO m => ProcessHandle -> m ExitCode
waitForProcess ProcessHandle
p m ExitCode -> (ExitCode -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                   ExitCode
ExitSuccess -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                   ExitFailure Int
n -> String -> m ()
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
expectationFailure [i|Minikube cluster creation failed with code #{n}.|]

                 oidcCache <- Map (Text, Text) OIDCAuth -> m (TVar (Map (Text, Text) OIDCAuth))
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Map (Text, Text) OIDCAuth
forall a. Monoid a => a
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 :: forall (m :: * -> *).
MonadLoggerIO m =>
String
-> Handle
-> String
-> String
-> MinikubeClusterOptions
-> m ProcessHandle
startMinikubeCluster String
minikubeBinary Handle
logH String
clusterName String
minikubeKubeConfigFile (MinikubeClusterOptions {Int
[Text]
Maybe Text
minikubeClusterNumNodes :: MinikubeClusterOptions -> Int
minikubeClusterExtraFlags :: MinikubeClusterOptions -> [Text]
minikubeClusterNamePrefix :: MinikubeClusterOptions -> Maybe Text
minikubeClusterDriver :: MinikubeClusterOptions -> Maybe Text
minikubeClusterCpus :: MinikubeClusterOptions -> Maybe Text
minikubeClusterMemory :: MinikubeClusterOptions -> Maybe Text
minikubeClusterNumNodes :: Int
minikubeClusterExtraFlags :: [Text]
minikubeClusterNamePrefix :: Maybe Text
minikubeClusterDriver :: Maybe Text
minikubeClusterCpus :: Maybe Text
minikubeClusterMemory :: Maybe Text
..}) = do
  baseEnv <- m [(String, String)]
forall (m :: * -> *). MonadIO m => m [(String, String)]
getEnvironment
  let env = ((String, String) -> (String, String) -> Bool)
-> [(String, String)] -> [(String, String)]
forall a. (a -> a -> Bool) -> [a] -> [a]
L.nubBy (\(String, String)
x (String, String)
y -> (String, String) -> String
forall a b. (a, b) -> a
fst (String, String)
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (String, String) -> String
forall a b. (a, b) -> a
fst (String, String)
y) ((String
"KUBECONFIG", String
minikubeKubeConfigFile) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
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 Maybe Text
minikubeClusterDriver of
        Maybe Text
Nothing -> [String
"--driver=docker"
                   , [i|--memory=#{fromMaybe "16000mb" minikubeClusterMemory}|]
                   , [i|--cpus=#{fromMaybe "max" minikubeClusterCpus}|]
                   ]
        Just Text
d -> [[i|--driver=#{d}|]
                  , [i|--memory=#{fromMaybe "16000mb" minikubeClusterMemory}|]
                  , [i|--cpus=#{fromMaybe "8" minikubeClusterCpus}|]
                  ]

  let args = [String
"start"
             , String
"--profile", String
clusterName
             , String
"--logtostderr"
             -- , "--addons=ingress"
             , String
"--extra-config=kubelet.streaming-connection-idle-timeout=5h"
             ]
             [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
driverAndResourceFlags
             [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> ((Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
forall a. ToString a => a -> String
toString [Text]
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")))