sandwich-contexts-kubernetes: starting to work on haddocks

sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Cluster.hs

@@ -3,6 +3,14 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE TypeApplications #-}
 
+{-|
+
+This is the main module for creating and working with Kubernetes clusters. You can create clusters with either Kind or Minikube, obtaining the relevant binary from either the current PATH or from Nix.
+
+The module also contains functions for waiting for pods and services to exist, running commands with Kubectl, logging, service forwarding, and port forwarding.
+
+-}
+
 module Test.Sandwich.Contexts.Kubernetes.Cluster (
   -- * Kind clusters
   Kind.introduceKindClusterViaNix
@@ -20,8 +28,8 @@ module Test.Sandwich.Contexts.Kubernetes.Cluster (
   , waitForServiceEndpointsToExist
 
   -- * Run commands with kubectl
-  , runWithKubectl
-  , runWithKubectl'
+  , askKubectlArgs
+  , askKubectlEnvironment
 
   -- * Forward services
   , withForwardKubernetesService

sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Images.hs

@@ -124,7 +124,7 @@ loadImageIfNecessary' kcc imageLoadSpec = do
   unlessM (imageLoadSpecToImageName imageLoadSpec >>= clusterContainsImage' kcc) $
     void $ loadImage' kcc imageLoadSpec
 
--- | Load an image into a Kubernetes cluster. The image you pass may be an absolute path to a .tar or .tar.gz
+-- | Load an image into a Kubernetes cluster. The image you pass may be an absolute path to a @.tar@ or @.tar.gz@
 -- image archive, *or* the name of an image in your local Docker daemon. It will load the image onto the cluster,
 -- and return the modified image name (i.e. the name by which the cluster knows the image).
 loadImage :: (

sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/KataContainers.hs

@@ -120,7 +120,7 @@ withKataContainers' kcc@(KubernetesClusterContext {..}) kubectlBinary options@(K
 
   info [i|kataRoot: #{kataRoot}|]
 
-  (_, env) <- runWithKubectl' kcc kubectlBinary
+  env <- askKubectlEnvironment kcc
 
   -- Now follow the instructions from
   -- https://github.com/kata-containers/kata-containers/blob/main/docs/install/minikube-installation-guide.md#installing-kata-containers

sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Kubectl.hs

@@ -1,12 +1,14 @@
-{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE GADTs #-}
 {-# LANGUAGE TypeApplications #-}
 
+{-|
+Helper module for working with @kubectl@ processes.
+-}
+
 module Test.Sandwich.Contexts.Kubernetes.Kubectl (
   -- * Run commands with kubectl
-  runWithKubectl
-  , runWithKubectl'
+  askKubectlArgs
+  , askKubectlEnvironment
   ) where
 
 import Control.Monad.Logger
@@ -18,28 +20,29 @@ import Test.Sandwich.Contexts.Kubernetes.Types
 import UnliftIO.Environment
 
 
-runWithKubectl :: (
+-- | Retrieve the @kubectl@ binary path and the set of environment variables to use when invoking it.
+-- Derives these from a 'HasFile' context and the 'KubernetesClusterContext' respectively.
+--
+-- Useful for running Kubectl commands with 'System.Process.createProcess' etc.
+askKubectlArgs :: (
   MonadLoggerIO m
   , HasBaseContextMonad context m, HasFile context "kubectl", HasKubernetesClusterContext context
   )
-  -- | Return the kubectl binary and env.
+  -- | Returns the @kubectl@ binary and environment variables.
   => m (FilePath, [(String, String)])
-runWithKubectl = do
+askKubectlArgs = do
   kcc <- getContext kubernetesCluster
   kubectlBinary <- askFile @"kubectl"
-  runWithKubectl' kcc kubectlBinary
+  (kubectlBinary, ) <$> askKubectlEnvironment kcc
 
-runWithKubectl' :: (
+-- | Same as 'askKubectlArgs', but only returns the environment variables.
+askKubectlEnvironment :: (
   MonadLoggerIO m
   )
   -- | Kubernetes cluster context
   => KubernetesClusterContext
-  -- | Path to kubectl binary
-  -> FilePath
-  -- | Return the kubectl binary and env.
-  -> m (FilePath, [(String, String)])
-runWithKubectl' (KubernetesClusterContext {..}) kubectlBinary = do
+  -- | Returns the @kubectl@ binary and environment variables.
+  -> m [(String, String)]
+askKubectlEnvironment (KubernetesClusterContext {..}) = do
   baseEnv <- getEnvironment
-  let env = L.nubBy (\x y -> fst x == fst y) (("KUBECONFIG", kubernetesClusterKubeConfigPath) : baseEnv)
-
-  return (kubectlBinary, env)
+  return $ L.nubBy (\x y -> fst x == fst y) (("KUBECONFIG", kubernetesClusterKubeConfigPath) : baseEnv)

sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/MinioOperator.hs

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

sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/MinioS3Server.hs

@@ -124,7 +124,7 @@ withK8SMinioS3Server' :: forall m context. (
   -> (TestS3Server -> m [Result])
   -> m ()
 withK8SMinioS3Server' kubectlBinary kcc@(KubernetesClusterContext {..}) MinioOperatorContext (MinioS3ServerOptions {..}) action = do
-  (_, env) <- runWithKubectl' kcc kubectlBinary
+  env <- askKubectlEnvironment kcc
   let runWithKubeConfig :: (HasCallStack) => String -> [String] -> m ()
       runWithKubeConfig prog args = do
         createProcessWithLogging ((proc prog args) { env = Just env, delegate_ctlc = True })

sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Namespace.hs

@@ -63,7 +63,7 @@ createKubernetesNamespace :: (
   ) => Text -> m ()
 createKubernetesNamespace namespace = do
   let args = ["create", "namespace", toString namespace]
-  (kubectl, env) <- runWithKubectl
+  (kubectl, env) <- askKubectlArgs
   createProcessWithLogging ((proc kubectl args) { env = Just env, delegate_ctlc = True })
     >>= waitForProcess >>= (`shouldBe` ExitSuccess)
 
@@ -77,6 +77,6 @@ destroyKubernetesNamespace :: (
 destroyKubernetesNamespace force namespace = do
   let args = ["delete", "namespace", toString namespace]
            <> if force then ["--force"] else []
-  (kubectl, env) <- runWithKubectl
+  (kubectl, env) <- askKubectlArgs
   createProcessWithLogging ((proc kubectl args) { env = Just env, delegate_ctlc = True })
     >>= waitForProcess >>= (`shouldBe` ExitSuccess)

sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/Types.hs

@@ -55,7 +55,7 @@ data ImagePullPolicy = Always | IfNotPresent | Never
   deriving (Show, Eq)
 
 data ImageLoadSpec =
-  -- | A .tar or .tar.gz file
+  -- | A @.tar@ or @.tar.gz@ file
   ImageLoadSpecTarball FilePath
   -- | An image pulled via Docker
   | ImageLoadSpecDocker { imageName :: Text

sandwich-contexts-kubernetes/test/Spec.hs

@@ -102,7 +102,7 @@ loadImageTests' = do
     -- withKubernetesNamespace' (toText namespace) $
     let namespace = "default"
 
-    (kubectlBinary, env) <- runWithKubectl
+    (kubectlBinary, env) <- askKubectlArgs
 
     -- Wait for service account to exist; see
     -- https://github.com/kubernetes/kubernetes/issues/66689