{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

{-|

Create and manage Kubernetes clusters via [kind](https://kind.sigs.k8s.io/).

-}

module Test.Sandwich.Contexts.Kubernetes.KindCluster (
  introduceKindClusterViaNix
  , introduceKindClusterViaEnvironment
  , introduceKindCluster'

  -- * Bracket-style versions
  , withKindCluster
  , withKindCluster'

  -- * Image management
  -- | These are lower-level and Kind-specific; prefer working with the functions in "Test.Sandwich.Contexts.Kubernetes.Images".
  , Images.clusterContainsImageKind
  , Images.getLoadedImagesKind
  , Images.loadImageKind

  -- * Re-exported types
  , KubernetesClusterContext (..)
  , kubernetesCluster
  , HasKubernetesClusterContext

  -- * Types
  , KindClusterOptions (..)
  , defaultKindClusterOptions
  , KindClusterName(..)
  , ExtraPortMapping(..)
  , ExtraMount(..)
  , KindContext
  ) where

import Control.Monad
import Control.Monad.IO.Unlift
import Control.Monad.Logger
import Data.String.Interpolate
import qualified Data.Yaml as Yaml
import Kubernetes.Client.Config
import Relude
import System.IO.Temp
import Test.Sandwich
import Test.Sandwich.Contexts.Files
import Test.Sandwich.Contexts.Kubernetes.KindCluster.Config
import qualified Test.Sandwich.Contexts.Kubernetes.KindCluster.Images as Images
import Test.Sandwich.Contexts.Kubernetes.KindCluster.Setup
import Test.Sandwich.Contexts.Kubernetes.Types
import Test.Sandwich.Contexts.Kubernetes.Util.Container (isInContainer)
import Test.Sandwich.Contexts.Kubernetes.Util.UUID
import Test.Sandwich.Contexts.Nix
import UnliftIO.Environment
import UnliftIO.Exception
import UnliftIO.Process


-- Note: when using kind with podman as a driver, it's possible to run into a low PID limit
-- which isn't enough for all the processes in a Kubernetes cluster.
-- I debugged this and found a kind patch to fix it, described here:
-- https://github.com/kubernetes-sigs/kind/issues/3451#issuecomment-1855701939
--
-- You can also fix this at the podman level, with the following in `containers.conf`:
-- [containers]
-- pids_limit = 0


data KindClusterName =
  -- | Give the kind cluster an exact name
  KindClusterNameExactly Text
  -- | Autogenerate the cluster name, with an optional fixed prefix
  | KindClusterNameAutogenerate (Maybe Text)
  deriving (Int -> KindClusterName -> ShowS
[KindClusterName] -> ShowS
KindClusterName -> String
(Int -> KindClusterName -> ShowS)
-> (KindClusterName -> String)
-> ([KindClusterName] -> ShowS)
-> Show KindClusterName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KindClusterName -> ShowS
showsPrec :: Int -> KindClusterName -> ShowS
$cshow :: KindClusterName -> String
show :: KindClusterName -> String
$cshowList :: [KindClusterName] -> ShowS
showList :: [KindClusterName] -> ShowS
Show, KindClusterName -> KindClusterName -> Bool
(KindClusterName -> KindClusterName -> Bool)
-> (KindClusterName -> KindClusterName -> Bool)
-> Eq KindClusterName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KindClusterName -> KindClusterName -> Bool
== :: KindClusterName -> KindClusterName -> Bool
$c/= :: KindClusterName -> KindClusterName -> Bool
/= :: KindClusterName -> KindClusterName -> Bool
Eq)

data KindClusterOptions = KindClusterOptions {
  KindClusterOptions -> Int
kindClusterNumNodes :: Int
  -- | Extra flags to pass to @kind@
  , KindClusterOptions -> [Text]
kindClusterExtraFlags :: [Text]
  -- | Labels to apply to the created containers
  , KindClusterOptions -> Map Text Text
kindClusterContainerLabels :: Map Text Text
  -- | Extra ports to map; see the [docs](https://kind.sigs.k8s.io/docs/user/configuration#extra-port-mappings)
  , KindClusterOptions -> [ExtraPortMapping]
kindClusterExtraPortMappings :: [ExtraPortMapping]
  -- | Extra mounts; see the [docs](https://kind.sigs.k8s.io/docs/user/configuration#extra-mounts)
  , KindClusterOptions -> [ExtraMount]
kindClusterExtraMounts :: [ExtraMount]
  -- | Prefix for the generated cluster name
  , KindClusterOptions -> KindClusterName
kindClusterName :: KindClusterName
  -- | Container driver, either "docker" or "podman". Defaults to "docker".
  , KindClusterOptions -> Maybe Text
kindClusterDriver :: Maybe Text
  -- , kindClusterCpus :: Maybe Text
  -- , kindClusterMemory :: Maybe Text
  }
defaultKindClusterOptions :: KindClusterOptions
defaultKindClusterOptions :: KindClusterOptions
defaultKindClusterOptions = KindClusterOptions {
  kindClusterNumNodes :: Int
kindClusterNumNodes = Int
3
  , kindClusterExtraFlags :: [Text]
kindClusterExtraFlags = []
  , kindClusterContainerLabels :: Map Text Text
kindClusterContainerLabels = Map Text Text
forall a. Monoid a => a
mempty
  , kindClusterExtraPortMappings :: [ExtraPortMapping]
kindClusterExtraPortMappings = []
  , kindClusterExtraMounts :: [ExtraMount]
kindClusterExtraMounts = []
  , kindClusterName :: KindClusterName
kindClusterName = Maybe Text -> KindClusterName
KindClusterNameAutogenerate Maybe Text
forall a. Maybe a
Nothing
  , kindClusterDriver :: Maybe Text
kindClusterDriver = Maybe Text
forall a. Maybe a
Nothing
  -- , kindClusterCpus = Nothing
  -- , kindClusterMemory = Nothing
  }

-- * Introduce

-- | Alias to make type signatures shorter.
type KindContext context = LabelValue "kubernetesCluster" KubernetesClusterContext :> LabelValue "file-kubectl" (EnvironmentFile "kubectl") :> LabelValue "file-kind" (EnvironmentFile "kind") :> context

-- | Introduce a Kubernetes cluster using [kind](https://kind.sigs.k8s.io/), deriving the @kind@ and @kubectl@ binaries from the Nix context.
introduceKindClusterViaNix :: (
  HasBaseContext context, MonadUnliftIO m, HasNixContext context
  )
  -- | Options
  => KindClusterOptions
  -- | Child spec
  -> SpecFree (KindContext context) m ()
  -- | Parent spec
  -> SpecFree context m ()
introduceKindClusterViaNix :: forall context (m :: * -> *).
(HasBaseContext context, MonadUnliftIO m, HasNixContext context) =>
KindClusterOptions
-> SpecFree (KindContext context) m () -> SpecFree context m ()
introduceKindClusterViaNix KindClusterOptions
kindClusterOptions SpecFree (KindContext 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 @"kind" Text
"kind" (SpecFree
   (LabelValue (AppendSymbol "file-" "kind") (EnvironmentFile "kind")
    :> context)
   m
   ()
 -> SpecFree context m ())
-> SpecFree
     (LabelValue (AppendSymbol "file-" "kind") (EnvironmentFile "kind")
      :> context)
     m
     ()
-> SpecFree context m ()
forall a b. (a -> b) -> a -> b
$
    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 @"kubectl" Text
"kubectl" (SpecFree
   (LabelValue
      (AppendSymbol "file-" "kubectl") (EnvironmentFile "kubectl")
    :> (LabelValue
          (AppendSymbol "file-" "kind") (EnvironmentFile "kind")
        :> context))
   m
   ()
 -> SpecFree
      (LabelValue (AppendSymbol "file-" "kind") (EnvironmentFile "kind")
       :> context)
      m
      ())
-> SpecFree
     (LabelValue
        (AppendSymbol "file-" "kubectl") (EnvironmentFile "kubectl")
      :> (LabelValue
            (AppendSymbol "file-" "kind") (EnvironmentFile "kind")
          :> context))
     m
     ()
-> SpecFree
     (LabelValue (AppendSymbol "file-" "kind") (EnvironmentFile "kind")
      :> context)
     m
     ()
forall a b. (a -> b) -> a -> b
$
      String
-> Label "kubernetesCluster" KubernetesClusterContext
-> ((HasCallStack =>
     KubernetesClusterContext
     -> ExampleT
          (LabelValue
             (AppendSymbol "file-" "kubectl") (EnvironmentFile "kubectl")
           :> (LabelValue
                 (AppendSymbol "file-" "kind") (EnvironmentFile "kind")
               :> context))
          m
          [Result])
    -> ExampleT
         (LabelValue
            (AppendSymbol "file-" "kubectl") (EnvironmentFile "kubectl")
          :> (LabelValue
                (AppendSymbol "file-" "kind") (EnvironmentFile "kind")
              :> context))
         m
         ())
-> SpecFree
     (LabelValue "kubernetesCluster" KubernetesClusterContext
      :> (LabelValue
            (AppendSymbol "file-" "kubectl") (EnvironmentFile "kubectl")
          :> (LabelValue
                (AppendSymbol "file-" "kind") (EnvironmentFile "kind")
              :> context)))
     m
     ()
-> SpecFree
     (LabelValue
        (AppendSymbol "file-" "kubectl") (EnvironmentFile "kubectl")
      :> (LabelValue
            (AppendSymbol "file-" "kind") (EnvironmentFile "kind")
          :> 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 kind cluster" Label "kubernetesCluster" KubernetesClusterContext
kubernetesCluster (ExampleT
  (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
   :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
  m
  [Result]
-> ExampleT
     (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
      :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
     m
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExampleT
   (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
    :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
   m
   [Result]
 -> ExampleT
      (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
       :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
      m
      ())
-> ((KubernetesClusterContext
     -> ExampleT
          (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
           :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
          m
          [Result])
    -> ExampleT
         (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
          :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
         m
         [Result])
-> (KubernetesClusterContext
    -> ExampleT
         (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
          :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
         m
         [Result])
-> ExampleT
     (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
      :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
     m
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KindClusterOptions
-> (KubernetesClusterContext
    -> ExampleT
         (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
          :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
         m
         [Result])
-> ExampleT
     (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
      :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
     m
     [Result]
forall (m :: * -> *) context a.
(MonadLoggerIO m, MonadUnliftIO m, MonadFail m,
 HasBaseContextMonad context m, HasFile context "kind",
 HasFile context "kubectl") =>
KindClusterOptions -> (KubernetesClusterContext -> m a) -> m a
withKindCluster KindClusterOptions
kindClusterOptions) SpecFree (KindContext context) m ()
SpecFree
  (LabelValue "kubernetesCluster" KubernetesClusterContext
   :> (LabelValue
         (AppendSymbol "file-" "kubectl") (EnvironmentFile "kubectl")
       :> (LabelValue
             (AppendSymbol "file-" "kind") (EnvironmentFile "kind")
           :> context)))
  m
  ()
spec

-- | Introduce a Kubernetes cluster using [kind](https://kind.sigs.k8s.io/), deriving the @kind@ and @kubectl@ binaries from the PATH.
introduceKindClusterViaEnvironment :: (
  HasBaseContext context, MonadUnliftIO m
  )
  -- | Options
  => KindClusterOptions
  -> SpecFree (KindContext context) m ()
  -> SpecFree context m ()
introduceKindClusterViaEnvironment :: forall context (m :: * -> *).
(HasBaseContext context, MonadUnliftIO m) =>
KindClusterOptions
-> SpecFree (KindContext context) m () -> SpecFree context m ()
introduceKindClusterViaEnvironment KindClusterOptions
kindClusterOptions SpecFree (KindContext 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 @"kind" (SpecFree
   (LabelValue (AppendSymbol "file-" "kind") (EnvironmentFile "kind")
    :> context)
   m
   ()
 -> SpecFree context m ())
-> SpecFree
     (LabelValue (AppendSymbol "file-" "kind") (EnvironmentFile "kind")
      :> context)
     m
     ()
-> SpecFree context m ()
forall a b. (a -> b) -> a -> b
$
    forall (a :: Symbol) context (m :: * -> *).
(MonadUnliftIO m, KnownSymbol a) =>
SpecFree
  (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
   :> context)
  m
  ()
-> SpecFree context m ()
introduceBinaryViaEnvironment @"kubectl" (SpecFree
   (LabelValue
      (AppendSymbol "file-" "kubectl") (EnvironmentFile "kubectl")
    :> (LabelValue
          (AppendSymbol "file-" "kind") (EnvironmentFile "kind")
        :> context))
   m
   ()
 -> SpecFree
      (LabelValue (AppendSymbol "file-" "kind") (EnvironmentFile "kind")
       :> context)
      m
      ())
-> SpecFree
     (LabelValue
        (AppendSymbol "file-" "kubectl") (EnvironmentFile "kubectl")
      :> (LabelValue
            (AppendSymbol "file-" "kind") (EnvironmentFile "kind")
          :> context))
     m
     ()
-> SpecFree
     (LabelValue (AppendSymbol "file-" "kind") (EnvironmentFile "kind")
      :> context)
     m
     ()
forall a b. (a -> b) -> a -> b
$
    String
-> Label "kubernetesCluster" KubernetesClusterContext
-> ((HasCallStack =>
     KubernetesClusterContext
     -> ExampleT
          (LabelValue
             (AppendSymbol "file-" "kubectl") (EnvironmentFile "kubectl")
           :> (LabelValue
                 (AppendSymbol "file-" "kind") (EnvironmentFile "kind")
               :> context))
          m
          [Result])
    -> ExampleT
         (LabelValue
            (AppendSymbol "file-" "kubectl") (EnvironmentFile "kubectl")
          :> (LabelValue
                (AppendSymbol "file-" "kind") (EnvironmentFile "kind")
              :> context))
         m
         ())
-> SpecFree
     (LabelValue "kubernetesCluster" KubernetesClusterContext
      :> (LabelValue
            (AppendSymbol "file-" "kubectl") (EnvironmentFile "kubectl")
          :> (LabelValue
                (AppendSymbol "file-" "kind") (EnvironmentFile "kind")
              :> context)))
     m
     ()
-> SpecFree
     (LabelValue
        (AppendSymbol "file-" "kubectl") (EnvironmentFile "kubectl")
      :> (LabelValue
            (AppendSymbol "file-" "kind") (EnvironmentFile "kind")
          :> 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 kind cluster" Label "kubernetesCluster" KubernetesClusterContext
kubernetesCluster (ExampleT
  (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
   :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
  m
  [Result]
-> ExampleT
     (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
      :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
     m
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExampleT
   (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
    :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
   m
   [Result]
 -> ExampleT
      (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
       :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
      m
      ())
-> ((KubernetesClusterContext
     -> ExampleT
          (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
           :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
          m
          [Result])
    -> ExampleT
         (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
          :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
         m
         [Result])
-> (KubernetesClusterContext
    -> ExampleT
         (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
          :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
         m
         [Result])
-> ExampleT
     (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
      :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
     m
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KindClusterOptions
-> (KubernetesClusterContext
    -> ExampleT
         (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
          :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
         m
         [Result])
-> ExampleT
     (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
      :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
     m
     [Result]
forall (m :: * -> *) context a.
(MonadLoggerIO m, MonadUnliftIO m, MonadFail m,
 HasBaseContextMonad context m, HasFile context "kind",
 HasFile context "kubectl") =>
KindClusterOptions -> (KubernetesClusterContext -> m a) -> m a
withKindCluster KindClusterOptions
kindClusterOptions) SpecFree (KindContext context) m ()
SpecFree
  (LabelValue "kubernetesCluster" KubernetesClusterContext
   :> (LabelValue
         (AppendSymbol "file-" "kubectl") (EnvironmentFile "kubectl")
       :> (LabelValue
             (AppendSymbol "file-" "kind") (EnvironmentFile "kind")
           :> context)))
  m
  ()
spec

-- | Introduce a Kubernetes cluster using [kind](https://kind.sigs.k8s.io/), passing in the @kind@ and @kubectl@ binaries.
introduceKindCluster' :: (
  HasBaseContext context, MonadUnliftIO m
  )
  -- | Path to kind binary
  => FilePath
  -- | Path to kubectl binary
  -> FilePath
  -> KindClusterOptions
  -> SpecFree (KindContext context) m ()
  -> SpecFree context m ()
introduceKindCluster' :: forall context (m :: * -> *).
(HasBaseContext context, MonadUnliftIO m) =>
String
-> String
-> KindClusterOptions
-> SpecFree (KindContext context) m ()
-> SpecFree context m ()
introduceKindCluster' String
kindBinary String
kubectlBinary KindClusterOptions
kindClusterOptions SpecFree (KindContext 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 @"kind" String
kindBinary (SpecFree
   (LabelValue (AppendSymbol "file-" "kind") (EnvironmentFile "kind")
    :> context)
   m
   ()
 -> SpecFree context m ())
-> SpecFree
     (LabelValue (AppendSymbol "file-" "kind") (EnvironmentFile "kind")
      :> context)
     m
     ()
-> SpecFree context m ()
forall a b. (a -> b) -> a -> b
$
    forall (a :: Symbol) context (m :: * -> *).
(MonadUnliftIO m, KnownSymbol a) =>
String
-> SpecFree
     (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a)
      :> context)
     m
     ()
-> SpecFree context m ()
introduceFile @"kubectl" String
kubectlBinary (SpecFree
   (LabelValue
      (AppendSymbol "file-" "kubectl") (EnvironmentFile "kubectl")
    :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
   m
   ()
 -> SpecFree
      (LabelValue "file-kind" (EnvironmentFile "kind") :> context) m ())
-> SpecFree
     (LabelValue
        (AppendSymbol "file-" "kubectl") (EnvironmentFile "kubectl")
      :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
     m
     ()
-> SpecFree
     (LabelValue "file-kind" (EnvironmentFile "kind") :> context) m ()
forall a b. (a -> b) -> a -> b
$
    String
-> Label "kubernetesCluster" KubernetesClusterContext
-> ((HasCallStack =>
     KubernetesClusterContext
     -> ExampleT
          (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
           :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
          m
          [Result])
    -> ExampleT
         (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
          :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
         m
         ())
-> SpecFree (KindContext context) m ()
-> SpecFree
     (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
      :> (LabelValue "file-kind" (EnvironmentFile "kind") :> 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 kind cluster" Label "kubernetesCluster" KubernetesClusterContext
kubernetesCluster (ExampleT
  (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
   :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
  m
  [Result]
-> ExampleT
     (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
      :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
     m
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExampleT
   (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
    :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
   m
   [Result]
 -> ExampleT
      (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
       :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
      m
      ())
-> ((KubernetesClusterContext
     -> ExampleT
          (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
           :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
          m
          [Result])
    -> ExampleT
         (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
          :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
         m
         [Result])
-> (KubernetesClusterContext
    -> ExampleT
         (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
          :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
         m
         [Result])
-> ExampleT
     (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
      :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
     m
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KindClusterOptions
-> (KubernetesClusterContext
    -> ExampleT
         (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
          :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
         m
         [Result])
-> ExampleT
     (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
      :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
     m
     [Result]
forall (m :: * -> *) context a.
(MonadLoggerIO m, MonadUnliftIO m, MonadFail m,
 HasBaseContextMonad context m, HasFile context "kind",
 HasFile context "kubectl") =>
KindClusterOptions -> (KubernetesClusterContext -> m a) -> m a
withKindCluster KindClusterOptions
kindClusterOptions) (SpecFree (KindContext context) m ()
 -> SpecFree
      (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
       :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
      m
      ())
-> SpecFree (KindContext context) m ()
-> SpecFree
     (LabelValue "file-kubectl" (EnvironmentFile "kubectl")
      :> (LabelValue "file-kind" (EnvironmentFile "kind") :> context))
     m
     ()
forall a b. (a -> b) -> a -> b
$
      SpecFree (KindContext context) m ()
spec

-- * Implementation

-- | Bracket-style variant of 'introduceKindCluster''.
withKindCluster :: (
  MonadLoggerIO m, MonadUnliftIO m, MonadFail m
  , HasBaseContextMonad context m, HasFile context "kind", HasFile context "kubectl"
  )
  -- | Options
  => KindClusterOptions
  -> (KubernetesClusterContext -> m a)
  -> m a
withKindCluster :: forall (m :: * -> *) context a.
(MonadLoggerIO m, MonadUnliftIO m, MonadFail m,
 HasBaseContextMonad context m, HasFile context "kind",
 HasFile context "kubectl") =>
KindClusterOptions -> (KubernetesClusterContext -> m a) -> m a
withKindCluster KindClusterOptions
opts KubernetesClusterContext -> m a
action = do
  kindBinary <- forall (a :: Symbol) context (m :: * -> *).
(MonadReader context m, HasFile context a) =>
m String
askFile @"kind"
  kubectlBinary <- askFile @"kubectl"
  withKindCluster' kindBinary kubectlBinary opts action

-- | Same as 'withKindCluster', but allows you to pass in the paths to the @kind@ and @kubectl@ binaries.
withKindCluster' :: (
  MonadLoggerIO m, MonadUnliftIO m, MonadFail m
  , HasBaseContextMonad context m
  )
  -- | Path to the kind binary
  => FilePath
  -- | Path to the kubectl binary
  -> FilePath
  -> KindClusterOptions
  -> (KubernetesClusterContext -> m a)
  -> m a
withKindCluster' :: forall (m :: * -> *) context a.
(MonadLoggerIO m, MonadUnliftIO m, MonadFail m,
 HasBaseContextMonad context m) =>
String
-> String
-> KindClusterOptions
-> (KubernetesClusterContext -> m a)
-> m a
withKindCluster' String
kindBinary String
kubectlBinary opts :: KindClusterOptions
opts@(KindClusterOptions {Int
[Text]
[ExtraPortMapping]
[ExtraMount]
Maybe Text
Map Text Text
KindClusterName
kindClusterNumNodes :: KindClusterOptions -> Int
kindClusterExtraFlags :: KindClusterOptions -> [Text]
kindClusterContainerLabels :: KindClusterOptions -> Map Text Text
kindClusterExtraPortMappings :: KindClusterOptions -> [ExtraPortMapping]
kindClusterExtraMounts :: KindClusterOptions -> [ExtraMount]
kindClusterName :: KindClusterOptions -> KindClusterName
kindClusterDriver :: KindClusterOptions -> Maybe Text
kindClusterNumNodes :: Int
kindClusterExtraFlags :: [Text]
kindClusterContainerLabels :: Map Text Text
kindClusterExtraPortMappings :: [ExtraPortMapping]
kindClusterExtraMounts :: [ExtraMount]
kindClusterName :: KindClusterName
kindClusterDriver :: Maybe Text
..}) KubernetesClusterContext -> m a
action = do
  clusterName <- case KindClusterName
kindClusterName of
    KindClusterNameExactly Text
t -> Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
t
    KindClusterNameAutogenerate Maybe Text
maybePrefix -> do
      let prefix :: Text
prefix = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"test-kind-cluster" Maybe Text
maybePrefix
      clusterID <- Int -> m Text
forall (m :: * -> *). MonadIO m => Int -> m Text
makeUUID' Int
5
      return [i|#{prefix}-#{clusterID}|]

  kc <- isInContainer >>= \case
    Bool
False -> Value -> m Value
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ Int -> Map Text Text -> [ExtraPortMapping] -> [ExtraMount] -> Value
kindConfig Int
kindClusterNumNodes Map Text Text
kindClusterContainerLabels [ExtraPortMapping]
kindClusterExtraPortMappings [ExtraMount]
kindClusterExtraMounts
    Bool
True -> Value -> m Value
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ Int -> Map Text Text -> [ExtraPortMapping] -> [ExtraMount] -> Value
kindConfig Int
kindClusterNumNodes Map Text Text
kindClusterContainerLabels [ExtraPortMapping]
kindClusterExtraPortMappings [ExtraMount]
kindClusterExtraMounts

  Just dir <- getCurrentFolder
  kindConfigFile <- liftIO $ writeTempFile dir "kind-config" (decodeUtf8 $ Yaml.encode kc)
  info [i|kindConfigFile: #{kindConfigFile}|]

  kindKubeConfigFile <- liftIO $ writeTempFile dir "kind-kube-config" ""

  environmentToUse <- case kindClusterDriver of
    Just Text
"docker" -> Maybe [(String, String)] -> m (Maybe [(String, String)])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [(String, String)]
forall a. Maybe a
Nothing
    Just Text
"podman" -> do
      baseEnvironment <- m [(String, String)]
forall (m :: * -> *). MonadIO m => m [(String, String)]
getEnvironment
      return $ Just (("KIND_EXPERIMENTAL_PROVIDER", "podman") : baseEnvironment)
    Just Text
x -> String -> m (Maybe [(String, String)])
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
expectationFailure [i|Unexpected driver: #{x}|]
    Maybe Text
Nothing -> Maybe [(String, String)] -> m (Maybe [(String, String)])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [(String, String)]
forall a. Maybe a
Nothing

  let driver = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"docker" Maybe Text
kindClusterDriver

  (bracket (startKindCluster kindBinary opts clusterName kindConfigFile kindKubeConfigFile environmentToUse driver)
           (\KubernetesClusterContext
_ -> do
               ps <- CreateProcess -> m ProcessHandle
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m, MonadLogger m) =>
CreateProcess -> m ProcessHandle
createProcessWithLogging ((String -> [String] -> CreateProcess
proc String
kindBinary [String
"delete", String
"cluster", String
"--name", Text -> String
forall a. ToString a => a -> String
toString Text
clusterName]) {
                                                  env = environmentToUse
                                                  })
               void $ waitForProcess ps
           ))
           (\KubernetesClusterContext
kcc -> m () -> m () -> m a -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> m b -> m c -> m c
bracket_ (KubernetesClusterContext
-> String -> String -> Maybe [(String, String)] -> Text -> m ()
forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
KubernetesClusterContext
-> String -> String -> Maybe [(String, String)] -> Text -> m ()
setUpKindCluster KubernetesClusterContext
kcc String
kindBinary String
kubectlBinary Maybe [(String, String)]
environmentToUse Text
driver)
                             (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                             (KubernetesClusterContext -> m a
action KubernetesClusterContext
kcc)
           )

startKindCluster :: (
  MonadLoggerIO m, MonadUnliftIO m
  ) => FilePath -> KindClusterOptions -> Text -> FilePath -> FilePath -> Maybe [(String, String)] -> Text -> m KubernetesClusterContext
startKindCluster :: forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
String
-> KindClusterOptions
-> Text
-> String
-> String
-> Maybe [(String, String)]
-> Text
-> m KubernetesClusterContext
startKindCluster String
kindBinary (KindClusterOptions {Int
[Text]
[ExtraPortMapping]
[ExtraMount]
Maybe Text
Map Text Text
KindClusterName
kindClusterNumNodes :: KindClusterOptions -> Int
kindClusterExtraFlags :: KindClusterOptions -> [Text]
kindClusterContainerLabels :: KindClusterOptions -> Map Text Text
kindClusterExtraPortMappings :: KindClusterOptions -> [ExtraPortMapping]
kindClusterExtraMounts :: KindClusterOptions -> [ExtraMount]
kindClusterName :: KindClusterOptions -> KindClusterName
kindClusterDriver :: KindClusterOptions -> Maybe Text
kindClusterNumNodes :: Int
kindClusterExtraFlags :: [Text]
kindClusterContainerLabels :: Map Text Text
kindClusterExtraPortMappings :: [ExtraPortMapping]
kindClusterExtraMounts :: [ExtraMount]
kindClusterName :: KindClusterName
kindClusterDriver :: Maybe Text
..}) Text
clusterName String
kindConfigFile String
kindKubeConfigFile Maybe [(String, String)]
environmentToUse Text
driver = do
  ps <- CreateProcess -> m ProcessHandle
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m, MonadLogger m) =>
CreateProcess -> m ProcessHandle
createProcessWithLogging ((String -> [String] -> CreateProcess
proc String
kindBinary [String
"create", String
"cluster", String
"-v", String
"1", String
"--name", Text -> String
forall a. ToString a => a -> String
toString Text
clusterName
                                                   , String
"--config", String
kindConfigFile
                                                   , String
"--kubeconfig", String
kindKubeConfigFile]) {
                                     delegate_ctlc = True
                                     , env = environmentToUse
                                     })
  void $ waitForProcess ps

  whenM isInContainer $
    callCommandWithLogging [i|#{kindBinary} get kubeconfig --internal --name #{clusterName} > "#{kindKubeConfigFile}"|]

  oidcCache <- newTVarIO mempty
  (m, c) <- liftIO $ mkKubeClientConfig oidcCache $ KubeConfigFile kindKubeConfigFile

  pure $ KubernetesClusterContext {
    kubernetesClusterName = toText clusterName
    , kubernetesClusterKubeConfigPath = kindKubeConfigFile
    , kubernetesClusterNumNodes = kindClusterNumNodes
    , kubernetesClusterClientConfig = (m, c)
    , kubernetesClusterType = KubernetesClusterKind kindBinary clusterName driver environmentToUse
    }