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

{-|
Helper module for working with Kubernetes namespaces.
-}

module Test.Sandwich.Contexts.Kubernetes.Namespace (
  withKubernetesNamespace
  , withKubernetesNamespace'
  , withKubernetesNamespace''
  , withKubernetesNamespace'''

  -- * Create a namespace
  , createKubernetesNamespace
  , createKubernetesNamespace'
  , createKubernetesNamespace''

  -- * Destroy a namespace
  , destroyKubernetesNamespace
  , destroyKubernetesNamespace'
  , destroyKubernetesNamespace''
  ) where

import Control.Monad
import Data.String.Interpolate
import Relude hiding (force)
import System.Exit
import Test.Sandwich
import Test.Sandwich.Contexts.Files
import Test.Sandwich.Contexts.Kubernetes.Kubectl
import Test.Sandwich.Contexts.Kubernetes.Types
import UnliftIO.Exception
import UnliftIO.Process


-- | Around-style node to create a Kubernetes namespace, and destroy it at the end.
--
-- If you're installing something via Helm 3, you may not need this as you can just pass @--create-namespace@.
withKubernetesNamespace :: (
  KubectlBasicWithoutReader context m
  )
  -- | Namespace to create
  => Text
  -> SpecFree context m ()
  -> SpecFree context m ()
withKubernetesNamespace :: forall context (m :: * -> *).
KubectlBasicWithoutReader context m =>
Text -> SpecFree context m () -> SpecFree context m ()
withKubernetesNamespace Text
namespace = String
-> (ExampleT context m [Result] -> ExampleT context m ())
-> SpecFree context m ()
-> SpecFree context m ()
forall context (m :: * -> *).
HasCallStack =>
String
-> (ExampleT context m [Result] -> ExampleT context m ())
-> SpecFree context m ()
-> SpecFree context m ()
around [i|Create the '#{namespace}' kubernetes namespace|]
  (ExampleT context m [Result] -> ExampleT context m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExampleT context m [Result] -> ExampleT context m ())
-> (ExampleT context m [Result] -> ExampleT context m [Result])
-> ExampleT context m [Result]
-> ExampleT context m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExampleT context m ()
-> ExampleT context m ()
-> ExampleT context m [Result]
-> ExampleT context m [Result]
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> m b -> m c -> m c
bracket_ (Text -> ExampleT context m ()
forall context (m :: * -> *).
KubectlBasic context m =>
Text -> m ()
createKubernetesNamespace Text
namespace) (Bool -> Text -> ExampleT context m ()
forall context (m :: * -> *).
KubectlBasic context m =>
Bool -> Text -> m ()
destroyKubernetesNamespace Bool
False Text
namespace))

-- | Same as 'withKubernetesNamespace', but works in an arbitrary monad with reader context.
withKubernetesNamespace' :: (
  KubectlBasic context m
  )
  -- | Namespace to create
  => Text
  -> m a
  -> m a
withKubernetesNamespace' :: forall context (m :: * -> *) a.
KubectlBasic context m =>
Text -> m a -> m a
withKubernetesNamespace' Text
namespace =
  m () -> m () -> m a -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> m b -> m c -> m c
bracket_ (Text -> m ()
forall context (m :: * -> *).
KubectlBasic context m =>
Text -> m ()
createKubernetesNamespace Text
namespace) (Bool -> Text -> m ()
forall context (m :: * -> *).
KubectlBasic context m =>
Bool -> Text -> m ()
destroyKubernetesNamespace Bool
False Text
namespace)

-- | Same as 'withKubernetesNamespace'', but allows you to pass in the path to the @kubectl@ binary.
withKubernetesNamespace'' :: (
  KubernetesClusterBasic context m
  )
  -- | Path to @kubectl@ binary
  => FilePath
  -- | Namespace to create
  -> Text
  -> m a
  -> m a
withKubernetesNamespace'' :: forall context (m :: * -> *) a.
KubernetesClusterBasic context m =>
String -> Text -> m a -> m a
withKubernetesNamespace'' String
kubectl Text
namespace =
  m () -> m () -> m a -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> m b -> m c -> m c
bracket_ (String -> Text -> m ()
forall context (m :: * -> *).
KubernetesClusterBasic context m =>
String -> Text -> m ()
createKubernetesNamespace' String
kubectl Text
namespace) (String -> Bool -> Text -> m ()
forall context (m :: * -> *).
KubernetesClusterBasic context m =>
String -> Bool -> Text -> m ()
destroyKubernetesNamespace' String
kubectl Bool
False Text
namespace)

-- | Same as 'withKubernetesNamespace''', but allows you to pass in the cluster context.
withKubernetesNamespace''' :: (
  KubernetesClusterBasic context m
  )
  -- | Cluster context
  => KubernetesClusterContext
  -- | Path to @kubectl@ binary
  -> FilePath
  -- | Namespace to create
  -> Text
  -> m a
  -> m a
withKubernetesNamespace''' :: forall context (m :: * -> *) a.
KubernetesClusterBasic context m =>
KubernetesClusterContext -> String -> Text -> m a -> m a
withKubernetesNamespace''' KubernetesClusterContext
kcc String
kubectl Text
namespace =
  m () -> m () -> m a -> m a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> m b -> m c -> m c
bracket_ (KubernetesClusterContext -> String -> Text -> m ()
forall context (m :: * -> *).
KubernetesClusterBasic context m =>
KubernetesClusterContext -> String -> Text -> m ()
createKubernetesNamespace'' KubernetesClusterContext
kcc String
kubectl Text
namespace) (KubernetesClusterContext -> String -> Bool -> Text -> m ()
forall context (m :: * -> *).
KubernetesClusterBasic context m =>
KubernetesClusterContext -> String -> Bool -> Text -> m ()
destroyKubernetesNamespace'' KubernetesClusterContext
kcc String
kubectl Bool
False Text
namespace)

-- | Create a Kubernetes namespace.
createKubernetesNamespace :: (
  KubectlBasic context m
  )
  -- | Namespace name
  => Text
  -> m ()
createKubernetesNamespace :: forall context (m :: * -> *).
KubectlBasic context m =>
Text -> m ()
createKubernetesNamespace Text
namespace =
  forall (a :: Symbol) context (m :: * -> *).
(MonadReader context m, HasFile context a) =>
m String
askFile @"kubectl" m String -> (String -> 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
>>= (String -> Text -> m ()) -> Text -> String -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Text -> m ()
forall context (m :: * -> *).
KubernetesClusterBasic context m =>
String -> Text -> m ()
createKubernetesNamespace' Text
namespace

-- | Create a Kubernetes namespace.
createKubernetesNamespace' :: (
  KubernetesClusterBasic context m
  )
  -- | Path to @kubectl@ binary
  => FilePath
  -- | Namespace name
  -> Text
  -> m ()
createKubernetesNamespace' :: forall context (m :: * -> *).
KubernetesClusterBasic context m =>
String -> Text -> m ()
createKubernetesNamespace' String
kubectl Text
namespace =
  Label "kubernetesCluster" KubernetesClusterContext
-> m KubernetesClusterContext
forall context (l :: Symbol) a (m :: * -> *).
(HasLabel context l a, MonadReader context m) =>
Label l a -> m a
getContext Label "kubernetesCluster" KubernetesClusterContext
kubernetesCluster m KubernetesClusterContext
-> (KubernetesClusterContext -> 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
>>= (\KubernetesClusterContext
kcc -> KubernetesClusterContext -> String -> Text -> m ()
forall context (m :: * -> *).
KubernetesClusterBasic context m =>
KubernetesClusterContext -> String -> Text -> m ()
createKubernetesNamespace'' KubernetesClusterContext
kcc String
kubectl Text
namespace)

-- | Destroy a Kubernetes namespace.
destroyKubernetesNamespace :: (
  KubectlBasic context m
  )
  -- | Whether to pass @--force@
  => Bool
  -- | Namespace name
  -> Text
  -> m ()
destroyKubernetesNamespace :: forall context (m :: * -> *).
KubectlBasic context m =>
Bool -> Text -> m ()
destroyKubernetesNamespace Bool
force Text
namespace =
  forall (a :: Symbol) context (m :: * -> *).
(MonadReader context m, HasFile context a) =>
m String
askFile @"kubectl" m String -> (String -> 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
>>= (\String
x -> String -> Bool -> Text -> m ()
forall context (m :: * -> *).
KubernetesClusterBasic context m =>
String -> Bool -> Text -> m ()
destroyKubernetesNamespace' String
x Bool
force Text
namespace)

-- | Destroy a Kubernetes namespace.
destroyKubernetesNamespace' :: (
  KubernetesClusterBasic context m
  )
  -- | Path to @kubectl@ binary
  => FilePath
  -- | Whether to pass @--force@
  -> Bool
  -- | Namespace name
  -> Text
  -> m ()
destroyKubernetesNamespace' :: forall context (m :: * -> *).
KubernetesClusterBasic context m =>
String -> Bool -> Text -> m ()
destroyKubernetesNamespace' String
kubectl Bool
force Text
namespace = do
  Label "kubernetesCluster" KubernetesClusterContext
-> m KubernetesClusterContext
forall context (l :: Symbol) a (m :: * -> *).
(HasLabel context l a, MonadReader context m) =>
Label l a -> m a
getContext Label "kubernetesCluster" KubernetesClusterContext
kubernetesCluster m KubernetesClusterContext
-> (KubernetesClusterContext -> 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
>>= (\KubernetesClusterContext
kcc -> KubernetesClusterContext -> String -> Bool -> Text -> m ()
forall context (m :: * -> *).
KubernetesClusterBasic context m =>
KubernetesClusterContext -> String -> Bool -> Text -> m ()
destroyKubernetesNamespace'' KubernetesClusterContext
kcc String
kubectl Bool
force Text
namespace)

-- | Create a Kubernetes namespace.
createKubernetesNamespace'' :: (
  KubernetesClusterBasic context m
  )
  -- | Cluster context
  => KubernetesClusterContext
  -- | Path to @kubectl@ binary
  -> FilePath
  -- | Namespace name
  -> Text
  -> m ()
createKubernetesNamespace'' :: forall context (m :: * -> *).
KubernetesClusterBasic context m =>
KubernetesClusterContext -> String -> Text -> m ()
createKubernetesNamespace'' KubernetesClusterContext
kcc String
kubectl Text
namespace = do
  let args :: [String]
args = [String
"create", String
"namespace", Text -> String
forall a. ToString a => a -> String
toString Text
namespace]
  env <- KubernetesClusterContext -> m [(String, String)]
forall (m :: * -> *).
MonadLoggerIO m =>
KubernetesClusterContext -> m [(String, String)]
getKubectlEnvironment KubernetesClusterContext
kcc
  createProcessWithLogging ((proc kubectl args) { env = Just env, delegate_ctlc = True })
    >>= waitForProcess >>= (`shouldBe` ExitSuccess)

-- | Destroy a Kubernetes namespace.
destroyKubernetesNamespace'' :: (
  KubernetesClusterBasic context m
  )
  -- | Cluster context
  => KubernetesClusterContext
  -- | Path to @kubectl@ binary
  -> FilePath
  -- | Whether to pass @--force@
  -> Bool
  -- | Namespace name
  -> Text
  -> m ()
destroyKubernetesNamespace'' :: forall context (m :: * -> *).
KubernetesClusterBasic context m =>
KubernetesClusterContext -> String -> Bool -> Text -> m ()
destroyKubernetesNamespace'' KubernetesClusterContext
kcc String
kubectl Bool
force Text
namespace = do
  let args :: [String]
args = [String
"delete", String
"namespace", Text -> String
forall a. ToString a => a -> String
toString Text
namespace]
           [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> if Bool
force then [String
"--force"] else []
  env <- KubernetesClusterContext -> m [(String, String)]
forall (m :: * -> *).
MonadLoggerIO m =>
KubernetesClusterContext -> m [(String, String)]
getKubectlEnvironment KubernetesClusterContext
kcc
  createProcessWithLogging ((proc kubectl args) { env = Just env, delegate_ctlc = True })
    >>= waitForProcess >>= (`shouldBe` ExitSuccess)