mirror of
https://github.com/codedownio/sandwich.git
synced 2024-10-26 20:49:20 +03:00
More haddocks work
This commit is contained in:
parent
de0e7afedb
commit
b3eef612aa
@ -70,5 +70,5 @@ withMinioOperator' kubectlMinioBinary (KubernetesClusterContext {..}) action = d
|
||||
|
||||
bracket_ (runWithKubeConfig kubectlMinioBinary ["init"])
|
||||
-- Can't delete -f yet; see https://github.com/minio/operator/issues/1683
|
||||
(return ()) -- (runWithKubeConfig [i|kubectl-minio delete|])
|
||||
(return ()) -- (runWithKubeConfig kubectlMinioBinary ["delete"])
|
||||
(action MinioOperatorContext)
|
||||
|
@ -7,7 +7,6 @@ module Test.Sandwich.Contexts.Kubernetes.Namespace (
|
||||
withKubernetesNamespace
|
||||
) where
|
||||
|
||||
import Test.Sandwich.Contexts.Kubernetes.KindCluster
|
||||
import Control.Monad
|
||||
import Control.Monad.Catch (MonadThrow)
|
||||
import Control.Monad.IO.Unlift
|
||||
@ -17,14 +16,21 @@ import Data.String.Interpolate
|
||||
import Relude
|
||||
import System.Exit
|
||||
import Test.Sandwich
|
||||
import Test.Sandwich.Contexts.Kubernetes.KindCluster
|
||||
import UnliftIO.Environment
|
||||
import UnliftIO.Exception
|
||||
import UnliftIO.Process
|
||||
|
||||
|
||||
-- | Around-style node to create a Kubernetes namespace, and destroy it at the end.
|
||||
-- If you're installing something via Helm 3, you may not need this as you can just pass "--create-namespace".
|
||||
withKubernetesNamespace :: (
|
||||
MonadUnliftIO m, HasLabel context "kubernetesCluster" KubernetesClusterContext, MonadBaseControl IO m, MonadThrow m
|
||||
) => Text -> SpecFree context m () -> SpecFree context m ()
|
||||
)
|
||||
-- | Namespace to create
|
||||
=> Text
|
||||
-> SpecFree context m ()
|
||||
-> SpecFree context m ()
|
||||
withKubernetesNamespace namespace = around [i|Create the '#{namespace}' kubernetes namespace|] (void . bracket_ create destroy)
|
||||
where
|
||||
create = runWithKubeConfig [i|kubectl create namespace #{namespace}|] >>= waitForProcess >>= (`shouldBe` ExitSuccess)
|
||||
|
@ -5,27 +5,28 @@
|
||||
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
|
||||
|
||||
module Test.Sandwich.Contexts.MinIO (
|
||||
MinIOContextOptions (..)
|
||||
, defaultMinIOContextOptions
|
||||
|
||||
, introduceMinIOViaNix
|
||||
-- * Introducing MinIO
|
||||
introduceMinIOViaNix
|
||||
, withMinIOViaBinary
|
||||
, withMinIO
|
||||
|
||||
, introduceMinIOViaContainer
|
||||
, withMinIOContainer
|
||||
, withMinIO'
|
||||
|
||||
, testS3Server
|
||||
, TestS3Server(..)
|
||||
, HasTestS3Server
|
||||
, HttpMode(..)
|
||||
|
||||
-- * Helpers for constructing connections
|
||||
, testS3ServerEndpoint
|
||||
, testS3ServerContainerEndpoint
|
||||
, testS3ServerConnectInfo
|
||||
|
||||
-- * Re-exports
|
||||
, testS3Server
|
||||
, TestS3Server(..)
|
||||
, HasTestS3Server
|
||||
, HttpMode(..)
|
||||
, NetworkAddress(..)
|
||||
|
||||
-- * Types
|
||||
, MinIOContextOptions (..)
|
||||
, defaultMinIOContextOptions
|
||||
) where
|
||||
|
||||
import Control.Monad
|
||||
@ -87,27 +88,40 @@ defaultMinIOContextOptions = MinIOContextOptions {
|
||||
|
||||
-- * Raw
|
||||
|
||||
-- | Introduce a MinIO server, deriving the MinIO binary from the Nix context.
|
||||
introduceMinIOViaNix :: (
|
||||
HasBaseContext context, HasNixContext context, MonadMask m, MonadUnliftIO m
|
||||
) => MinIOContextOptions
|
||||
)
|
||||
-- | Options
|
||||
=> MinIOContextOptions
|
||||
-> SpecFree (LabelValue "testS3Server" TestS3Server :> LabelValue (AppendSymbol "file-" "minio") (EnvironmentFile "minio") :> context) m ()
|
||||
-> SpecFree context m ()
|
||||
introduceMinIOViaNix options = introduceBinaryViaNixPackage @"minio" "minio" .
|
||||
introduceWith "MinIO S3 server (via Nix binary)" testS3Server (withMinIOViaBinary options)
|
||||
|
||||
-- | Bracket-style variant of introduceMinIOViaBinary
|
||||
withMinIOViaBinary :: (
|
||||
HasBaseContextMonad context m, HasFile context "minio"
|
||||
, MonadLoggerIO m, MonadMask m, MonadUnliftIO m
|
||||
) => MinIOContextOptions -> (TestS3Server -> m [Result]) -> m ()
|
||||
)
|
||||
-- | Options
|
||||
=> MinIOContextOptions
|
||||
-> (TestS3Server -> m [Result])
|
||||
-> m ()
|
||||
withMinIOViaBinary options action = do
|
||||
minioPath <- askFile @"minio"
|
||||
withMinIO minioPath options action
|
||||
withMinIO' minioPath options action
|
||||
|
||||
withMinIO :: (
|
||||
withMinIO' :: (
|
||||
HasBaseContextMonad context m
|
||||
, MonadLoggerIO m, MonadMask m, MonadUnliftIO m
|
||||
) => FilePath -> MinIOContextOptions -> (TestS3Server -> m [Result]) -> m ()
|
||||
withMinIO minioPath (MinIOContextOptions {..}) action = do
|
||||
)
|
||||
-- | Path to the minio binary
|
||||
=> FilePath
|
||||
-> MinIOContextOptions
|
||||
-> (TestS3Server -> m [Result])
|
||||
-> m ()
|
||||
withMinIO' minioPath (MinIOContextOptions {..}) action = do
|
||||
dir <- getCurrentFolder >>= \case
|
||||
Nothing -> expectationFailure "withMinIOViaBinary must be run with a current directory."
|
||||
Just x -> return x
|
||||
@ -174,12 +188,18 @@ withMinIO minioPath (MinIOContextOptions {..}) action = do
|
||||
|
||||
-- * Container
|
||||
|
||||
-- | Introduce a MinIO server by launching a container.
|
||||
introduceMinIOViaContainer :: (
|
||||
HasBaseContext context, MonadMask m, MonadUnliftIO m
|
||||
) => MinIOContextOptions -> SpecFree (LabelValue "testS3Server" TestS3Server :> context) m () -> SpecFree context m ()
|
||||
)
|
||||
-- | Options
|
||||
=> MinIOContextOptions
|
||||
-> SpecFree (LabelValue "testS3Server" TestS3Server :> context) m ()
|
||||
-> SpecFree context m ()
|
||||
introduceMinIOViaContainer options = introduceWith "MinIO S3 server (via container)" testS3Server $ \action -> do
|
||||
withMinIOContainer options action
|
||||
|
||||
-- | Bracket-style variant of 'introduceMinIOViaContainer'.
|
||||
withMinIOContainer :: (
|
||||
HasBaseContextMonad context m
|
||||
, MonadLoggerIO m, MonadMask m, MonadUnliftIO m
|
||||
|
Loading…
Reference in New Issue
Block a user