mirror of
https://github.com/codedownio/sandwich.git
synced 2024-10-26 20:49:20 +03:00
Fix kubernetes contexts module names and be able to introduce minikube via Nix
This commit is contained in:
parent
a1bdc525f6
commit
3c2b8bb659
@ -2,12 +2,14 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.Cluster (
|
||||
module Test.Sandwich.Contexts.Kubernetes.Cluster (
|
||||
KubernetesClusterContext (..)
|
||||
|
||||
, Kind.introduceKindCluster
|
||||
|
||||
, Minikube.introduceMinikubeCluster
|
||||
, Minikube.introduceMinikubeClusterViaNix
|
||||
, Minikube.introduceMinikubeClusterViaEnvironment
|
||||
, Minikube.introduceMinikubeCluster'
|
||||
, Minikube.MinikubeClusterOptions(..)
|
||||
, Minikube.defaultMinikubeClusterOptions
|
||||
|
||||
@ -22,17 +24,13 @@ module Sandwich.Contexts.Kubernetes.Cluster (
|
||||
, kubernetesCluster
|
||||
, HasKubernetesClusterContext
|
||||
|
||||
, module Sandwich.Contexts.Kubernetes.KubectlLogs
|
||||
, module Sandwich.Contexts.Kubernetes.KubectlPortForward
|
||||
, module Test.Sandwich.Contexts.Kubernetes.KubectlLogs
|
||||
, module Test.Sandwich.Contexts.Kubernetes.KubectlPortForward
|
||||
|
||||
-- * Util
|
||||
, Util.parseHostnameAndPort
|
||||
) where
|
||||
|
||||
import Sandwich.Contexts.Kubernetes.KubectlLogs
|
||||
import Sandwich.Contexts.Kubernetes.KubectlPortForward
|
||||
import Sandwich.Contexts.Kubernetes.Types
|
||||
import Sandwich.Contexts.Kubernetes.Waits
|
||||
import Control.Monad.Catch
|
||||
import Control.Monad.IO.Unlift
|
||||
import Control.Monad.Logger
|
||||
@ -41,14 +39,18 @@ import Control.Monad.Trans.Control (MonadBaseControl)
|
||||
import Network.URI
|
||||
import Relude
|
||||
import Test.Sandwich
|
||||
import Test.Sandwich.Contexts.Kubernetes.KubectlLogs
|
||||
import Test.Sandwich.Contexts.Kubernetes.KubectlPortForward
|
||||
import Test.Sandwich.Contexts.Kubernetes.Types
|
||||
import Test.Sandwich.Contexts.Kubernetes.Waits
|
||||
|
||||
import qualified Sandwich.Contexts.Kubernetes.KindCluster as Kind
|
||||
import qualified Sandwich.Contexts.Kubernetes.KindCluster.ServiceForwardPortForward as Kind
|
||||
import qualified Test.Sandwich.Contexts.Kubernetes.KindCluster as Kind
|
||||
import qualified Test.Sandwich.Contexts.Kubernetes.KindCluster.ServiceForwardPortForward as Kind
|
||||
|
||||
import qualified Sandwich.Contexts.Kubernetes.MinikubeCluster as Minikube
|
||||
import qualified Sandwich.Contexts.Kubernetes.MinikubeCluster.Forwards as Minikube
|
||||
import qualified Test.Sandwich.Contexts.Kubernetes.MinikubeCluster as Minikube
|
||||
import qualified Test.Sandwich.Contexts.Kubernetes.MinikubeCluster.Forwards as Minikube
|
||||
|
||||
import qualified Sandwich.Contexts.Kubernetes.Util as Util
|
||||
import qualified Test.Sandwich.Contexts.Kubernetes.Util as Util
|
||||
|
||||
|
||||
withForwardKubernetesService :: (
|
@ -4,7 +4,7 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.KindCluster (
|
||||
module Test.Sandwich.Contexts.Kubernetes.KindCluster (
|
||||
KubernetesClusterContext (..)
|
||||
, introduceKindCluster
|
||||
|
||||
@ -21,12 +21,12 @@ module Sandwich.Contexts.Kubernetes.KindCluster (
|
||||
, HasKubernetesClusterContext
|
||||
) where
|
||||
|
||||
import Sandwich.Contexts.Kubernetes.KindCluster.Config
|
||||
import Sandwich.Contexts.Kubernetes.KindCluster.Images
|
||||
import Sandwich.Contexts.Kubernetes.KindCluster.Setup
|
||||
import Sandwich.Contexts.Kubernetes.Types
|
||||
import Sandwich.Contexts.Kubernetes.Util.Container (isInContainer)
|
||||
import Sandwich.Contexts.Kubernetes.Util.UUID
|
||||
import Test.Sandwich.Contexts.Kubernetes.KindCluster.Config
|
||||
import Test.Sandwich.Contexts.Kubernetes.KindCluster.Images
|
||||
import Test.Sandwich.Contexts.Kubernetes.KindCluster.Setup
|
||||
import Test.Sandwich.Contexts.Kubernetes.Types
|
||||
import Test.Sandwich.Contexts.Kubernetes.Util.Container (isInContainer)
|
||||
import Test.Sandwich.Contexts.Kubernetes.Util.UUID
|
||||
import Control.Exception.Lifted (bracket, bracket_)
|
||||
import Control.Monad
|
||||
import Control.Monad.Catch (MonadMask)
|
@ -4,7 +4,7 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.KindCluster.Config where
|
||||
module Test.Sandwich.Contexts.Kubernetes.KindCluster.Config where
|
||||
|
||||
import qualified Data.List as L
|
||||
import Data.String.Interpolate
|
@ -3,10 +3,10 @@
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.KindCluster.Images where
|
||||
module Test.Sandwich.Contexts.Kubernetes.KindCluster.Images where
|
||||
|
||||
import Sandwich.Contexts.Kubernetes.Types
|
||||
import Sandwich.Contexts.Kubernetes.Util.Container
|
||||
import Test.Sandwich.Contexts.Kubernetes.Types
|
||||
import Test.Sandwich.Contexts.Kubernetes.Util.Container
|
||||
import Control.Monad.IO.Unlift
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Trans.Control (MonadBaseControl)
|
@ -1,5 +1,5 @@
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.KindCluster.Network () where
|
||||
module Test.Sandwich.Contexts.Kubernetes.KindCluster.Network () where
|
||||
|
||||
-- linkContainer :: (MonadLoggerIO m, MonadCatch m) => Text -> m ()
|
||||
-- linkContainer containerName = do
|
@ -3,9 +3,9 @@
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.KindCluster.ServiceForwardIngress where
|
||||
module Test.Sandwich.Contexts.Kubernetes.KindCluster.ServiceForwardIngress where
|
||||
|
||||
import Sandwich.Contexts.Kubernetes.Types
|
||||
import Test.Sandwich.Contexts.Kubernetes.Types
|
||||
import Control.Lens
|
||||
import Control.Lens.Regex.Text
|
||||
import Control.Monad
|
@ -3,10 +3,10 @@
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.KindCluster.ServiceForwardPortForward where
|
||||
module Test.Sandwich.Contexts.Kubernetes.KindCluster.ServiceForwardPortForward where
|
||||
|
||||
import Sandwich.Contexts.Kubernetes.Types
|
||||
import Sandwich.Contexts.Kubernetes.KubectlPortForward
|
||||
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
|
@ -4,10 +4,10 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.KindCluster.Setup where
|
||||
module Test.Sandwich.Contexts.Kubernetes.KindCluster.Setup where
|
||||
|
||||
import Sandwich.Contexts.Kubernetes.Types
|
||||
import Sandwich.Contexts.Kubernetes.Waits
|
||||
import Test.Sandwich.Contexts.Kubernetes.Types
|
||||
import Test.Sandwich.Contexts.Kubernetes.Waits
|
||||
import Control.Monad
|
||||
import Control.Monad.Catch ( MonadMask)
|
||||
import Control.Monad.IO.Unlift
|
@ -1,5 +1,5 @@
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.KubectlLogs (
|
||||
module Test.Sandwich.Contexts.Kubernetes.KubectlLogs (
|
||||
KubectlLogsContext (..)
|
||||
, withKubectlLogs
|
||||
) where
|
@ -1,13 +1,13 @@
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.KubectlPortForward (
|
||||
module Test.Sandwich.Contexts.Kubernetes.KubectlPortForward (
|
||||
KubectlPortForwardContext (..)
|
||||
|
||||
, withKubectlPortForward
|
||||
, withKubectlPortForward'
|
||||
) where
|
||||
|
||||
import Sandwich.Contexts.Kubernetes.Util.Ports
|
||||
import Sandwich.Contexts.Kubernetes.Util.SocketUtil
|
||||
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
|
@ -1,11 +1,14 @@
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.MinikubeCluster (
|
||||
module Test.Sandwich.Contexts.Kubernetes.MinikubeCluster (
|
||||
KubernetesClusterContext (..)
|
||||
, introduceMinikubeCluster
|
||||
, introduceMinikubeClusterViaNix
|
||||
, introduceMinikubeClusterViaEnvironment
|
||||
, introduceMinikubeCluster'
|
||||
|
||||
, MinikubeClusterOptions (..)
|
||||
, defaultMinikubeClusterOptions
|
||||
@ -27,9 +30,6 @@ module Sandwich.Contexts.Kubernetes.MinikubeCluster (
|
||||
, HasKubernetesClusterContext
|
||||
) where
|
||||
|
||||
import Sandwich.Contexts.Kubernetes.MinikubeCluster.Images
|
||||
import Sandwich.Contexts.Kubernetes.Types
|
||||
import Sandwich.Contexts.Kubernetes.Util.UUID
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Unlift
|
||||
import Control.Monad.Logger
|
||||
@ -42,6 +42,11 @@ import System.Exit
|
||||
import System.FilePath
|
||||
import System.IO.Temp
|
||||
import Test.Sandwich
|
||||
import Test.Sandwich.Contexts.Files
|
||||
import Test.Sandwich.Contexts.Kubernetes.MinikubeCluster.Images
|
||||
import Test.Sandwich.Contexts.Kubernetes.Types
|
||||
import Test.Sandwich.Contexts.Kubernetes.Util.UUID
|
||||
import Test.Sandwich.Contexts.Nix
|
||||
import UnliftIO.Environment
|
||||
import UnliftIO.Exception
|
||||
import UnliftIO.IO
|
||||
@ -68,16 +73,32 @@ defaultMinikubeClusterOptions = MinikubeClusterOptions {
|
||||
|
||||
-- * Introduce
|
||||
|
||||
introduceMinikubeCluster :: (
|
||||
introduceMinikubeClusterViaNix :: (
|
||||
HasBaseContext context, MonadUnliftIO m, HasNixContext context
|
||||
) => MinikubeClusterOptions -> SpecFree (LabelValue "kubernetesCluster" KubernetesClusterContext :> LabelValue "file-minikube" (EnvironmentFile "minikube") :> context) m () -> SpecFree context m ()
|
||||
introduceMinikubeClusterViaNix minikubeClusterOptions spec =
|
||||
introduceBinaryViaNixPackage @"minikube" "minikube" $
|
||||
introduceWith "introduce minikube cluster" kubernetesCluster (void . withMinikubeCluster minikubeClusterOptions) spec
|
||||
|
||||
introduceMinikubeClusterViaEnvironment :: (
|
||||
HasBaseContext context, MonadUnliftIO m
|
||||
) => MinikubeClusterOptions -> SpecFree (LabelValue "kubernetesCluster" KubernetesClusterContext :> context) m () -> SpecFree context m ()
|
||||
introduceMinikubeCluster minikubeClusterOptions = introduceWith "introduce minikube cluster" kubernetesCluster $ \action ->
|
||||
void $ withMinikubeCluster minikubeClusterOptions action
|
||||
) => MinikubeClusterOptions -> SpecFree (LabelValue "kubernetesCluster" KubernetesClusterContext :> LabelValue "file-minikube" (EnvironmentFile "minikube") :> context) m () -> SpecFree context m ()
|
||||
introduceMinikubeClusterViaEnvironment minikubeClusterOptions spec =
|
||||
introduceBinaryViaEnvironment @"minikube" $
|
||||
introduceWith "introduce minikube cluster" kubernetesCluster (void . withMinikubeCluster minikubeClusterOptions) spec
|
||||
|
||||
introduceMinikubeCluster' :: (
|
||||
HasBaseContext context, MonadUnliftIO m
|
||||
) => FilePath -> MinikubeClusterOptions -> SpecFree (LabelValue "kubernetesCluster" KubernetesClusterContext :> LabelValue "file-minikube" (EnvironmentFile "minikube") :> context) m () -> SpecFree context m ()
|
||||
introduceMinikubeCluster' minikubeBinary minikubeClusterOptions spec =
|
||||
introduceFile @"minikube" minikubeBinary $
|
||||
introduceWith "introduce minikube cluster" kubernetesCluster (void . withMinikubeCluster minikubeClusterOptions) $
|
||||
spec
|
||||
|
||||
-- * Implementation
|
||||
|
||||
withMinikubeCluster :: (
|
||||
MonadReader context m, HasBaseContext context
|
||||
MonadReader context m, HasBaseContext context, HasFile context "minikube"
|
||||
, MonadLoggerIO m, MonadUnliftIO m, MonadFail m
|
||||
) => MinikubeClusterOptions -> (KubernetesClusterContext -> m a) -> m a
|
||||
withMinikubeCluster options@(MinikubeClusterOptions {..}) action = do
|
||||
@ -87,7 +108,7 @@ withMinikubeCluster options@(MinikubeClusterOptions {..}) action = do
|
||||
withNewMinikubeCluster clusterName options action
|
||||
|
||||
withNewMinikubeCluster :: (
|
||||
MonadReader context m, HasBaseContext context
|
||||
MonadReader context m, HasBaseContext context, HasFile context "minikube"
|
||||
, MonadLoggerIO m, MonadUnliftIO m, MonadFail m
|
||||
) => String -> MinikubeClusterOptions -> (KubernetesClusterContext -> m a) -> m a
|
||||
withNewMinikubeCluster clusterName options@(MinikubeClusterOptions {..}) action = do
|
||||
@ -146,7 +167,7 @@ withNewMinikubeCluster clusterName options@(MinikubeClusterOptions {..}) action
|
||||
)
|
||||
|
||||
startMinikubeCluster :: (
|
||||
MonadLoggerIO m
|
||||
MonadLoggerIO m, MonadReader context m, HasFile context "minikube"
|
||||
) => Handle -> String -> String -> MinikubeClusterOptions -> m ProcessHandle
|
||||
startMinikubeCluster logH clusterName minikubeKubeConfigFile (MinikubeClusterOptions {..}) = do
|
||||
baseEnv <- getEnvironment
|
||||
@ -168,6 +189,8 @@ startMinikubeCluster logH clusterName minikubeKubeConfigFile (MinikubeClusterOpt
|
||||
, [i|--cpus=#{fromMaybe "8" minikubeClusterCpus}|]
|
||||
]
|
||||
|
||||
minikube <- askFile @"minikube"
|
||||
|
||||
let args = ["start"
|
||||
, "--profile", clusterName
|
||||
, "--logtostderr"
|
||||
@ -177,7 +200,7 @@ startMinikubeCluster logH clusterName minikubeKubeConfigFile (MinikubeClusterOpt
|
||||
<> driverAndResourceFlags
|
||||
<> (fmap toString minikubeClusterExtraFlags)
|
||||
|
||||
debug [i|Starting minikube with args: #{T.unwords $ fmap toText args}|]
|
||||
debug [i|Starting minikube with args: #{minikube} #{T.unwords $ fmap toText args}|]
|
||||
|
||||
(_, _, _, p) <- createProcess (
|
||||
(proc "minikube" args) {
|
@ -3,9 +3,9 @@
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.MinikubeCluster.Forwards where
|
||||
module Test.Sandwich.Contexts.Kubernetes.MinikubeCluster.Forwards where
|
||||
|
||||
import Sandwich.Contexts.Kubernetes.Types
|
||||
import Test.Sandwich.Contexts.Kubernetes.Types
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Unlift
|
||||
import Control.Monad.Logger
|
@ -3,7 +3,7 @@
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.MinikubeCluster.Images where
|
||||
module Test.Sandwich.Contexts.Kubernetes.MinikubeCluster.Images where
|
||||
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Unlift
|
||||
@ -12,8 +12,8 @@ import qualified Data.List as L
|
||||
import Data.String.Interpolate
|
||||
import Data.Text as T
|
||||
import Relude
|
||||
import Sandwich.Contexts.Kubernetes.Types
|
||||
import Sandwich.Contexts.Kubernetes.Util.Container
|
||||
import Test.Sandwich.Contexts.Kubernetes.Types
|
||||
import Test.Sandwich.Contexts.Kubernetes.Util.Container
|
||||
import System.Exit
|
||||
import System.FilePath
|
||||
import Test.Sandwich
|
@ -3,7 +3,7 @@
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.MinioOperator (
|
||||
module Test.Sandwich.Contexts.Kubernetes.MinioOperator (
|
||||
MinioOperatorContext(..)
|
||||
, HasMinioOperatorContext
|
||||
|
||||
@ -12,7 +12,7 @@ module Sandwich.Contexts.Kubernetes.MinioOperator (
|
||||
, withMinioOperator
|
||||
) where
|
||||
|
||||
import Sandwich.Contexts.Kubernetes.Types
|
||||
import Test.Sandwich.Contexts.Kubernetes.Types
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Unlift
|
||||
import Control.Monad.Logger
|
@ -1,15 +1,15 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.MinioS3Server (
|
||||
module Test.Sandwich.Contexts.Kubernetes.MinioS3Server (
|
||||
introduceK8SMinioS3Server
|
||||
, withK8SMinioS3Server
|
||||
) where
|
||||
|
||||
import Sandwich.Contexts.Kubernetes.Cluster
|
||||
import Sandwich.Contexts.Kubernetes.MinioS3Server.Parsing
|
||||
import Sandwich.Contexts.Kubernetes.Types
|
||||
import Sandwich.Contexts.Kubernetes.Util.UUID
|
||||
import Test.Sandwich.Contexts.Kubernetes.Cluster
|
||||
import Test.Sandwich.Contexts.Kubernetes.MinioS3Server.Parsing
|
||||
import Test.Sandwich.Contexts.Kubernetes.Types
|
||||
import Test.Sandwich.Contexts.Kubernetes.Util.UUID
|
||||
import Control.Monad
|
||||
import Control.Monad.Catch (MonadMask)
|
||||
import Control.Monad.IO.Unlift
|
@ -1,6 +1,6 @@
|
||||
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.MinioS3Server.Parsing (
|
||||
module Test.Sandwich.Contexts.Kubernetes.MinioS3Server.Parsing (
|
||||
parseMinioUserAndPassword
|
||||
) where
|
||||
|
@ -3,11 +3,11 @@
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.Namespace (
|
||||
module Test.Sandwich.Contexts.Kubernetes.Namespace (
|
||||
withKubernetesNamespace
|
||||
) where
|
||||
|
||||
import Sandwich.Contexts.Kubernetes.KindCluster
|
||||
import Test.Sandwich.Contexts.Kubernetes.KindCluster
|
||||
import Control.Monad
|
||||
import Control.Monad.Catch (MonadThrow)
|
||||
import Control.Monad.IO.Unlift
|
@ -4,9 +4,9 @@
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.Run where
|
||||
module Test.Sandwich.Contexts.Kubernetes.Run where
|
||||
|
||||
import Sandwich.Contexts.Kubernetes.Types
|
||||
import Test.Sandwich.Contexts.Kubernetes.Types
|
||||
import Control.Monad
|
||||
import Control.Monad.Catch (MonadMask, MonadThrow)
|
||||
import Control.Monad.IO.Unlift
|
@ -6,7 +6,7 @@
|
||||
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
|
||||
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.SeaweedFS (
|
||||
module Test.Sandwich.Contexts.Kubernetes.SeaweedFS (
|
||||
introduceSeaweedFSCluster
|
||||
, withSeaweedFS
|
||||
, withSeaweedFS'
|
||||
@ -19,9 +19,9 @@ module Sandwich.Contexts.Kubernetes.SeaweedFS (
|
||||
, HasSeaweedFSContext
|
||||
) where
|
||||
|
||||
import Sandwich.Contexts.Kubernetes.MinikubeCluster
|
||||
import Sandwich.Contexts.Kubernetes.Types
|
||||
import Sandwich.Contexts.Kubernetes.Util.Aeson
|
||||
import Test.Sandwich.Contexts.Kubernetes.MinikubeCluster
|
||||
import Test.Sandwich.Contexts.Kubernetes.Types
|
||||
import Test.Sandwich.Contexts.Kubernetes.Util.Aeson
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Unlift
|
||||
import Control.Monad.Logger
|
@ -7,7 +7,7 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.Types where
|
||||
module Test.Sandwich.Contexts.Kubernetes.Types where
|
||||
|
||||
import Kubernetes.OpenAPI.Core as Kubernetes
|
||||
import Network.HTTP.Client
|
@ -1,5 +1,5 @@
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.Util where
|
||||
module Test.Sandwich.Contexts.Kubernetes.Util where
|
||||
|
||||
import qualified Data.List as L
|
||||
import Data.String.Interpolate
|
@ -1,6 +1,6 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.Util.Aeson where
|
||||
module Test.Sandwich.Contexts.Kubernetes.Util.Aeson where
|
||||
|
||||
import qualified Data.Aeson as A
|
||||
import Data.Char
|
@ -1,7 +1,7 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.Util.Container (
|
||||
module Test.Sandwich.Contexts.Kubernetes.Util.Container (
|
||||
ContainerSystem (..)
|
||||
|
||||
, isInContainer
|
||||
@ -32,7 +32,7 @@ import qualified Data.Vector as V
|
||||
import Network.Socket (PortNumber)
|
||||
import Relude
|
||||
import Safe
|
||||
import Sandwich.Contexts.Kubernetes.Util.Aeson
|
||||
import Test.Sandwich.Contexts.Kubernetes.Util.Aeson
|
||||
import System.Exit
|
||||
import System.FilePath
|
||||
import Test.Sandwich
|
@ -1,5 +1,5 @@
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.Util.Exception where
|
||||
module Test.Sandwich.Contexts.Kubernetes.Util.Exception where
|
||||
|
||||
import Control.Monad.IO.Unlift
|
||||
import Relude
|
@ -1,5 +1,5 @@
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.Util.Nix (
|
||||
module Test.Sandwich.Contexts.Kubernetes.Util.Nix (
|
||||
withWritableBinaryCache
|
||||
) where
|
||||
|
@ -1,7 +1,7 @@
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.Util.Ports where
|
||||
module Test.Sandwich.Contexts.Kubernetes.Util.Ports where
|
||||
|
||||
import Control.Monad.Catch (MonadCatch, catch)
|
||||
import Control.Retry
|
@ -1,4 +1,4 @@
|
||||
module Sandwich.Contexts.Kubernetes.Util.SocketUtil (
|
||||
module Test.Sandwich.Contexts.Kubernetes.Util.SocketUtil (
|
||||
isPortOpen
|
||||
, simpleSockAddr
|
||||
) where
|
@ -1,5 +1,5 @@
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.Util.UUID where
|
||||
module Test.Sandwich.Contexts.Kubernetes.Util.UUID where
|
||||
|
||||
import qualified Data.List as L
|
||||
import Data.Text as T
|
@ -3,10 +3,10 @@
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Sandwich.Contexts.Kubernetes.Waits where
|
||||
module Test.Sandwich.Contexts.Kubernetes.Waits where
|
||||
|
||||
import Sandwich.Contexts.Kubernetes.Run
|
||||
import Sandwich.Contexts.Kubernetes.Types
|
||||
import Test.Sandwich.Contexts.Kubernetes.Run
|
||||
import Test.Sandwich.Contexts.Kubernetes.Types
|
||||
import Control.Monad.Catch (MonadMask)
|
||||
import Control.Monad.IO.Unlift
|
||||
import Control.Monad.Logger
|
@ -34,14 +34,14 @@ ghc-options:
|
||||
library:
|
||||
source-dirs: lib
|
||||
exposed-modules:
|
||||
- Sandwich.Contexts.Kubernetes.Cluster
|
||||
- Sandwich.Contexts.Kubernetes.KindCluster
|
||||
- Sandwich.Contexts.Kubernetes.MinikubeCluster
|
||||
- Sandwich.Contexts.Kubernetes.MinioOperator
|
||||
- Sandwich.Contexts.Kubernetes.MinioS3Server
|
||||
- Sandwich.Contexts.Kubernetes.Namespace
|
||||
- Sandwich.Contexts.Kubernetes.SeaweedFS
|
||||
- Sandwich.Contexts.Kubernetes.Types
|
||||
- Test.Sandwich.Contexts.Kubernetes.Cluster
|
||||
- Test.Sandwich.Contexts.Kubernetes.KindCluster
|
||||
- Test.Sandwich.Contexts.Kubernetes.MinikubeCluster
|
||||
- Test.Sandwich.Contexts.Kubernetes.MinioOperator
|
||||
- Test.Sandwich.Contexts.Kubernetes.MinioS3Server
|
||||
- Test.Sandwich.Contexts.Kubernetes.Namespace
|
||||
- Test.Sandwich.Contexts.Kubernetes.SeaweedFS
|
||||
- Test.Sandwich.Contexts.Kubernetes.Types
|
||||
dependencies:
|
||||
- aeson
|
||||
- base64-bytestring
|
||||
|
@ -15,36 +15,36 @@ build-type: Simple
|
||||
|
||||
library
|
||||
exposed-modules:
|
||||
Sandwich.Contexts.Kubernetes.Cluster
|
||||
Sandwich.Contexts.Kubernetes.KindCluster
|
||||
Sandwich.Contexts.Kubernetes.MinikubeCluster
|
||||
Sandwich.Contexts.Kubernetes.MinioOperator
|
||||
Sandwich.Contexts.Kubernetes.MinioS3Server
|
||||
Sandwich.Contexts.Kubernetes.Namespace
|
||||
Sandwich.Contexts.Kubernetes.SeaweedFS
|
||||
Sandwich.Contexts.Kubernetes.Types
|
||||
Test.Sandwich.Contexts.Kubernetes.Cluster
|
||||
Test.Sandwich.Contexts.Kubernetes.KindCluster
|
||||
Test.Sandwich.Contexts.Kubernetes.MinikubeCluster
|
||||
Test.Sandwich.Contexts.Kubernetes.MinioOperator
|
||||
Test.Sandwich.Contexts.Kubernetes.MinioS3Server
|
||||
Test.Sandwich.Contexts.Kubernetes.Namespace
|
||||
Test.Sandwich.Contexts.Kubernetes.SeaweedFS
|
||||
Test.Sandwich.Contexts.Kubernetes.Types
|
||||
other-modules:
|
||||
Sandwich.Contexts.Kubernetes.KindCluster.Config
|
||||
Sandwich.Contexts.Kubernetes.KindCluster.Images
|
||||
Sandwich.Contexts.Kubernetes.KindCluster.Network
|
||||
Sandwich.Contexts.Kubernetes.KindCluster.ServiceForwardIngress
|
||||
Sandwich.Contexts.Kubernetes.KindCluster.ServiceForwardPortForward
|
||||
Sandwich.Contexts.Kubernetes.KindCluster.Setup
|
||||
Sandwich.Contexts.Kubernetes.KubectlLogs
|
||||
Sandwich.Contexts.Kubernetes.KubectlPortForward
|
||||
Sandwich.Contexts.Kubernetes.MinikubeCluster.Forwards
|
||||
Sandwich.Contexts.Kubernetes.MinikubeCluster.Images
|
||||
Sandwich.Contexts.Kubernetes.MinioS3Server.Parsing
|
||||
Sandwich.Contexts.Kubernetes.Run
|
||||
Sandwich.Contexts.Kubernetes.Util
|
||||
Sandwich.Contexts.Kubernetes.Util.Aeson
|
||||
Sandwich.Contexts.Kubernetes.Util.Container
|
||||
Sandwich.Contexts.Kubernetes.Util.Exception
|
||||
Sandwich.Contexts.Kubernetes.Util.Nix
|
||||
Sandwich.Contexts.Kubernetes.Util.Ports
|
||||
Sandwich.Contexts.Kubernetes.Util.SocketUtil
|
||||
Sandwich.Contexts.Kubernetes.Util.UUID
|
||||
Sandwich.Contexts.Kubernetes.Waits
|
||||
Test.Sandwich.Contexts.Kubernetes.KindCluster.Config
|
||||
Test.Sandwich.Contexts.Kubernetes.KindCluster.Images
|
||||
Test.Sandwich.Contexts.Kubernetes.KindCluster.Network
|
||||
Test.Sandwich.Contexts.Kubernetes.KindCluster.ServiceForwardIngress
|
||||
Test.Sandwich.Contexts.Kubernetes.KindCluster.ServiceForwardPortForward
|
||||
Test.Sandwich.Contexts.Kubernetes.KindCluster.Setup
|
||||
Test.Sandwich.Contexts.Kubernetes.KubectlLogs
|
||||
Test.Sandwich.Contexts.Kubernetes.KubectlPortForward
|
||||
Test.Sandwich.Contexts.Kubernetes.MinikubeCluster.Forwards
|
||||
Test.Sandwich.Contexts.Kubernetes.MinikubeCluster.Images
|
||||
Test.Sandwich.Contexts.Kubernetes.MinioS3Server.Parsing
|
||||
Test.Sandwich.Contexts.Kubernetes.Run
|
||||
Test.Sandwich.Contexts.Kubernetes.Util
|
||||
Test.Sandwich.Contexts.Kubernetes.Util.Aeson
|
||||
Test.Sandwich.Contexts.Kubernetes.Util.Container
|
||||
Test.Sandwich.Contexts.Kubernetes.Util.Exception
|
||||
Test.Sandwich.Contexts.Kubernetes.Util.Nix
|
||||
Test.Sandwich.Contexts.Kubernetes.Util.Ports
|
||||
Test.Sandwich.Contexts.Kubernetes.Util.SocketUtil
|
||||
Test.Sandwich.Contexts.Kubernetes.Util.UUID
|
||||
Test.Sandwich.Contexts.Kubernetes.Waits
|
||||
Paths_sandwich_contexts_kubernetes
|
||||
hs-source-dirs:
|
||||
lib
|
||||
|
@ -9,7 +9,8 @@
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Test.Sandwich.Contexts.Files (
|
||||
introduceBinaryViaEnvironment
|
||||
introduceFile
|
||||
, introduceBinaryViaEnvironment
|
||||
|
||||
, introduceBinaryViaNixPackage
|
||||
, introduceBinaryViaNixPackage'
|
||||
@ -30,9 +31,9 @@ import Control.Monad.Logger
|
||||
import Data.String.Interpolate
|
||||
import GHC.TypeLits
|
||||
import Relude
|
||||
import Test.Sandwich.Contexts.Nix
|
||||
import System.FilePath
|
||||
import Test.Sandwich
|
||||
import Test.Sandwich.Contexts.Nix
|
||||
import UnliftIO.Directory
|
||||
|
||||
|
||||
@ -54,13 +55,31 @@ askFile = askFileProxy (Proxy @a)
|
||||
askFileProxy :: forall a context m. (MonadReader context m, HasFile context a) => Proxy a -> m FilePath
|
||||
askFileProxy _ = unEnvironmentFile <$> getContext (mkLabel @a)
|
||||
|
||||
introduceFile :: forall a context m. (
|
||||
MonadUnliftIO m, KnownSymbol a
|
||||
) => FilePath -> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m () -> SpecFree context m ()
|
||||
introduceFile path = introduceFile' (Proxy @a) path
|
||||
|
||||
introduceFile' :: forall a context m. (
|
||||
MonadUnliftIO m, KnownSymbol a
|
||||
) => Proxy a -> FilePath -> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m () -> SpecFree context m ()
|
||||
introduceFile' proxy path = introduce [i|#{symbolVal proxy} (binary from PATH)|] (mkLabel @a) (return $ EnvironmentFile path) (const $ return ())
|
||||
|
||||
-- | Introduce a given 'EnvironmentFile' from the PATH present when tests are run.
|
||||
-- Useful when you want to set up your own environment with binaries etc. to use in tests.
|
||||
-- Throws an exception if the desired file is not available.
|
||||
introduceBinaryViaEnvironment :: forall a context m. (
|
||||
MonadUnliftIO m, KnownSymbol a
|
||||
) => SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m () -> SpecFree context m ()
|
||||
introduceBinaryViaEnvironment = introduceBinaryViaEnvironment' (Proxy @a)
|
||||
|
||||
-- | Introduce a given 'EnvironmentFile' from the PATH present when tests are run.
|
||||
-- Useful when you want to set up your own environment with binaries etc. to use in tests.
|
||||
-- Throws an exception if the desired file is not available.
|
||||
introduceBinaryViaEnvironment' :: forall a context m. (
|
||||
MonadUnliftIO m, KnownSymbol a
|
||||
) => Proxy a -> SpecFree (LabelValue (AppendSymbol "file-" a) (EnvironmentFile a) :> context) m () -> SpecFree context m ()
|
||||
introduceBinaryViaEnvironment proxy = introduce [i|#{symbolVal proxy} (binary from PATH)|] (mkLabel @a) alloc cleanup
|
||||
introduceBinaryViaEnvironment' proxy = introduce [i|#{symbolVal proxy} (binary from PATH)|] (mkLabel @a) alloc cleanup
|
||||
where
|
||||
alloc = do
|
||||
liftIO (findExecutable (symbolVal proxy)) >>= \case
|
||||
|
@ -19,19 +19,15 @@ import Control.Monad.Logger
|
||||
import Control.Retry
|
||||
import Data.Aeson as A
|
||||
import Data.Aeson.TH as A
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.List as L
|
||||
import qualified Data.Map as M
|
||||
import Data.String.Interpolate
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Vector as V
|
||||
import Network.Socket (PortNumber)
|
||||
import Relude
|
||||
import Safe
|
||||
import System.Exit
|
||||
import System.FilePath
|
||||
import Test.Sandwich
|
||||
import Test.Sandwich.Contexts.Util.Aeson
|
||||
import qualified Text.Show
|
||||
import UnliftIO.Process
|
||||
|
||||
|
@ -43,7 +43,6 @@ library:
|
||||
- Test.Sandwich.Contexts.Util.Aeson
|
||||
dependencies:
|
||||
- aeson
|
||||
- bytestring
|
||||
- conduit
|
||||
- conduit-extra
|
||||
- containers
|
||||
|
@ -52,7 +52,6 @@ library
|
||||
HTTP
|
||||
, aeson
|
||||
, base
|
||||
, bytestring
|
||||
, conduit
|
||||
, conduit-extra
|
||||
, containers
|
||||
|
Loading…
Reference in New Issue
Block a user