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

{-|

Install MinIO S3 servers onto a Kubernetes cluster.

Such a server is provided as a generic 'TestS3Server', so that you can easily run the same tests against both Kubernetes environments and normal ones. See for example the @sandwich-contexts-minio@ package.

-}

module Test.Sandwich.Contexts.Kubernetes.MinioS3Server (
  introduceK8SMinioS3Server
  , introduceK8SMinioS3Server'

  -- * Bracket-style variants
  , withK8SMinioS3Server
  , withK8SMinioS3Server'

  -- * Types
  , MinioS3ServerOptions(..)
  , defaultMinioS3ServerOptions
  , NetworkPolicies(..)

  -- * Re-exports
  , testS3Server
  , TestS3Server(..)
  , HasTestS3Server
  , NetworkAddress(..)
  ) where

import Control.Monad
import Control.Monad.IO.Unlift
import Data.String.Interpolate
import Data.Text as T
import Network.Minio
import Relude
import System.Exit
import Test.Sandwich
import Test.Sandwich.Contexts.Files
import Test.Sandwich.Contexts.HttpWaits
import Test.Sandwich.Contexts.Kubernetes
import Test.Sandwich.Contexts.Kubernetes.FindImages
import Test.Sandwich.Contexts.Kubernetes.Images
import Test.Sandwich.Contexts.Kubernetes.MinioOperator
import Test.Sandwich.Contexts.Kubernetes.MinioS3Server.Parsing
import Test.Sandwich.Contexts.Kubernetes.Util.UUID
import Test.Sandwich.Contexts.MinIO
import Test.Sandwich.Contexts.Nix
import UnliftIO.Exception
import UnliftIO.Process
import UnliftIO.Timeout


data MinioS3ServerOptions = MinioS3ServerOptions {
  MinioS3ServerOptions -> Text
minioS3ServerNamespace :: Text
  , MinioS3ServerOptions -> KustomizationDir
minioS3ServerKustomizationDir :: KustomizationDir
  , MinioS3ServerOptions -> Bool
minioS3ServerPreloadImages :: Bool
  , MinioS3ServerOptions -> Maybe NetworkPolicies
minioS3ServerNetworkPolicies :: Maybe NetworkPolicies
  }
defaultMinioS3ServerOptions :: Text -> MinioS3ServerOptions
defaultMinioS3ServerOptions :: Text -> MinioS3ServerOptions
defaultMinioS3ServerOptions Text
namespace = MinioS3ServerOptions {
  minioS3ServerNamespace :: Text
minioS3ServerNamespace = Text
namespace
  , minioS3ServerKustomizationDir :: KustomizationDir
minioS3ServerKustomizationDir = Text -> KustomizationDir
KustomizationDirUrl Text
"https://github.com/minio/operator/examples/kustomization/base?ref=v6.0.1"
  , minioS3ServerPreloadImages :: Bool
minioS3ServerPreloadImages = Bool
True
  , minioS3ServerNetworkPolicies :: Maybe NetworkPolicies
minioS3ServerNetworkPolicies = Maybe NetworkPolicies
forall a. Maybe a
Nothing
  }

data NetworkPolicies = NetworkPolicies {
  NetworkPolicies -> [String]
networkPoliciesNames :: [String]
  , NetworkPolicies -> String
networkPoliciesAllYaml :: String
  }
  deriving (Int -> NetworkPolicies -> ShowS
[NetworkPolicies] -> ShowS
NetworkPolicies -> String
(Int -> NetworkPolicies -> ShowS)
-> (NetworkPolicies -> String)
-> ([NetworkPolicies] -> ShowS)
-> Show NetworkPolicies
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NetworkPolicies -> ShowS
showsPrec :: Int -> NetworkPolicies -> ShowS
$cshow :: NetworkPolicies -> String
show :: NetworkPolicies -> String
$cshowList :: [NetworkPolicies] -> ShowS
showList :: [NetworkPolicies] -> ShowS
Show, NetworkPolicies -> NetworkPolicies -> Bool
(NetworkPolicies -> NetworkPolicies -> Bool)
-> (NetworkPolicies -> NetworkPolicies -> Bool)
-> Eq NetworkPolicies
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NetworkPolicies -> NetworkPolicies -> Bool
== :: NetworkPolicies -> NetworkPolicies -> Bool
$c/= :: NetworkPolicies -> NetworkPolicies -> Bool
/= :: NetworkPolicies -> NetworkPolicies -> Bool
Eq)

data KustomizationDir =
  -- | URL Kustomize dir to be downloaded
  KustomizationDirUrl Text
  -- | Local Kustomize dir
  | KustomizationDirLocal FilePath
  -- | A Nix callPackage-style derivation to produce the Kustomize dir
  | KustomizationDirNixDerivation Text
  deriving (Int -> KustomizationDir -> ShowS
[KustomizationDir] -> ShowS
KustomizationDir -> String
(Int -> KustomizationDir -> ShowS)
-> (KustomizationDir -> String)
-> ([KustomizationDir] -> ShowS)
-> Show KustomizationDir
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KustomizationDir -> ShowS
showsPrec :: Int -> KustomizationDir -> ShowS
$cshow :: KustomizationDir -> String
show :: KustomizationDir -> String
$cshowList :: [KustomizationDir] -> ShowS
showList :: [KustomizationDir] -> ShowS
Show, KustomizationDir -> KustomizationDir -> Bool
(KustomizationDir -> KustomizationDir -> Bool)
-> (KustomizationDir -> KustomizationDir -> Bool)
-> Eq KustomizationDir
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KustomizationDir -> KustomizationDir -> Bool
== :: KustomizationDir -> KustomizationDir -> Bool
$c/= :: KustomizationDir -> KustomizationDir -> Bool
/= :: KustomizationDir -> KustomizationDir -> Bool
Eq)

-- | Introduce a MinIO server on a Kubernetes cluster.
-- Must have a 'minioOperator' context.
introduceK8SMinioS3Server :: (
  Typeable context, KubectlBasicWithoutReader context m, HasMinioOperatorContext context
  )
  -- | Options
  => MinioS3ServerOptions
  -> SpecFree (LabelValue "testS3Server" TestS3Server :> context) m ()
  -> SpecFree context m ()
introduceK8SMinioS3Server :: forall context (m :: * -> *).
(Typeable context, KubectlBasicWithoutReader context m,
 HasMinioOperatorContext context) =>
MinioS3ServerOptions
-> SpecFree
     (LabelValue "testS3Server" TestS3Server :> context) m ()
-> SpecFree context m ()
introduceK8SMinioS3Server MinioS3ServerOptions
options = do
  String
-> Label "testS3Server" TestS3Server
-> ((HasCallStack => TestS3Server -> ExampleT context m [Result])
    -> ExampleT context m ())
-> SpecFree
     (LabelValue "testS3Server" TestS3Server :> context) m ()
-> SpecFree context m ()
forall (l :: Symbol) intro context (m :: * -> *).
HasCallStack =>
String
-> Label l intro
-> ((HasCallStack => intro -> ExampleT context m [Result])
    -> ExampleT context m ())
-> SpecFree (LabelValue l intro :> context) m ()
-> SpecFree context m ()
introduceWith String
"minio S3 server" Label "testS3Server" TestS3Server
testS3Server (((HasCallStack => TestS3Server -> ExampleT context m [Result])
  -> ExampleT context m ())
 -> SpecFree
      (LabelValue "testS3Server" TestS3Server :> context) m ()
 -> SpecFree context m ())
-> ((HasCallStack => TestS3Server -> ExampleT context m [Result])
    -> ExampleT context m ())
-> SpecFree
     (LabelValue "testS3Server" TestS3Server :> context) m ()
-> SpecFree context m ()
forall a b. (a -> b) -> a -> b
$ \HasCallStack => TestS3Server -> ExampleT context m [Result]
action -> do
    kcc <- Label "kubernetesCluster" KubernetesClusterContext
-> ExampleT context 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
    moc <- getContext minioOperator
    withK8SMinioS3Server kcc moc options action

-- | Same as 'introduceK8SMinioS3Server', but allows you to pass in the 'KubernetesClusterContext'.
introduceK8SMinioS3Server' :: (
  Typeable context, KubectlBasic context m, HasMinioOperatorContext context
  )
  => KubernetesClusterContext
  -- | Options
  -> MinioS3ServerOptions
  -> SpecFree (LabelValue "testS3Server" TestS3Server :> context) m ()
  -> SpecFree context m ()
introduceK8SMinioS3Server' :: forall context (m :: * -> *).
(Typeable context, KubectlBasic context m,
 HasMinioOperatorContext context) =>
KubernetesClusterContext
-> MinioS3ServerOptions
-> SpecFree
     (LabelValue "testS3Server" TestS3Server :> context) m ()
-> SpecFree context m ()
introduceK8SMinioS3Server' KubernetesClusterContext
kubernetesClusterContext MinioS3ServerOptions
options =
  String
-> Label "testS3Server" TestS3Server
-> ((HasCallStack => TestS3Server -> ExampleT context m [Result])
    -> ExampleT context m ())
-> SpecFree
     (LabelValue "testS3Server" TestS3Server :> context) m ()
-> SpecFree context m ()
forall (l :: Symbol) intro context (m :: * -> *).
HasCallStack =>
String
-> Label l intro
-> ((HasCallStack => intro -> ExampleT context m [Result])
    -> ExampleT context m ())
-> SpecFree (LabelValue l intro :> context) m ()
-> SpecFree context m ()
introduceWith String
"minio S3 server" Label "testS3Server" TestS3Server
testS3Server (((HasCallStack => TestS3Server -> ExampleT context m [Result])
  -> ExampleT context m ())
 -> SpecFree
      (LabelValue "testS3Server" TestS3Server :> context) m ()
 -> SpecFree context m ())
-> ((HasCallStack => TestS3Server -> ExampleT context m [Result])
    -> ExampleT context m ())
-> SpecFree
     (LabelValue "testS3Server" TestS3Server :> context) m ()
-> SpecFree context m ()
forall a b. (a -> b) -> a -> b
$ \HasCallStack => TestS3Server -> ExampleT context m [Result]
action -> do
    moc <- Label "minioOperator" MinioOperatorContext
-> ExampleT context m MinioOperatorContext
forall context (l :: Symbol) a (m :: * -> *).
(HasLabel context l a, MonadReader context m) =>
Label l a -> m a
getContext Label "minioOperator" MinioOperatorContext
minioOperator
    withK8SMinioS3Server kubernetesClusterContext moc options action

-- | Bracket-style variant of 'introduceK8SMinioS3Server'.
withK8SMinioS3Server :: (
  Typeable context, MonadFail m, KubernetesBasic context m, HasFile context "kubectl"
  )
  => KubernetesClusterContext
  -> MinioOperatorContext
  -- | Options
  -> MinioS3ServerOptions
  -> (TestS3Server -> m [Result])
  -> m ()
withK8SMinioS3Server :: forall context (m :: * -> *).
(Typeable context, MonadFail m, KubernetesBasic context m,
 HasFile context "kubectl") =>
KubernetesClusterContext
-> MinioOperatorContext
-> MinioS3ServerOptions
-> (TestS3Server -> m [Result])
-> m ()
withK8SMinioS3Server KubernetesClusterContext
kcc MinioOperatorContext
moc MinioS3ServerOptions
options TestS3Server -> m [Result]
action = do
  kubectlBinary <- forall (a :: Symbol) context (m :: * -> *).
(MonadReader context m, HasFile context a) =>
m String
askFile @"kubectl"
  withK8SMinioS3Server' kubectlBinary kcc moc options action

-- | Same as 'withK8SMinioS3Server', but allows you to pass in the @kubectl@ binary.
withK8SMinioS3Server' :: forall m context. (
  Typeable context, MonadFail m, KubernetesBasic context m
  )
  -- | Path to kubectl binary
  => FilePath
  -> KubernetesClusterContext
  -> MinioOperatorContext
  -- | Options
  -> MinioS3ServerOptions
  -> (TestS3Server -> m [Result])
  -> m ()
withK8SMinioS3Server' :: forall (m :: * -> *) context.
(Typeable context, MonadFail m, KubernetesBasic context m) =>
String
-> KubernetesClusterContext
-> MinioOperatorContext
-> MinioS3ServerOptions
-> (TestS3Server -> m [Result])
-> m ()
withK8SMinioS3Server' String
kubectlBinary kcc :: KubernetesClusterContext
kcc@(KubernetesClusterContext {Int
String
(Manager, KubernetesClientConfig)
Text
KubernetesClusterType
kubernetesClusterName :: Text
kubernetesClusterKubeConfigPath :: String
kubernetesClusterNumNodes :: Int
kubernetesClusterClientConfig :: (Manager, KubernetesClientConfig)
kubernetesClusterType :: KubernetesClusterType
kubernetesClusterType :: KubernetesClusterContext -> KubernetesClusterType
kubernetesClusterClientConfig :: KubernetesClusterContext -> (Manager, KubernetesClientConfig)
kubernetesClusterNumNodes :: KubernetesClusterContext -> Int
kubernetesClusterKubeConfigPath :: KubernetesClusterContext -> String
kubernetesClusterName :: KubernetesClusterContext -> Text
..}) MinioOperatorContext
MinioOperatorContext (MinioS3ServerOptions {Bool
Maybe NetworkPolicies
Text
KustomizationDir
minioS3ServerNamespace :: MinioS3ServerOptions -> Text
minioS3ServerKustomizationDir :: MinioS3ServerOptions -> KustomizationDir
minioS3ServerPreloadImages :: MinioS3ServerOptions -> Bool
minioS3ServerNetworkPolicies :: MinioS3ServerOptions -> Maybe NetworkPolicies
minioS3ServerNamespace :: Text
minioS3ServerKustomizationDir :: KustomizationDir
minioS3ServerPreloadImages :: Bool
minioS3ServerNetworkPolicies :: Maybe NetworkPolicies
..}) TestS3Server -> m [Result]
action = do
  env <- KubernetesClusterContext -> m [(String, String)]
forall (m :: * -> *).
MonadLoggerIO m =>
KubernetesClusterContext -> m [(String, String)]
getKubectlEnvironment KubernetesClusterContext
kcc
  let runWithKubeConfig :: (HasCallStack) => String -> [String] -> m ()
      runWithKubeConfig String
prog [String]
args = do
        CreateProcess -> m ProcessHandle
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m, MonadLogger m) =>
CreateProcess -> m ProcessHandle
createProcessWithLogging ((String -> [String] -> CreateProcess
proc String
prog [String]
args) { env = Just env, delegate_ctlc = True })
          m ProcessHandle -> (ProcessHandle -> m ExitCode) -> m ExitCode
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcessHandle -> m ExitCode
forall (m :: * -> *). MonadIO m => ProcessHandle -> m ExitCode
waitForProcess m ExitCode -> (ExitCode -> 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
>>= (ExitCode -> ExitCode -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Eq a, Show a) =>
a -> a -> m ()
`shouldBe` ExitCode
ExitSuccess)

  deploymentName <- ("minio-" <>) <$> makeUUID' 5

  -- let pool = "pool1"
  let port = PortNumber
80

  kustomizationDir <- case minioS3ServerKustomizationDir of
    KustomizationDirLocal String
p -> String -> m String
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
p
    KustomizationDirUrl Text
u -> String -> m String
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> String
forall a. ToString a => a -> String
toString Text
u)
    KustomizationDirNixDerivation Text
d -> do
      Label "nixContext" NixContext -> m (Maybe NixContext)
forall context (m :: * -> *) (l :: Symbol) a.
(MonadReader context m, KnownSymbol l, Typeable context,
 Typeable a) =>
Label l a -> m (Maybe a)
getContextMaybe Label "nixContext" NixContext
nixContext m (Maybe NixContext) -> (Maybe NixContext -> m String) -> m String
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe NixContext
Nothing -> String -> m String
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
expectationFailure [i|Couldn't find a Nix context to use with KustomizationDirNixDerivation|]
        Just NixContext
nc -> NixContext -> Text -> m String
forall context (m :: * -> *).
(HasBaseContextMonad context m, MonadUnliftIO m, MonadLogger m) =>
NixContext -> Text -> m String
buildNixCallPackageDerivation' NixContext
nc Text
d

  let busyboxImage = Text
"busybox:1.36.1-musl"

  let create = do
        allYaml <- CreateProcess -> String -> m String
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m, MonadLogger m) =>
CreateProcess -> String -> m String
readCreateProcessWithLogging ((String -> [String] -> CreateProcess
proc String
kubectlBinary [String
"kustomize", String
kustomizationDir]) { env = Just env, delegate_ctlc = True }) String
""

        when minioS3ServerPreloadImages $ do
          let images = Text -> [Text]
findAllImages (String -> Text
forall a. ToText a => a -> Text
toText String
allYaml)

          forM_ images $ \Text
image -> do
            Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
debug [i|Preloading image: #{image}|]
            KubernetesClusterContext -> ImageLoadSpec -> m ()
forall (m :: * -> *) context.
(HasCallStack, MonadFail m, KubernetesBasic context m) =>
KubernetesClusterContext -> ImageLoadSpec -> m ()
loadImageIfNecessary' KubernetesClusterContext
kcc (Text -> ImagePullPolicy -> ImageLoadSpec
ImageLoadSpecDocker Text
image ImagePullPolicy
IfNotPresent)

          debug [i|Preloading image: #{busyboxImage}|]
          loadImageIfNecessary' kcc (ImageLoadSpecDocker busyboxImage IfNotPresent)

        (userAndPassword@(username, password), finalYaml) <- case transformKustomizeChunks (toString minioS3ServerNamespace) (toString deploymentName) (T.splitOn "---\n" (toText allYaml)) of
          Left String
err -> String -> m ((Text, Text), Text)
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
expectationFailure [i|Couldn't transform kustomize chunks: #{err}|]
          Right ((Text, Text), Text)
x -> ((Text, Text), Text) -> m ((Text, Text), Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text, Text), Text)
x

        info [i|Got username and password: #{(username, password)}|]

        createProcessWithLoggingAndStdin ((proc kubectlBinary ["apply", "-f", "-"]) { env = Just env }) (toString finalYaml)
          >>= waitForProcess >>= (`shouldBe` ExitSuccess)

        return (userAndPassword, finalYaml)

  let destroy (a
_, a
finalYaml) = do
        Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
info [i|-------------------------- DESTROYING --------------------------|]
        CreateProcess -> String -> m ProcessHandle
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m, MonadFail m, MonadLogger m) =>
CreateProcess -> String -> m ProcessHandle
createProcessWithLoggingAndStdin ((String -> [String] -> CreateProcess
proc String
kubectlBinary [String
"delete", String
"-f", String
"-"]) { env = Just env }) (a -> String
forall a. ToString a => a -> String
toString a
finalYaml)
          m ProcessHandle -> (ProcessHandle -> m ExitCode) -> m ExitCode
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcessHandle -> m ExitCode
forall (m :: * -> *). MonadIO m => ProcessHandle -> m ExitCode
waitForProcess m ExitCode -> (ExitCode -> 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
>>= (ExitCode -> ExitCode -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Eq a, Show a) =>
a -> a -> m ()
`shouldBe` ExitCode
ExitSuccess)


  -- Create network policy allowing ingress/egress for v1.min.io/tenant = deploymentName
  let createNetworkPolicy = do
        let NetworkPolicies [String]
policyNames String
yaml = NetworkPolicies -> Maybe NetworkPolicies -> NetworkPolicies
forall a. a -> Maybe a -> a
fromMaybe (Text -> NetworkPolicies
defaultNetworkPolicies Text
deploymentName) Maybe NetworkPolicies
minioS3ServerNetworkPolicies
        CreateProcess -> String -> m ProcessHandle
forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m, MonadFail m, MonadLogger m) =>
CreateProcess -> String -> m ProcessHandle
createProcessWithLoggingAndStdin ((String -> [String] -> CreateProcess
proc String
kubectlBinary [String
"create", String
"--namespace", Text -> String
forall a. ToString a => a -> String
toString Text
minioS3ServerNamespace, String
"-f", String
"-"]) { env = Just env, delegate_ctlc = True }) String
yaml
          m ProcessHandle -> (ProcessHandle -> m ExitCode) -> m ExitCode
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcessHandle -> m ExitCode
forall (m :: * -> *). MonadIO m => ProcessHandle -> m ExitCode
waitForProcess m ExitCode -> (ExitCode -> 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
>>= (ExitCode -> ExitCode -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Eq a, Show a) =>
a -> a -> m ()
`shouldBe` ExitCode
ExitSuccess)
        [String] -> m [String]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String]
policyNames
  let destroyNetworkPolicy t String
policyNames = do
        t String -> (String -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t String
policyNames ((String -> m ()) -> m ()) -> (String -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \String
name ->
          HasCallStack => String -> [String] -> m ()
String -> [String] -> m ()
runWithKubeConfig String
kubectlBinary [String
"delete", String
"NetworkPolicy", String
name, String
"--namespace", Text -> String
forall a. ToString a => a -> String
toString Text
minioS3ServerNamespace]

  bracket createNetworkPolicy destroyNetworkPolicy $ \[String]
_ -> m ((Text, Text), Text)
-> (((Text, Text), Text) -> m ())
-> (((Text, Text), Text) -> m ())
-> m ()
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket m ((Text, Text), Text)
create ((Text, Text), Text) -> m ()
forall {m :: * -> *} {a} {a}.
(MonadLogger m, MonadUnliftIO m, MonadFail m, ToString a) =>
(a, a) -> m ()
destroy ((((Text, Text), Text) -> m ()) -> m ())
-> (((Text, Text), Text) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \((Text
username, Text
password), Text
_) -> do
    do
      uuid <- m Text
forall (m :: * -> *). MonadIO m => m Text
makeUUID
      p <- createProcessWithLogging ((proc kubectlBinary [
                                         "run", "discoverer-" <> toString uuid
                                         , "--rm", "-i"
                                         , "--attach"
                                         , [i|--image=#{busyboxImage}|]
                                         , "--image-pull-policy=IfNotPresent"
                                         , "--restart=Never"
                                         , "--command"
                                         , "--namespace", toString minioS3ServerNamespace
                                         , "--labels=app=discover-pod"
                                         , "--"
                                         , "sh", "-c", [i|until nc -vz minio 80; do echo "Waiting for minio..."; sleep 3; done;|]
                                         ]) { env = Just env })
      timeout 300_000_000 (waitForProcess p >>= (`shouldBe` ExitSuccess)) >>= \case
        Just () -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Maybe ()
Nothing -> String -> m ()
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
expectationFailure [i|Failed to wait for minio to come online.|]

    Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
info [__i|Ready to try port-forward:
              export KUBECONFIG=#{kubernetesClusterKubeConfigPath}
              kubectl --namespace #{minioS3ServerNamespace} port-forward "service/minio" 8080:#{port}|]

    String
-> String
-> Text
-> (PortNumber -> Bool)
-> Maybe PortNumber
-> Text
-> PortNumber
-> (KubectlPortForwardContext -> m ())
-> m ()
forall context (m :: * -> *) a.
(HasCallStack, KubernetesBasic context m) =>
String
-> String
-> Text
-> (PortNumber -> Bool)
-> Maybe PortNumber
-> Text
-> PortNumber
-> (KubectlPortForwardContext -> m a)
-> m a
withKubectlPortForward' String
kubectlBinary String
kubernetesClusterKubeConfigPath Text
minioS3ServerNamespace (Bool -> PortNumber -> Bool
forall a b. a -> b -> a
const Bool
True) Maybe PortNumber
forall a. Maybe a
Nothing Text
"service/minio" PortNumber
port ((KubectlPortForwardContext -> m ()) -> m ())
-> (KubectlPortForwardContext -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(KubectlPortForwardContext {PortNumber
kubectlPortForwardPort :: PortNumber
kubectlPortForwardPort :: KubectlPortForwardContext -> PortNumber
..}) -> do
      Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
info [i|Did forward to localhost:#{kubectlPortForwardPort}|]

      let bucket :: Text
bucket = Text
"bucket1"

      let testServ :: TestS3Server
testServ = TestS3Server {
            testS3ServerAddress :: NetworkAddress
testS3ServerAddress = String -> PortNumber -> NetworkAddress
NetworkAddressTCP String
"localhost" PortNumber
kubectlPortForwardPort
            , testS3ServerContainerAddress :: Maybe NetworkAddress
testS3ServerContainerAddress = NetworkAddress -> Maybe NetworkAddress
forall a. a -> Maybe a
Just (NetworkAddress -> Maybe NetworkAddress)
-> NetworkAddress -> Maybe NetworkAddress
forall a b. (a -> b) -> a -> b
$ String -> PortNumber -> NetworkAddress
NetworkAddressTCP String
"minio" PortNumber
port
            , testS3ServerAccessKeyId :: Text
testS3ServerAccessKeyId = Text
username
            , testS3ServerSecretAccessKey :: Text
testS3ServerSecretAccessKey = Text
password
            , testS3ServerBucket :: Maybe Text
testS3ServerBucket = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
bucket
            , testS3ServerHttpMode :: HttpMode
testS3ServerHttpMode = HttpMode
HttpModeHttp
            }

      IO (Either MinioErr ()) -> m (Either MinioErr ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ConnectInfo -> Minio () -> IO (Either MinioErr ())
forall a. ConnectInfo -> Minio a -> IO (Either MinioErr a)
runMinio (TestS3Server -> ConnectInfo
testS3ServerConnectInfo TestS3Server
testServ) (Minio () -> IO (Either MinioErr ()))
-> Minio () -> IO (Either MinioErr ())
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Minio ()
makeBucket Text
bucket Maybe Text
forall a. Maybe a
Nothing) m (Either MinioErr ()) -> (Either MinioErr () -> 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
>>= \case
        Left MinioErr
err -> String -> m ()
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
expectationFailure [i|Failed to create bucket: #{err}|]
        Right () -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

      (Int, Int, Int) -> Int -> VerifyCerts -> String -> m ()
forall (m :: * -> *).
WaitConstraints m =>
(Int, Int, Int) -> Int -> VerifyCerts -> String -> m ()
waitUntilStatusCodeWithTimeout (Int
4, Int
0, Int
3) (Int
1_000_000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5) VerifyCerts
NoVerify (Text -> String
forall a. ToString a => a -> String
toString (TestS3Server -> Text
testS3ServerEndpoint TestS3Server
testServ))

      m [Result] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m [Result] -> m ()) -> m [Result] -> m ()
forall a b. (a -> b) -> a -> b
$ TestS3Server -> m [Result]
action TestS3Server
testServ


defaultNetworkPolicies :: Text -> NetworkPolicies
defaultNetworkPolicies :: Text -> NetworkPolicies
defaultNetworkPolicies Text
deploymentName = [String] -> String -> NetworkPolicies
NetworkPolicies [String]
allPolicyNames String
yaml
  where
    allPolicyNames :: [String]
allPolicyNames = [
      String
policyName
      , String
discoverPodPolicyName
      ]

    policyName :: String
policyName = String
"minio-allow"
    discoverPodPolicyName :: String
discoverPodPolicyName = String
"discover-pod-allow"

    yaml :: String
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:
                  - {}
                ---
                apiVersion: networking.k8s.io/v1
                kind: NetworkPolicy
                metadata:
                  name: #{discoverPodPolicyName}
                spec:
                  podSelector:
                    matchLabels:
                      app: discover-pod

                  policyTypes:
                  - Ingress
                  - Egress

                  ingress:
                  - {}

                  egress:
                  - {}
                |]