mirror of
https://github.com/codedownio/sandwich.git
synced 2024-10-03 23:08:04 +03:00
sandwich-contexts-kubernetes: working on getting kubectl, kubectl-minio from contexts
This commit is contained in:
parent
b3eef612aa
commit
0928961b23
@ -16,6 +16,8 @@ import Test.Sandwich
|
||||
import Test.Sandwich.Contexts.FakeSmtpServer
|
||||
import Test.Sandwich.Contexts.Files
|
||||
import Test.Sandwich.Contexts.Kubernetes.KindCluster
|
||||
import Test.Sandwich.Contexts.Kubernetes.MinioOperator
|
||||
import Test.Sandwich.Contexts.Kubernetes.MinioS3Server
|
||||
import Test.Sandwich.Contexts.Nix
|
||||
import Test.Sandwich.Contexts.Waits
|
||||
|
||||
@ -31,5 +33,39 @@ spec = describe "Introducing a Kubernetes cluster" $ do
|
||||
|
||||
liftIO $ threadDelay 60_000_000
|
||||
|
||||
introduceBinaryViaNixPackage @"kubectl" "kubectl" $
|
||||
introduceBinaryViaNixDerivation @"kubectl-minio" kubectlMinioDerivation $
|
||||
introduceMinioOperator $ do
|
||||
it "Has a MinIO operator" $ do
|
||||
moc <- getContext minioOperator
|
||||
info [i|Got MinIO operator: #{moc}|]
|
||||
|
||||
-- introduceK8SMinioS3Server "foo" $ do
|
||||
-- Relude.undefined
|
||||
-- -- it "has a MinIO S3 server" $ do
|
||||
-- -- Relude.undefined
|
||||
-- -- -- 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
|
||||
|
@ -1,6 +1,7 @@
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module Test.Sandwich.Contexts.Kubernetes.Cluster (
|
||||
-- * Kind clusters
|
||||
@ -47,6 +48,7 @@ import Control.Monad.Trans.Control (MonadBaseControl)
|
||||
import Network.URI
|
||||
import Relude
|
||||
import Test.Sandwich
|
||||
import Test.Sandwich.Contexts.Files
|
||||
import Test.Sandwich.Contexts.Kubernetes.KubectlLogs
|
||||
import Test.Sandwich.Contexts.Kubernetes.KubectlPortForward
|
||||
import Test.Sandwich.Contexts.Kubernetes.Types
|
||||
@ -63,17 +65,18 @@ import qualified Test.Sandwich.Contexts.Kubernetes.Util as Util
|
||||
|
||||
withForwardKubernetesService :: (
|
||||
MonadLoggerIO m, MonadMask m, MonadUnliftIO m, MonadBaseControl IO m
|
||||
, HasBaseContextMonad context m, HasKubernetesClusterContext context
|
||||
, HasBaseContextMonad context m, HasKubernetesClusterContext context, HasFile context "kubectl"
|
||||
) => Text -> Text -> (URI -> m a) -> m a
|
||||
withForwardKubernetesService namespace serviceName action = do
|
||||
kcc <- getContext kubernetesCluster
|
||||
withForwardKubernetesService' kcc namespace serviceName action
|
||||
kubectlBinary <- askFile @"kubectl"
|
||||
withForwardKubernetesService' kcc kubectlBinary namespace serviceName action
|
||||
|
||||
withForwardKubernetesService' :: (
|
||||
MonadLoggerIO m, MonadMask m, MonadUnliftIO m, MonadBaseControl IO m
|
||||
, HasBaseContextMonad context m
|
||||
) => KubernetesClusterContext -> Text -> Text -> (URI -> m a) -> m a
|
||||
withForwardKubernetesService' kcc@(KubernetesClusterContext {kubernetesClusterType=(KubernetesClusterMinikube {..})}) =
|
||||
) => KubernetesClusterContext -> FilePath -> Text -> Text -> (URI -> m a) -> m a
|
||||
withForwardKubernetesService' kcc@(KubernetesClusterContext {kubernetesClusterType=(KubernetesClusterMinikube {..})}) _kubectlBinary =
|
||||
Minikube.withForwardKubernetesService' kcc minikubeProfileName
|
||||
withForwardKubernetesService' kcc@(KubernetesClusterContext {kubernetesClusterType=(KubernetesClusterKind {})}) =
|
||||
Kind.withForwardKubernetesService' kcc
|
||||
withForwardKubernetesService' kcc@(KubernetesClusterContext {kubernetesClusterType=(KubernetesClusterKind {})}) kubectlBinary =
|
||||
Kind.withForwardKubernetesService' kcc kubectlBinary
|
||||
|
@ -103,7 +103,7 @@ defaultKindClusterOptions = KindClusterOptions {
|
||||
|
||||
-- * Introduce
|
||||
|
||||
|
||||
-- | Alias to make type signatures shorter
|
||||
type KindContext context = LabelValue "kubernetesCluster" KubernetesClusterContext :> LabelValue "file-kind" (EnvironmentFile "kind") :> context
|
||||
|
||||
-- | Introduce a Kubernetes cluster using [kind](https://kind.sigs.k8s.io/), deriving the kind binary from the Nix context.
|
||||
|
@ -5,7 +5,6 @@
|
||||
|
||||
module Test.Sandwich.Contexts.Kubernetes.KindCluster.ServiceForwardIngress where
|
||||
|
||||
import Test.Sandwich.Contexts.Kubernetes.Types
|
||||
import Control.Lens
|
||||
import Control.Lens.Regex.Text
|
||||
import Control.Monad
|
||||
@ -24,6 +23,7 @@ import System.Exit
|
||||
import System.FilePath
|
||||
import qualified System.Random as R
|
||||
import Test.Sandwich
|
||||
import Test.Sandwich.Contexts.Kubernetes.Types
|
||||
import Test.Sandwich.Util.Process
|
||||
import UnliftIO.Environment
|
||||
import UnliftIO.Exception
|
||||
@ -36,8 +36,8 @@ import UnliftIO.Timeout
|
||||
withForwardKubernetesService' :: (
|
||||
MonadUnliftIO m, MonadBaseControl IO m, MonadLoggerIO m
|
||||
, MonadReader context m
|
||||
) => KubernetesClusterContext -> Text -> Text -> (URI -> m a) -> m a
|
||||
withForwardKubernetesService' (KubernetesClusterContext {kubernetesClusterType=(KubernetesClusterKind {..}), ..}) namespace service action = do
|
||||
) => KubernetesClusterContext -> FilePath -> Text -> Text -> (URI -> m a) -> m a
|
||||
withForwardKubernetesService' (KubernetesClusterContext {kubernetesClusterType=(KubernetesClusterKind {..}), ..}) kubectlBinary namespace service action = do
|
||||
baseEnv <- maybe getEnvironment return kindClusterEnvironment
|
||||
let env = L.nubBy (\x y -> fst x == fst y) (("KUBECONFIG", kubernetesClusterKubeConfigPath) : baseEnv)
|
||||
|
||||
@ -47,9 +47,9 @@ withForwardKubernetesService' (KubernetesClusterContext {kubernetesClusterType=(
|
||||
let configFile = dir </> "ingress.yaml"
|
||||
liftIO $ T.writeFile configFile (ingressConfig service randomHost)
|
||||
|
||||
createProcessWithLogging ((proc "kubectl" ["create"
|
||||
, "--namespace", toString namespace
|
||||
, "-f", configFile]) {
|
||||
createProcessWithLogging ((proc kubectlBinary ["create"
|
||||
, "--namespace", toString namespace
|
||||
, "-f", configFile]) {
|
||||
env = Just env
|
||||
}) >>= waitForProcess >>= (`shouldBe` ExitSuccess)
|
||||
|
||||
@ -95,7 +95,7 @@ withForwardKubernetesService' (KubernetesClusterContext {kubernetesClusterType=(
|
||||
Nothing -> expectationFailure [i|Couldn't parse URI in withForwardKubernetesService': #{uriToUse}|]
|
||||
Just x -> pure x
|
||||
|
||||
withForwardKubernetesService' _ _ _ _ = error "withForwardKubernetesService' must be called with a kind KubernetesClusterContext"
|
||||
withForwardKubernetesService' _ _ _ _ _ = error "withForwardKubernetesService' must be called with a kind KubernetesClusterContext"
|
||||
|
||||
|
||||
ingressConfig :: Text -> Text -> Text
|
||||
|
@ -1,12 +1,11 @@
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Test.Sandwich.Contexts.Kubernetes.KindCluster.ServiceForwardPortForward where
|
||||
|
||||
import Test.Sandwich.Contexts.Kubernetes.Types
|
||||
import Test.Sandwich.Contexts.Kubernetes.KubectlPortForward
|
||||
import Control.Monad.Catch (MonadCatch)
|
||||
import Control.Monad.IO.Unlift
|
||||
import Control.Monad.Logger
|
||||
@ -18,6 +17,8 @@ import Network.URI
|
||||
import Relude hiding (withFile)
|
||||
import Safe
|
||||
import Test.Sandwich
|
||||
import Test.Sandwich.Contexts.Kubernetes.KubectlPortForward
|
||||
import Test.Sandwich.Contexts.Kubernetes.Types
|
||||
import UnliftIO.Environment
|
||||
import UnliftIO.Process
|
||||
|
||||
@ -25,13 +26,13 @@ import UnliftIO.Process
|
||||
withForwardKubernetesService' :: (
|
||||
MonadUnliftIO m, MonadCatch m, MonadBaseControl IO m, MonadLoggerIO m
|
||||
, HasBaseContextMonad context m
|
||||
) => KubernetesClusterContext -> Text -> Text -> (URI -> m a) -> m a
|
||||
withForwardKubernetesService' (KubernetesClusterContext {kubernetesClusterType=(KubernetesClusterKind {..}), ..}) namespace service action = do
|
||||
) => KubernetesClusterContext -> FilePath -> Text -> Text -> (URI -> m a) -> m a
|
||||
withForwardKubernetesService' (KubernetesClusterContext {kubernetesClusterType=(KubernetesClusterKind {..}), ..}) kubectlBinary namespace service action = do
|
||||
baseEnv <- maybe getEnvironment return kindClusterEnvironment
|
||||
let env = L.nubBy (\x y -> fst x == fst y) (("KUBECONFIG", kubernetesClusterKubeConfigPath) : baseEnv)
|
||||
|
||||
portRaw <- (toString . T.strip . toText) <$> readCreateProcessWithLogging (
|
||||
(proc "kubectl" [
|
||||
(proc kubectlBinary [
|
||||
"get"
|
||||
, "service", toString service
|
||||
, "--namespace", toString namespace
|
||||
@ -42,7 +43,7 @@ withForwardKubernetesService' (KubernetesClusterContext {kubernetesClusterType=(
|
||||
Just p -> pure p
|
||||
Nothing -> expectationFailure [i|Failed to parse service port: #{portRaw}|]
|
||||
|
||||
withKubectlPortForward kubernetesClusterKubeConfigPath namespace ("svc/" <> service) port $ \(KubectlPortForwardContext {..}) -> do
|
||||
withKubectlPortForward' kubectlBinary kubernetesClusterKubeConfigPath namespace (const True) Nothing ("svc/" <> service) port $ \(KubectlPortForwardContext {..}) -> do
|
||||
action $ nullURI {
|
||||
uriScheme = "http:"
|
||||
, uriAuthority = Just (nullURIAuth {
|
||||
@ -51,4 +52,4 @@ withForwardKubernetesService' (KubernetesClusterContext {kubernetesClusterType=(
|
||||
})
|
||||
}
|
||||
|
||||
withForwardKubernetesService' _ _ _ _ = error "withForwardKubernetesService' must be called with a kind KubernetesClusterContext"
|
||||
withForwardKubernetesService' _ _ _ _ _ = error "withForwardKubernetesService' must be called with a kind KubernetesClusterContext"
|
||||
|
@ -1,3 +1,5 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module Test.Sandwich.Contexts.Kubernetes.KubectlPortForward (
|
||||
KubectlPortForwardContext (..)
|
||||
@ -6,8 +8,6 @@ module Test.Sandwich.Contexts.Kubernetes.KubectlPortForward (
|
||||
, withKubectlPortForward'
|
||||
) where
|
||||
|
||||
import Test.Sandwich.Contexts.Kubernetes.Util.Ports
|
||||
import Test.Sandwich.Contexts.Kubernetes.Util.SocketUtil
|
||||
import Control.Monad
|
||||
import Control.Monad.Catch (MonadCatch)
|
||||
import Control.Monad.IO.Unlift
|
||||
@ -20,6 +20,9 @@ import Relude hiding (withFile)
|
||||
import System.FilePath
|
||||
import System.Process (getPid)
|
||||
import Test.Sandwich
|
||||
import Test.Sandwich.Contexts.Files
|
||||
import Test.Sandwich.Contexts.Kubernetes.Util.Ports
|
||||
import Test.Sandwich.Contexts.Kubernetes.Util.SocketUtil
|
||||
import Test.Sandwich.Util.Process (gracefullyStopProcess)
|
||||
import UnliftIO.Async
|
||||
import UnliftIO.Directory
|
||||
@ -37,16 +40,20 @@ newtype KubectlPortForwardContext = KubectlPortForwardContext {
|
||||
-- * Implementation
|
||||
|
||||
withKubectlPortForward :: (
|
||||
HasCallStack, HasBaseContextMonad ctx m, MonadCatch m, MonadLogger m, MonadUnliftIO m
|
||||
HasCallStack, MonadCatch m, MonadLogger m, MonadUnliftIO m
|
||||
, HasBaseContextMonad ctx m, HasFile ctx "kubectl"
|
||||
) => FilePath -> Text -> Text -> PortNumber -> (KubectlPortForwardContext -> m a) -> m a
|
||||
withKubectlPortForward kubeConfigFile namespace = withKubectlPortForward' kubeConfigFile namespace (const True) Nothing
|
||||
withKubectlPortForward kubeConfigFile namespace targetName targetPort action = do
|
||||
kubectlBinary <- askFile @"kubectl"
|
||||
withKubectlPortForward' kubectlBinary kubeConfigFile namespace (const True) Nothing targetName targetPort action
|
||||
|
||||
-- | Note that this will stop working if the pod you're talking to goes away (even if you do it against a service)
|
||||
-- If this happens, a rerun of the command is needed to resume forwarding
|
||||
withKubectlPortForward' :: (
|
||||
HasCallStack, HasBaseContextMonad ctx m, MonadCatch m, MonadLogger m, MonadUnliftIO m
|
||||
) => FilePath -> Text -> (PortNumber -> Bool) -> Maybe PortNumber -> Text -> PortNumber -> (KubectlPortForwardContext -> m a) -> m a
|
||||
withKubectlPortForward' kubeConfigFile namespace isAcceptablePort maybeHostPort targetName targetPort action = do
|
||||
HasCallStack, MonadCatch m, MonadLogger m, MonadUnliftIO m
|
||||
, HasBaseContextMonad ctx m
|
||||
) => FilePath -> FilePath -> Text -> (PortNumber -> Bool) -> Maybe PortNumber -> Text -> PortNumber -> (KubectlPortForwardContext -> m a) -> m a
|
||||
withKubectlPortForward' kubectlBinary kubeConfigFile namespace isAcceptablePort maybeHostPort targetName targetPort action = do
|
||||
port <- maybe (findFreePortOrException' isAcceptablePort) return maybeHostPort
|
||||
|
||||
let args = ["port-forward", toString targetName, [i|#{port}:#{targetPort}|]
|
||||
@ -65,10 +72,11 @@ withKubectlPortForward' kubeConfigFile namespace isAcceptablePort maybeHostPort
|
||||
withFile logPath WriteMode $ \h -> do
|
||||
|
||||
let restarterThread = forever $ do
|
||||
bracket (createProcess ((proc "kubectl" args) { std_out = UseHandle h
|
||||
, std_err = UseHandle h
|
||||
, create_group = True
|
||||
}))
|
||||
bracket (createProcess ((proc kubectlBinary args) {
|
||||
std_out = UseHandle h
|
||||
, std_err = UseHandle h
|
||||
, create_group = True
|
||||
}))
|
||||
(\(_, _, _, ps) -> gracefullyStopProcess ps 30000000)
|
||||
(\(_, _, _, ps) -> do
|
||||
pid <- liftIO $ getPid ps
|
||||
|
@ -13,6 +13,7 @@ module Test.Sandwich.Contexts.Kubernetes.MinioOperator (
|
||||
, withMinioOperator'
|
||||
|
||||
-- * Types
|
||||
, minioOperator
|
||||
, MinioOperatorContext(..)
|
||||
, HasMinioOperatorContext
|
||||
) where
|
||||
|
@ -1,16 +1,23 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Test.Sandwich.Contexts.Kubernetes.MinioS3Server (
|
||||
introduceK8SMinioS3Server
|
||||
, introduceK8SMinioS3Server'
|
||||
, withK8SMinioS3Server
|
||||
, withK8SMinioS3Server'
|
||||
|
||||
-- * Re-exports
|
||||
, testS3Server
|
||||
, TestS3Server(..)
|
||||
, HasTestS3Server
|
||||
) where
|
||||
|
||||
import Control.Monad
|
||||
import Control.Monad.Catch (MonadMask)
|
||||
import Control.Monad.IO.Unlift
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Trans.Control (MonadBaseControl)
|
||||
import qualified Data.ByteString.Base64 as B64
|
||||
import qualified Data.List as L
|
||||
import Data.String.Interpolate
|
||||
@ -19,6 +26,7 @@ import Network.Minio
|
||||
import Relude
|
||||
import System.Exit
|
||||
import Test.Sandwich
|
||||
import Test.Sandwich.Contexts.Files
|
||||
import Test.Sandwich.Contexts.Kubernetes.Cluster
|
||||
import Test.Sandwich.Contexts.Kubernetes.MinioS3Server.Parsing
|
||||
import Test.Sandwich.Contexts.Kubernetes.Types
|
||||
@ -30,48 +38,78 @@ import UnliftIO.Exception
|
||||
import UnliftIO.Process
|
||||
|
||||
|
||||
-- | Introduce a MinIO server on a Kubernetes cluster.
|
||||
-- Must have a 'minioOperator' context.
|
||||
introduceK8SMinioS3Server :: (
|
||||
HasBaseContext context, MonadMask m, MonadBaseControl IO m, MonadUnliftIO m, HasMinioOperatorContext context
|
||||
MonadMask m, MonadUnliftIO m
|
||||
, HasBaseContextMonad context m, HasMinioOperatorContext context, HasKubernetesClusterContext context
|
||||
, HasFile context "kubectl", HasFile context "kubectl-minio"
|
||||
) => Text -> SpecFree (LabelValue "testS3Server" TestS3Server :> context) m () -> SpecFree context m ()
|
||||
introduceK8SMinioS3Server namespace = do
|
||||
introduceWith "minio S3 server" testS3Server $ \action -> do
|
||||
kcc <- getContext kubernetesCluster
|
||||
moc <- getContext minioOperator
|
||||
withK8SMinioS3Server kcc moc namespace action
|
||||
|
||||
-- | Same as 'introduceK8SMinioS3Server', but allows you to pass in the 'KubernetesClusterContext'.
|
||||
introduceK8SMinioS3Server' :: (
|
||||
MonadMask m, MonadUnliftIO m
|
||||
, HasBaseContextMonad context m, HasMinioOperatorContext context, HasFile context "kubectl", HasFile context "kubectl-minio"
|
||||
) => KubernetesClusterContext -> Text -> SpecFree (LabelValue "testS3Server" TestS3Server :> context) m () -> SpecFree context m ()
|
||||
introduceK8SMinioS3Server kubernetesClusterContext namespace =
|
||||
introduceK8SMinioS3Server' kubernetesClusterContext namespace =
|
||||
introduceWith "minio S3 server" testS3Server $ \action -> do
|
||||
moc <- getContext minioOperator
|
||||
withK8SMinioS3Server kubernetesClusterContext moc namespace action
|
||||
|
||||
-- | Bracket-style variant of 'introduceK8SMinioS3Server'.
|
||||
withK8SMinioS3Server :: (
|
||||
MonadLoggerIO m, MonadMask m, MonadBaseControl IO m, MonadUnliftIO m, MonadFail m
|
||||
, HasBaseContextMonad context m
|
||||
MonadLoggerIO m, MonadMask m, MonadUnliftIO m, MonadFail m
|
||||
, HasBaseContextMonad context m, HasFile context "kubectl", HasFile context "kubectl-minio"
|
||||
) => KubernetesClusterContext -> MinioOperatorContext -> Text -> (TestS3Server -> m [Result]) -> m ()
|
||||
withK8SMinioS3Server (KubernetesClusterContext {..}) MinioOperatorContext namespace action = do
|
||||
withK8SMinioS3Server kcc moc namespace action = do
|
||||
kubectlBinary <- askFile @"kubectl"
|
||||
kubectlMinioBinary <- askFile @"kubectl-minio"
|
||||
withK8SMinioS3Server' kubectlBinary kubectlMinioBinary kcc moc namespace action
|
||||
|
||||
withK8SMinioS3Server' :: (
|
||||
MonadLoggerIO m, MonadMask m, MonadUnliftIO m, MonadFail m
|
||||
, HasBaseContextMonad context m
|
||||
) => FilePath -> FilePath -> KubernetesClusterContext -> MinioOperatorContext -> Text -> (TestS3Server -> m [Result]) -> m ()
|
||||
withK8SMinioS3Server' kubectlBinary kubectlMinioBinary (KubernetesClusterContext {..}) MinioOperatorContext namespace action = do
|
||||
baseEnv <- getEnvironment
|
||||
let env = L.nubBy (\x y -> fst x == fst y) (("KUBECONFIG", kubernetesClusterKubeConfigPath) : baseEnv)
|
||||
let runWithKubeConfig cmd = do
|
||||
p <- createProcessWithLogging ((shell cmd) { env = Just env, delegate_ctlc = True })
|
||||
let runWithKubeConfig prog args = do
|
||||
p <- createProcessWithLogging ((proc prog args) { env = Just env, delegate_ctlc = True })
|
||||
waitForProcess p >>= (`shouldBe` ExitSuccess)
|
||||
|
||||
deploymentName <- ("minio-" <>) <$> makeUUID' 5
|
||||
|
||||
let pool = "pool1" :: Text
|
||||
let pool = "pool1"
|
||||
let port = 80
|
||||
|
||||
let create = do
|
||||
runWithKubeConfig [iii|kubectl minio tenant create #{deploymentName}
|
||||
--namespace #{namespace}
|
||||
--servers 1
|
||||
--volumes 1
|
||||
--capacity 10G
|
||||
--pool #{pool}
|
||||
--disable-tls
|
||||
|]
|
||||
runWithKubeConfig kubectlMinioBinary [
|
||||
"tenant", "create", toString deploymentName
|
||||
, "--namespace", toString namespace
|
||||
, "--servers", "1"
|
||||
, "--volumes", "1"
|
||||
, "--capacity", "10G"
|
||||
, "--pool", pool
|
||||
, "--disable-tls"
|
||||
]
|
||||
|
||||
let destroy = do
|
||||
runWithKubeConfig [i|kubectl minio tenant delete #{deploymentName} --namespace #{namespace} -f|]
|
||||
runWithKubeConfig kubectlMinioBinary ["tenant", "delete", toString deploymentName
|
||||
, "--namespace", toString namespace
|
||||
, "-f"
|
||||
]
|
||||
|
||||
bracket_ create destroy $ do
|
||||
Right envConfig <- ((B64.decode . encodeUtf8 . T.strip . toText) <$>) $
|
||||
readCreateProcess ((shell [iii|kubectl get secret #{deploymentName}-env-configuration
|
||||
--namespace #{namespace}
|
||||
-o jsonpath="{.data.config\\.env}"|]) { env = Just env }) ""
|
||||
readCreateProcess ((proc kubectlBinary ["get", "secret", [i|#{deploymentName}-env-configuration|]
|
||||
, "--namespace", toString namespace
|
||||
, "-o", [i|jsonpath="{.data.config\\.env}"|]
|
||||
]) { env = Just env }) ""
|
||||
info [i|Got envConfig: #{envConfig}|]
|
||||
|
||||
Just (username, password) <- return (parseMinioUserAndPassword (decodeUtf8 envConfig))
|
||||
@ -79,7 +117,7 @@ withK8SMinioS3Server (KubernetesClusterContext {..}) MinioOperatorContext namesp
|
||||
|
||||
do
|
||||
uuid <- makeUUID
|
||||
p <- createProcessWithLogging ((proc "kubectl" [
|
||||
p <- createProcessWithLogging ((proc kubectlBinary [
|
||||
"run", "discoverer-" <> toString uuid
|
||||
, "--rm", "-i"
|
||||
, "--attach"
|
||||
@ -96,7 +134,7 @@ withK8SMinioS3Server (KubernetesClusterContext {..}) MinioOperatorContext namesp
|
||||
export KUBECONFIG=#{kubernetesClusterKubeConfigPath}
|
||||
kubectl --namespace #{namespace} port-forward "service/minio" 8080:#{port}|]
|
||||
|
||||
withKubectlPortForward kubernetesClusterKubeConfigPath namespace "service/minio" port $ \(KubectlPortForwardContext {..}) -> do
|
||||
withKubectlPortForward' kubectlBinary kubernetesClusterKubeConfigPath namespace (const True) Nothing "service/minio" port $ \(KubectlPortForwardContext {..}) -> do
|
||||
info [i|Did forward to localhost:#{kubectlPortForwardPort}|]
|
||||
-- liftIO $ threadDelay 999999999999
|
||||
|
||||
@ -118,15 +156,3 @@ withK8SMinioS3Server (KubernetesClusterContext {..}) MinioOperatorContext namesp
|
||||
waitUntilStatusCodeWithTimeout (4, 0, 3) (1_000_000 * 60 * 5) NoVerify (toString (testS3ServerEndpoint testServ))
|
||||
|
||||
void $ action testServ
|
||||
|
||||
|
||||
-- main :: IO ()
|
||||
-- main = do
|
||||
-- runSandwichWithCommandLineArgs defaultOptions $ do
|
||||
-- introduceK8SMinioS3Server $ do
|
||||
-- it "spins up a demo minio server" $ do
|
||||
-- fss <- getContext testS3Server
|
||||
-- info [i|Got test S3 server: #{fss}|]
|
||||
|
||||
-- it "waits forever" $ do
|
||||
-- forever (threadDelay maxBound)
|
||||
|
13
stack.yaml
13
stack.yaml
@ -83,3 +83,16 @@ extra-deps:
|
||||
- git: https://github.com/codedownio/haskell-oidc-client
|
||||
# codedown-jan-2024-ghc96
|
||||
commit: 4c122412e80c45bd28d03ead16f1a153bd53fcf4
|
||||
|
||||
# https://github.com/kubernetes-client/haskell/issues/64
|
||||
# https://github.com/channable/vaultenv/issues/99
|
||||
- git: https://github.com/codedownio/hs-certificate
|
||||
# codedown-feb-2024
|
||||
# This branch
|
||||
# 1. Takes akshaymankar's fixes from https://github.com/haskell-tls/hs-certificate/pull/113
|
||||
# and rebases them on the most recent https://github.com/haskell-tls/hs-certificate master branch
|
||||
# 2. Cherry-picks kazuyamamoto's commit switching the package tocrypton, from here:
|
||||
# https://github.com/kazu-yamamoto/crypton-certificate/commit/c11bbbeec2360ce797c5eb3bd4953cbc5bf1a0d6
|
||||
commit: dcd0d5b200e96e90c6daa728585c23be5309a955
|
||||
subdirs:
|
||||
- x509-validation
|
||||
|
@ -70,6 +70,19 @@ packages:
|
||||
original:
|
||||
commit: 4c122412e80c45bd28d03ead16f1a153bd53fcf4
|
||||
git: https://github.com/codedownio/haskell-oidc-client
|
||||
- completed:
|
||||
commit: dcd0d5b200e96e90c6daa728585c23be5309a955
|
||||
git: https://github.com/codedownio/hs-certificate
|
||||
name: crypton-x509-validation
|
||||
pantry-tree:
|
||||
sha256: a33d18d3ebc3011afac3a2fb39b1492b3c4687d332eb33ffcb4557bced4ce8a6
|
||||
size: 639
|
||||
subdir: x509-validation
|
||||
version: 1.6.12
|
||||
original:
|
||||
commit: dcd0d5b200e96e90c6daa728585c23be5309a955
|
||||
git: https://github.com/codedownio/hs-certificate
|
||||
subdir: x509-validation
|
||||
snapshots:
|
||||
- completed:
|
||||
sha256: e2c529ccfb21501f98f639e056cbde50470b86256d9849d7a82d414ca23e4276
|
||||
|
Loading…
Reference in New Issue
Block a user