Separate demo-kubernetes-kind from demo-kubernetes-minikube, make MinioS3Server.hs create a NetworkPolicy

demos/demo-kubernetes-kind/app/Main.hs

@@ -28,7 +28,7 @@ spec = describe "Introducing a Kubernetes cluster" $ do
   describe "Via kind" $ do
     introduceNixContext nixpkgsReleaseDefault $ do
       introduceKindClusterViaNix defaultKindClusterOptions $ do
-        it "prints the Kind cluster info" $ do
+        it "prints the cluster info" $ do
           kcc <- getContext kubernetesCluster
           info [i|Got Kubernetes cluster context: #{kcc}|]
 

demos/demo-kubernetes-kind/demo-kubernetes-kind.cabal

@@ -4,16 +4,16 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 
-name:           demo-kubernetes
+name:           demo-kubernetes-kind
 version:        0.1.0.0
 license:        BSD3
 license-file:   LICENSE
 build-type:     Simple
 
-executable demo-kubernetes
+executable demo-kubernetes-kind
   main-is: Main.hs
   other-modules:
-      Paths_demo_kubernetes
+      Paths_demo_kubernetes_kind
   hs-source-dirs:
       app
   default-extensions:

demos/demo-kubernetes-kind/package.yaml

@@ -1,4 +1,4 @@
-name:                demo-kubernetes
+name:                demo-kubernetes-kind
 version:             0.1.0.0
 license:             BSD3
 
@@ -32,6 +32,6 @@ ghc-options:
 - -with-rtsopts=-N
 
 executables:
-  demo-kubernetes:
+  demo-kubernetes-kind:
     main: Main.hs
     source-dirs: app

demos/demo-kubernetes-minikube/.gitignore

@@ -0,0 +1,2 @@
+.stack-work/
+*~

demos/demo-kubernetes-minikube/LICENSE

@@ -0,0 +1,30 @@
+Copyright Tom McLaughlin (c) 2023
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Tom McLaughlin nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

demos/demo-kubernetes-minikube/app/Main.hs

@@ -0,0 +1,85 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Main where
+
+import Control.Concurrent
+import Control.Monad
+import Control.Monad.IO.Class
+import Control.Monad.Logger
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.List as L
+import Data.String.Interpolate
+import Data.Time
+import Relude
+import System.Exit
+import Test.Sandwich
+import Test.Sandwich.Contexts.FakeSmtpServer
+import Test.Sandwich.Contexts.Files
+import Test.Sandwich.Contexts.Kubernetes.MinikubeCluster
+import Test.Sandwich.Contexts.Kubernetes.MinioOperator
+import Test.Sandwich.Contexts.Kubernetes.MinioS3Server
+import Test.Sandwich.Contexts.Kubernetes.Namespace
+import Test.Sandwich.Contexts.Nix
+import Test.Sandwich.Contexts.Waits
+import UnliftIO.Environment
+import UnliftIO.Process
+
+
+spec :: TopSpec
+spec = describe "Introducing a Kubernetes cluster" $ do
+  describe "Via Minikube" $ do
+    introduceNixContext nixpkgsReleaseDefault $ do
+      introduceMinikubeClusterViaNix defaultMinikubeClusterOptions $ do
+        it "prints the cluster info" $ do
+          kcc <- getContext kubernetesCluster
+          info [i|Got Kubernetes cluster context: #{kcc}|]
+
+        introduceBinaryViaNixPackage @"kubectl" "kubectl" $
+          introduceBinaryViaNixDerivation @"kubectl-minio" kubectlMinioDerivation $
+          introduceMinioOperator $ do
+            it "Has a MinIO operator" $ do
+              moc <- getContext minioOperator
+              info [i|Got MinIO operator: #{moc}|]
+
+            withKubernetesNamespace "foo" $ do
+              it "creates a service account" $ do
+                kubectlBinary <- askFile @"kubectl"
+
+                KubernetesClusterContext {..} <- getContext kubernetesCluster
+                baseEnv <- getEnvironment
+                let env = L.nubBy (\x y -> fst x == fst y) (("KUBECONFIG", kubernetesClusterKubeConfigPath) : baseEnv)
+
+                let args = ["create", "serviceaccount", "default", "--namespace", "foo"]
+
+                p <- createProcessWithLogging ((proc kubectlBinary args) { env = Just env, delegate_ctlc = True })
+                waitForProcess p >>= (`shouldBe` ExitSuccess)
+
+              introduceK8SMinioS3Server "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
+  '';
+}
+|]
+
+
+main :: IO ()
+main = runSandwichWithCommandLineArgs defaultOptions spec

demos/demo-kubernetes-minikube/demo-kubernetes-minikube.cabal

@@ -0,0 +1,42 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.36.0.
+--
+-- see: https://github.com/sol/hpack
+
+name:           demo-kubernetes-minikube
+version:        0.1.0.0
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+
+executable demo-kubernetes-minikube
+  main-is: Main.hs
+  other-modules:
+      Paths_demo_kubernetes_minikube
+  hs-source-dirs:
+      app
+  default-extensions:
+      OverloadedStrings
+      QuasiQuotes
+      NamedFieldPuns
+      RecordWildCards
+      ScopedTypeVariables
+      FlexibleContexts
+      FlexibleInstances
+      LambdaCase
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      base
+    , bytestring
+    , monad-logger
+    , network
+    , relude
+    , sandwich
+    , sandwich-contexts
+    , sandwich-contexts-kubernetes
+    , string-interpolate
+    , text
+    , time
+    , unliftio
+  default-language: Haskell2010

demos/demo-kubernetes-minikube/package.yaml

@@ -0,0 +1,37 @@
+name:                demo-kubernetes-minikube
+version:             0.1.0.0
+license:             BSD3
+
+dependencies:
+- base
+- bytestring
+- monad-logger
+- network
+- relude
+- sandwich
+- sandwich-contexts
+- sandwich-contexts-kubernetes
+- string-interpolate
+- text
+- time
+- unliftio
+
+default-extensions:
+- OverloadedStrings
+- QuasiQuotes
+- NamedFieldPuns
+- RecordWildCards
+- ScopedTypeVariables
+- FlexibleContexts
+- FlexibleInstances
+- LambdaCase
+
+ghc-options:
+- -threaded
+- -rtsopts
+- -with-rtsopts=-N
+
+executables:
+  demo-kubernetes-minikube:
+    main: Main.hs
+    source-dirs: app

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

@@ -107,6 +107,9 @@ withK8SMinioS3Server' kubectlBinary kubectlMinioBinary (KubernetesClusterContext
   let runWithKubeConfig prog args = do
         p <- createProcessWithLogging ((proc prog args) { env = Just env, delegate_ctlc = True })
         waitForProcess p >>= (`shouldBe` ExitSuccess)
+  let runWithKubeConfig' prog args input = do
+        p <- createProcessWithLoggingAndStdin ((proc prog args) { env = Just env, delegate_ctlc = True }) input
+        waitForProcess p >>= (`shouldBe` ExitSuccess)
 
   deploymentName <- ("minio-" <>) <$> makeUUID' 5
 
@@ -130,13 +133,20 @@ withK8SMinioS3Server' kubectlBinary kubectlMinioBinary (KubernetesClusterContext
                                              , "-f"
                                              ]
 
-  bracket_ create destroy $ do
+  let createNetworkPolicy = do
+        let (policyName, yaml) = networkPolicy deploymentName
+        runWithKubeConfig' kubectlBinary ["create", "--namespace", toString namespace, "-f", "-"] yaml
+        pure policyName
+  let destroyNetworkPolicy policyName = runWithKubeConfig kubectlBinary ["delete", "NetworkPolicy", policyName, "--namespace", toString namespace]
+
+  -- TODO: create network policy allowing ingress/egress for v1.min.io/tenant = deploymentName
+  bracket createNetworkPolicy destroyNetworkPolicy $ \_ -> bracket_ create destroy $ do
     envConfig <- ((B64.decodeLenient . encodeUtf8 . T.strip . toText) <$>) $ do
       let getSecretArgs = ["get", "secret", [i|#{deploymentName}-env-configuration|]
                           , "--namespace", toString namespace
                           , "-o", [i|jsonpath="{.data.config\\.env}"|]
                           ]
-      debug [i|export KUBECONFIG=#{kubernetesClusterKubeConfigPath}|]
+      debug [i|export KUBECONFIG='#{kubernetesClusterKubeConfigPath}'|]
       debug [i|#{kubectlBinary} #{T.unwords $ fmap T.pack getSecretArgs}|]
       ret <- readCreateProcessWithLogging ((proc kubectlBinary getSecretArgs) { env = Just env }) ""
       debug [i|Got ret: #{ret}|]
@@ -192,3 +202,29 @@ withK8SMinioS3Server' kubectlBinary kubectlMinioBinary (KubernetesClusterContext
       waitUntilStatusCodeWithTimeout (4, 0, 3) (1_000_000 * 60 * 5) NoVerify (toString (testS3ServerEndpoint testServ))
 
       void $ action testServ
+
+
+networkPolicy :: Text -> (String, String)
+networkPolicy deploymentName = (policyName, yaml)
+  where
+    policyName = "minio-allow"
+
+    yaml = [__i|apiVersion: networking.k8s.io/v1
+                kind: NetworkPolicy
+                metadata:
+                  name: #{policyName}
+                spec:
+                  podSelector:
+                    matchLabels:
+                      v1.min.io/tenant: "#{deploymentName}"
+
+                  policyTypes:
+                  - Ingress
+                  - Egress
+
+                  ingress:
+                  - {}
+
+                  egress:
+                  - {}
+                |]

stack.yaml

@@ -38,7 +38,8 @@ packages:
 - ./demos/demo-fake-smtp-server
 - ./demos/demo-golden
 - ./demos/demo-hedgehog
-- ./demos/demo-kubernetes
+- ./demos/demo-kubernetes-kind
+- ./demos/demo-kubernetes-minikube
 - ./demos/demo-landing
 - ./demos/demo-minio
 - ./demos/demo-nix-binary