sandwich-contexts-kubernetes 0.1.1.1 → 0.1.2.0

raw patch · 7 files changed

+123/−15 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• lib/Test/Sandwich/Contexts/Kubernetes.hs +1/−0
• lib/Test/Sandwich/Contexts/Kubernetes/KataContainers.hs +1/−1
• lib/Test/Sandwich/Contexts/Kubernetes/Kubectl.hs +14/−3
• lib/Test/Sandwich/Contexts/Kubernetes/MinioOperator.hs +1/−1
• lib/Test/Sandwich/Contexts/Kubernetes/MinioS3Server.hs +2/−1
• lib/Test/Sandwich/Contexts/Kubernetes/Namespace.hs +103/−8
• sandwich-contexts-kubernetes.cabal +1/−1

@@ -36,6 +36,7 @@   -- * Run commands with kubectl   , askKubectlArgs   , askKubectlEnvironment+  , getKubectlEnvironment    -- * Forward services   , withForwardKubernetesService

@@ -151,7 +151,7 @@    info [i|kataRoot: #{kataRoot}|] -  env <- askKubectlEnvironment kcc+  env <- getKubectlEnvironment kcc    -- Now follow the instructions from   -- https://github.com/kata-containers/kata-containers/blob/main/docs/install/minikube-installation-guide.md#installing-kata-containers

@@ -9,6 +9,7 @@   -- * Run commands with kubectl   askKubectlArgs   , askKubectlEnvironment+  , getKubectlEnvironment   ) where  import Control.Monad.Logger@@ -30,18 +31,28 @@   -- | Returns the @kubectl@ binary and environment variables.   => m (FilePath, [(String, String)]) askKubectlArgs = do-  kcc <- getContext kubernetesCluster   kubectlBinary <- askFile @"kubectl"-  (kubectlBinary, ) <$> askKubectlEnvironment kcc+  (kubectlBinary, ) <$> askKubectlEnvironment  -- | Same as 'askKubectlArgs', but only returns the environment variables. askKubectlEnvironment :: (+  KubernetesClusterBasic context m+  )+  -- | Returns the @kubectl@ environment variables.+  => m [(String, String)]+askKubectlEnvironment = do+  KubernetesClusterContext {..} <- getContext kubernetesCluster+  baseEnv <- getEnvironment+  return $ L.nubBy (\x y -> fst x == fst y) (("KUBECONFIG", kubernetesClusterKubeConfigPath) : baseEnv)++-- | Same as 'askKubectlArgs', but only returns the environment variables.+getKubectlEnvironment :: (   MonadLoggerIO m   )   -- | Kubernetes cluster context   => KubernetesClusterContext   -- | Returns the @kubectl@ environment variables.   -> m [(String, String)]-askKubectlEnvironment (KubernetesClusterContext {..}) = do+getKubectlEnvironment (KubernetesClusterContext {..}) = do   baseEnv <- getEnvironment   return $ L.nubBy (\x y -> fst x == fst y) (("KUBECONFIG", kubernetesClusterKubeConfigPath) : baseEnv)

@@ -114,7 +114,7 @@   -> (MinioOperatorContext -> m a)   -> m a withMinioOperator' kubectlBinary (MinioOperatorOptions {..}) kcc action = do-  env <- askKubectlEnvironment kcc+  env <- getKubectlEnvironment kcc    allYaml <- readCreateProcessWithLogging ((proc kubectlBinary ["kustomize", "github.com/minio/operator?ref=v6.0.1"]) { env = Just env }) "" 

@@ -27,6 +27,7 @@   , testS3Server   , TestS3Server(..)   , HasTestS3Server+  , NetworkAddress(..)   ) where  import Control.Monad@@ -137,7 +138,7 @@   -> (TestS3Server -> m [Result])   -> m () withK8SMinioS3Server' kubectlBinary kcc@(KubernetesClusterContext {..}) MinioOperatorContext (MinioS3ServerOptions {..}) action = do-  env <- askKubectlEnvironment kcc+  env <- getKubectlEnvironment kcc   let runWithKubeConfig :: (HasCallStack) => String -> [String] -> m ()       runWithKubeConfig prog args = do         createProcessWithLogging ((proc prog args) { env = Just env, delegate_ctlc = True })

@@ -11,9 +11,18 @@ 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@@ -21,6 +30,7 @@ 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@@ -48,8 +58,37 @@   => Text   -> m a   -> m a-withKubernetesNamespace' namespace = bracket_ (createKubernetesNamespace namespace) (destroyKubernetesNamespace False namespace)+withKubernetesNamespace' namespace =+  bracket_ (createKubernetesNamespace namespace) (destroyKubernetesNamespace False 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'' kubectl namespace =+  bracket_ (createKubernetesNamespace' kubectl namespace) (destroyKubernetesNamespace' kubectl False namespace)++-- | Same as 'withKubernetesNamespace''', but allows you to pass in the path to the cluster context.+withKubernetesNamespace''' :: (+  KubernetesClusterBasic context m+  )+  -- | Cluster context+  => KubernetesClusterContext+  -- | Path to @kubectl@ binary+  -> FilePath+  -- | Namespace to create+  -> Text+  -> m a+  -> m a+withKubernetesNamespace''' kcc kubectl namespace =+  bracket_ (createKubernetesNamespace'' kcc kubectl namespace) (destroyKubernetesNamespace'' kcc kubectl False namespace)+ -- | Create a Kubernetes namespace. createKubernetesNamespace :: (   KubectlBasic context m@@ -57,12 +96,21 @@   -- | Namespace name   => Text   -> m ()-createKubernetesNamespace namespace = do-  let args = ["create", "namespace", toString namespace]-  (kubectl, env) <- askKubectlArgs-  createProcessWithLogging ((proc kubectl args) { env = Just env, delegate_ctlc = True })-    >>= waitForProcess >>= (`shouldBe` ExitSuccess)+createKubernetesNamespace namespace =+  askFile @"kubectl" >>= flip createKubernetesNamespace' namespace +-- | Create a Kubernetes namespace.+createKubernetesNamespace' :: (+  KubernetesClusterBasic context m+  )+  -- | Path to @kubectl@ binary+  => FilePath+  -- | Namespace name+  -> Text+  -> m ()+createKubernetesNamespace' kubectl namespace =+  getContext kubernetesCluster >>= (\kcc -> createKubernetesNamespace'' kcc kubectl namespace)+ -- | Destroy a Kubernetes namespace. destroyKubernetesNamespace :: (   KubectlBasic context m@@ -72,9 +120,56 @@   -- | Namespace name   -> Text   -> m ()-destroyKubernetesNamespace force namespace = do+destroyKubernetesNamespace force namespace =+  askFile @"kubectl" >>= (\x -> destroyKubernetesNamespace' x force namespace)++-- | Destroy a Kubernetes namespace.+destroyKubernetesNamespace' :: (+  KubernetesClusterBasic context m+  )+  -- | Path to @kubectl@ binary+  => FilePath+  -- | Whether to pass @--force@+  -> Bool+  -- | Namespace name+  -> Text+  -> m ()+destroyKubernetesNamespace' kubectl force namespace = do+  getContext kubernetesCluster >>= (\kcc -> destroyKubernetesNamespace'' kcc kubectl force namespace)++-- | Create a Kubernetes namespace.+createKubernetesNamespace'' :: (+  KubernetesClusterBasic context m+  )+  -- | Cluster context+  => KubernetesClusterContext+  -- | Path to @kubectl@ binary+  -> FilePath+  -- | Namespace name+  -> Text+  -> m ()+createKubernetesNamespace'' kcc kubectl namespace = do+  let args = ["create", "namespace", toString namespace]+  env <- getKubectlEnvironment 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'' kcc kubectl force namespace = do   let args = ["delete", "namespace", toString namespace]            <> if force then ["--force"] else []-  (kubectl, env) <- askKubectlArgs+  env <- getKubectlEnvironment kcc   createProcessWithLogging ((proc kubectl args) { env = Just env, delegate_ctlc = True })     >>= waitForProcess >>= (`shouldBe` ExitSuccess)

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           sandwich-contexts-kubernetes-version:        0.1.1.1+version:        0.1.2.0 synopsis:       Sandwich test contexts for Kubernetes description:    Please see README.md author:         Tom McLaughlin