Skip to content

Commit

Permalink
sandwich-contexts-kubernetes: working on updated minio that pre-loads…
Browse files Browse the repository at this point in the history
… images
  • Loading branch information
thomasjm committed Aug 2, 2024
1 parent 5682a11 commit fdced4e
Show file tree
Hide file tree
Showing 12 changed files with 303 additions and 185 deletions.
27 changes: 5 additions & 22 deletions demos/demo-kubernetes-minikube/app/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,6 @@

module Main where

import Control.Concurrent
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Logger
Expand All @@ -24,6 +23,7 @@ import Test.Sandwich.Contexts.Kubernetes.MinioS3Server
import Test.Sandwich.Contexts.Kubernetes.Namespace
import Test.Sandwich.Contexts.Nix
import Test.Sandwich.Contexts.Waits
import UnliftIO.Concurrent
import UnliftIO.Environment
import UnliftIO.Process

Expand All @@ -42,8 +42,7 @@ spec = describe "Introducing a Kubernetes cluster" $ do
forM_ images $ \image -> info [i|Image: #{image}|]

introduceBinaryViaNixPackage @"kubectl" "kubectl" $
introduceBinaryViaNixDerivation @"kubectl-minio" kubectlMinioDerivation $
introduceMinioOperator $ do
introduceMinioOperator defaultMinioOperatorOptions $ do
it "Has a MinIO operator" $ do
moc <- getContext minioOperator
info [i|Got MinIO operator: #{moc}|]
Expand All @@ -61,29 +60,13 @@ spec = describe "Introducing a Kubernetes cluster" $ do
p <- createProcessWithLogging ((proc kubectlBinary args) { env = Just env, delegate_ctlc = True })
waitForProcess p >>= (`shouldBe` ExitSuccess)

introduceK8SMinioS3Server "foo" $ do
introduceK8SMinioS3Server (defaultMinioS3ServerOptions "foo") $ do
it "has a MinIO S3 server" $ do
serv <- getContext testS3Server
info [i|Got test S3 server: #{serv}|]

kubectlMinioDerivation :: Text
kubectlMinioDerivation = [i|
{ fetchurl
}:

fetchurl {
url = "https://github.com/minio/operator/releases/download/v5.0.6/kubectl-minio_5.0.6_linux_amd64";
hash = "sha256-j3mpgV1HLmFwYRdxfPXT1XzDWeiyQC2Ye8aeZt511bc=";

downloadToTemp = true;
executable = true;

postFetch = ''
mkdir -p $out/bin
mv "$downloadedFile" $out/bin/kubectl-minio
'';
}
|]
it "pauses" $ do
threadDelay 9999999999999


main :: IO ()
Expand Down
Original file line number Diff line number Diff line change
@@ -0,0 +1,47 @@
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeOperators #-}

module Test.Sandwich.Contexts.Kubernetes.FindImages (
findAllImages
, findAllImages'
) where

import Control.Lens
import Data.Aeson (FromJSON)
import Data.Text as T
import qualified Data.Yaml as Yaml
import Kubernetes.OpenAPI.Model as Kubernetes
import Kubernetes.OpenAPI.ModelLens as Kubernetes
import Relude


-- | Find all image references in a chunk of YAML containing multiple sections
findAllImages :: Text -> [Text]
findAllImages = Relude.concatMap findAllImages' . T.splitOn "---\n"

-- | Find all image references in a single chunk of YAML
findAllImages' :: Text -> [Text]
findAllImages' (decode -> Right x@(V1Pod {})) = maybe [] imagesFromPodSpec (v1PodSpec x)
findAllImages' (decode -> Right x@(V1Deployment {})) = maybe [] imagesFromPodSpec maybePodSpec
where
maybePodSpec :: Maybe V1PodSpec
maybePodSpec = x ^? (v1DeploymentSpecL . _Just . v1DeploymentSpecTemplateL . v1PodTemplateSpecSpecL . _Just)
findAllImages' (decode -> Right x@(V1StatefulSet {})) = maybe [] imagesFromPodSpec maybePodSpec
where
maybePodSpec :: Maybe V1PodSpec
maybePodSpec = x ^? (v1StatefulSetSpecL . _Just . v1StatefulSetSpecTemplateL . v1PodTemplateSpecSpecL . _Just)
findAllImages' (decode -> Right x@(V1DaemonSet {})) = maybe [] imagesFromPodSpec maybePodSpec
where
maybePodSpec :: Maybe V1PodSpec
maybePodSpec = x ^? (v1DaemonSetSpecL . _Just . v1DaemonSetSpecTemplateL . v1PodTemplateSpecSpecL . _Just)
findAllImages' _ = []

imagesFromPodSpec :: V1PodSpec -> [Text]
imagesFromPodSpec x = mapMaybe v1ContainerImage allContainers
where
allContainers = x ^. v1PodSpecContainersL <> fromMaybe [] (x ^. v1PodSpecInitContainersL)

decode :: FromJSON a => Text -> Either Yaml.ParseException a
decode = Yaml.decodeEither' . encodeUtf8
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,9 @@ module Test.Sandwich.Contexts.Kubernetes.Images (

, introduceImages

, findAllImages
, findAllImages'

, ImageLoadSpec(..)
, ImagePullPolicy(..)
) where
Expand All @@ -28,6 +31,7 @@ import Data.String.Interpolate
import Data.Text as T
import Relude
import Test.Sandwich
import Test.Sandwich.Contexts.Kubernetes.FindImages
import qualified Test.Sandwich.Contexts.Kubernetes.KindCluster.Images as Kind
import qualified Test.Sandwich.Contexts.Kubernetes.MinikubeCluster.Images as Minikube
import Test.Sandwich.Contexts.Kubernetes.Types
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -22,27 +22,24 @@ runWithKubectl :: (
MonadLoggerIO m
, HasBaseContextMonad context m, HasFile context "kubectl", HasKubernetesClusterContext context
)
-- | Callback receiving the kubectl binary and env.
=> (FilePath -> [(String, String)] -> m a)
-> m a
runWithKubectl cb = do
-- | Return the kubectl binary and env.
=> m (FilePath, [(String, String)])
runWithKubectl = do
kcc <- getContext kubernetesCluster
kubectlBinary <- askFile @"kubectl"
runWithKubectl' kcc kubectlBinary cb
runWithKubectl' kcc kubectlBinary

runWithKubectl' :: (
MonadLoggerIO m
, HasBaseContextMonad context m
)
-- | Kubernetes cluster context
=> KubernetesClusterContext
-- | Binary path for kubectl
-- | Path to kubectl binary
-> FilePath
-- | Callback receiving the kubectl binary and env.
-> (FilePath -> [(String, String)] -> m a)
-> m a
runWithKubectl' (KubernetesClusterContext {..}) kubectlBinary cb = do
-- | Return the kubectl binary and env.
-> m (FilePath, [(String, String)])
runWithKubectl' (KubernetesClusterContext {..}) kubectlBinary = do
baseEnv <- getEnvironment
let env = L.nubBy (\x y -> fst x == fst y) (("KUBECONFIG", kubernetesClusterKubeConfigPath) : baseEnv)

cb kubectlBinary env
return (kubectlBinary, env)
Original file line number Diff line number Diff line change
Expand Up @@ -15,69 +15,80 @@ module Test.Sandwich.Contexts.Kubernetes.MinioOperator (
-- * Types
, minioOperator
, MinioOperatorContext(..)
, MinioOperatorOptions(..)
, defaultMinioOperatorOptions
, HasMinioOperatorContext
) where

import Control.Monad
import Control.Monad.IO.Unlift
import Control.Monad.Logger
import qualified Data.List as L
import Relude
import System.Exit
import System.FilePath
import Test.Sandwich
import Test.Sandwich.Contexts.Files
import Test.Sandwich.Contexts.Kubernetes.FindImages
import Test.Sandwich.Contexts.Kubernetes.Images
import Test.Sandwich.Contexts.Kubernetes.Kubectl
import Test.Sandwich.Contexts.Kubernetes.Types
import UnliftIO.Environment
import UnliftIO.Exception
import UnliftIO.Process


data MinioOperatorOptions = MinioOperatorOptions {
minioOperatorPreloadImages :: Bool
}
defaultMinioOperatorOptions :: MinioOperatorOptions
defaultMinioOperatorOptions = MinioOperatorOptions {
minioOperatorPreloadImages = True
}

-- | Install the MinIO Kubernetes plugin onto a Kubernetes cluster.
-- See the docs [here](https://min.io/docs/minio/kubernetes/upstream/reference/kubectl-minio-plugin.html).
introduceMinioOperator :: (
MonadUnliftIO m, HasKubernetesClusterContext context, HasFile context "kubectl", HasFile context "kubectl-minio"
) => SpecFree (LabelValue "minioOperator" MinioOperatorContext :> context) m () -> SpecFree context m ()
introduceMinioOperator = introduceWith "introduce MinIO operator" minioOperator $ \action -> do
MonadUnliftIO m, HasBaseContext context, HasKubernetesClusterContext context, HasFile context "kubectl"
) => MinioOperatorOptions -> SpecFree (LabelValue "minioOperator" MinioOperatorContext :> context) m () -> SpecFree context m ()
introduceMinioOperator options = introduceWith "introduce MinIO operator" minioOperator $ \action -> do
kcc <- getContext kubernetesCluster
void $ withMinioOperator kcc action
void $ withMinioOperator options kcc action

-- | Same as 'introduceMinioOperator', but allows you to pass in the "kubectl-minio" binary path.
-- | Same as 'introduceMinioOperator', but allows you to pass in the "kubectl" binary path.
introduceMinioOperator' :: (
MonadUnliftIO m, HasKubernetesClusterContext context
) => FilePath -> FilePath -> SpecFree (LabelValue "minioOperator" MinioOperatorContext :> context) m () -> SpecFree context m ()
introduceMinioOperator' kubectlBinary kubectlMinioBinary = introduceWith "introduce MinIO operator" minioOperator $ \action -> do
MonadUnliftIO m, MonadFail m, HasKubernetesClusterContext context, HasBaseContext context
) => MinioOperatorOptions -> FilePath -> SpecFree (LabelValue "minioOperator" MinioOperatorContext :> context) m () -> SpecFree context m ()
introduceMinioOperator' options kubectlBinary = introduceWith "introduce MinIO operator" minioOperator $ \action -> do
kcc <- getContext kubernetesCluster
void $ withMinioOperator' kubectlBinary kubectlMinioBinary kcc action
void $ withMinioOperator' options kubectlBinary kcc action

-- | Bracket-style variant of 'introduceMinioOperator'.
withMinioOperator :: (
MonadLoggerIO m, MonadUnliftIO m, MonadReader context m, HasFile context "kubectl", HasFile context "kubectl-minio"
) => KubernetesClusterContext -> (MinioOperatorContext -> m a) -> m a
withMinioOperator kcc action = do
MonadLoggerIO m, MonadUnliftIO m, MonadFail m
, HasBaseContextMonad context m, HasFile context "kubectl"
) => MinioOperatorOptions -> KubernetesClusterContext -> (MinioOperatorContext -> m a) -> m a
withMinioOperator options kcc action = do
kubectlBinary <- askFile @"kubectl"
kubectlMinioBinary <- askFile @"kubectl-minio"
withMinioOperator' kubectlBinary kubectlMinioBinary kcc action
withMinioOperator' options kubectlBinary kcc action

-- | Same as 'withMinioOperator', but allows you to pass in the "kubectl-minio" binary path.
-- | Same as 'withMinioOperator', but allows you to pass in the "kubectl" binary path.
withMinioOperator' :: (
MonadLoggerIO m, MonadUnliftIO m
) => FilePath -> FilePath -> KubernetesClusterContext -> (MinioOperatorContext -> m a) -> m a
withMinioOperator' kubectlBinary kubectlMinioBinary (KubernetesClusterContext {..}) action = do
baseEnv <- getEnvironment
MonadLoggerIO m, MonadUnliftIO m, MonadFail m
, HasBaseContextMonad context m
) => MinioOperatorOptions -> FilePath -> KubernetesClusterContext -> (MinioOperatorContext -> m a) -> m a
withMinioOperator' (MinioOperatorOptions {..}) kubectlBinary kcc action = do
(_, env) <- runWithKubectl' kcc kubectlBinary

allYaml <- readCreateProcessWithLogging ((proc kubectlBinary ["kustomize", "github.com/minio/operator?ref=v6.0.1"]) { env = Just env }) ""

let basePathParts = maybe [] splitSearchPath (L.lookup "PATH" baseEnv)
when minioOperatorPreloadImages $ do
let images = findAllImages (toText allYaml)

let newPath = L.intercalate [searchPathSeparator] ((takeDirectory kubectlBinary) : basePathParts)
forM_ images $ \image ->
loadImageIfNecessary' kcc (ImageLoadSpecDocker image IfNotPresent)

let env = L.nubBy (\x y -> fst x == fst y) (("PATH", newPath) : ("KUBECONFIG", kubernetesClusterKubeConfigPath) : baseEnv)
let create = createProcessWithLoggingAndStdin ((proc kubectlBinary ["apply", "-f", "-"]) { env = Just env }) allYaml
>>= waitForProcess >>= (`shouldBe` ExitSuccess)

let runWithKubeConfig exe args = do
p <- createProcessWithLogging ((proc exe args) { env = Just env, delegate_ctlc = True })
code <- waitForProcess p
code `shouldBe` ExitSuccess
let destroy = createProcessWithLoggingAndStdin ((proc kubectlBinary ["delete", "-f", "-"]) { env = Just env }) allYaml
>>= waitForProcess >>= (`shouldBe` ExitSuccess)

bracket_ (runWithKubeConfig kubectlMinioBinary ["init"])
-- Can't delete -f yet; see https://github.com/minio/operator/issues/1683
(return ()) -- (runWithKubeConfig kubectlMinioBinary ["delete"])
(action MinioOperatorContext)
bracket_ create destroy (action MinioOperatorContext)
Loading

0 comments on commit fdced4e

Please sign in to comment.