From be1245e7ec9323650f7411911ef5d1efaa48dd46 Mon Sep 17 00:00:00 2001 From: thomasjm Date: Thu, 16 May 2024 02:07:34 -0700 Subject: [PATCH] Split out sandwich-contexts.minio, fixes #84 --- demos/demo-minio/demo-minio.cabal | 1 + demos/demo-minio/package.yaml | 1 + sandwich-contexts-docker/.dir-locals.el | 4 +- sandwich-contexts-docker/package.yaml | 3 - .../sandwich-contexts-docker.cabal | 3 - sandwich-contexts-kubernetes/.dir-locals.el | 1 - .../Contexts/Kubernetes/MinioS3Server.hs | 8 +- sandwich-contexts-kubernetes/package.yaml | 1 + .../sandwich-contexts-kubernetes.cabal | 1 + sandwich-contexts-minio/.dir-locals.el | 6 ++ .../lib/Test/Sandwich/Contexts/MinIO.hs | 36 +------- sandwich-contexts-minio/package.yaml | 69 ++++++++++++++ .../sandwich-contexts-minio.cabal | 92 +++++++++++++++++++ sandwich-contexts-minio/test/Main.hs | 11 +++ sandwich-contexts-minio/test/Spec.hs | 25 +++++ sandwich-contexts-minio/test/Spec/Basic.hs | 14 +++ sandwich-contexts/.dir-locals.el | 4 +- .../lib/Test/Sandwich/Contexts/Types/S3.hs | 45 +++++++++ sandwich-contexts/package.yaml | 8 +- sandwich-contexts/sandwich-contexts.cabal | 10 +- stack.yaml | 1 + 21 files changed, 283 insertions(+), 61 deletions(-) create mode 100644 sandwich-contexts-minio/.dir-locals.el rename {sandwich-contexts => sandwich-contexts-minio}/lib/Test/Sandwich/Contexts/MinIO.hs (87%) create mode 100644 sandwich-contexts-minio/package.yaml create mode 100644 sandwich-contexts-minio/sandwich-contexts-minio.cabal create mode 100644 sandwich-contexts-minio/test/Main.hs create mode 100644 sandwich-contexts-minio/test/Spec.hs create mode 100644 sandwich-contexts-minio/test/Spec/Basic.hs create mode 100644 sandwich-contexts/lib/Test/Sandwich/Contexts/Types/S3.hs diff --git a/demos/demo-minio/demo-minio.cabal b/demos/demo-minio/demo-minio.cabal index 8ee8bcc6..8c891faf 100644 --- a/demos/demo-minio/demo-minio.cabal +++ b/demos/demo-minio/demo-minio.cabal @@ -33,6 +33,7 @@ executable demo-minio , network , sandwich , sandwich-contexts + , sandwich-contexts-minio , string-interpolate , text , unliftio diff --git a/demos/demo-minio/package.yaml b/demos/demo-minio/package.yaml index efee27cc..eaded1fa 100644 --- a/demos/demo-minio/package.yaml +++ b/demos/demo-minio/package.yaml @@ -9,6 +9,7 @@ dependencies: - network - sandwich - sandwich-contexts +- sandwich-contexts-minio - string-interpolate - text - unliftio diff --git a/sandwich-contexts-docker/.dir-locals.el b/sandwich-contexts-docker/.dir-locals.el index 22320352..4bfe5f96 100644 --- a/sandwich-contexts-docker/.dir-locals.el +++ b/sandwich-contexts-docker/.dir-locals.el @@ -1,8 +1,6 @@ ((haskell-mode . ( (haskell-process-args-stack-ghci . ("--ghci-options=-ferror-spans" "--no-build" "--no-load" - "--stack-yaml" "/home/tom/codedown/stack.yaml" - "codedown-core:lib" - "codedown-test-contexts:lib" + "sandwich-contexts-docker:lib" )) ))) diff --git a/sandwich-contexts-docker/package.yaml b/sandwich-contexts-docker/package.yaml index b28cf690..96b5c76d 100644 --- a/sandwich-contexts-docker/package.yaml +++ b/sandwich-contexts-docker/package.yaml @@ -42,7 +42,6 @@ library: - containers - docker-engine - exceptions - - filepath - hostname - http-client - http-types @@ -54,11 +53,9 @@ library: - relude - retry - safe - - sandwich-contexts - string-interpolate - text - unliftio-core - - vector tests: tests: diff --git a/sandwich-contexts-docker/sandwich-contexts-docker.cabal b/sandwich-contexts-docker/sandwich-contexts-docker.cabal index 48028322..99fb5e9f 100644 --- a/sandwich-contexts-docker/sandwich-contexts-docker.cabal +++ b/sandwich-contexts-docker/sandwich-contexts-docker.cabal @@ -43,7 +43,6 @@ library , containers , docker-engine , exceptions - , filepath , hostname , http-client , http-types @@ -56,12 +55,10 @@ library , retry , safe , sandwich - , sandwich-contexts , string-interpolate , text , unliftio , unliftio-core - , vector default-language: Haskell2010 test-suite tests diff --git a/sandwich-contexts-kubernetes/.dir-locals.el b/sandwich-contexts-kubernetes/.dir-locals.el index 39183d2a..ceebd5da 100644 --- a/sandwich-contexts-kubernetes/.dir-locals.el +++ b/sandwich-contexts-kubernetes/.dir-locals.el @@ -1,7 +1,6 @@ ((haskell-mode . ( (haskell-process-args-stack-ghci . ("--ghci-options=-ferror-spans" "--no-build" "--no-load" - "--stack-yaml" "/home/tom/tools/sandwich/stack.yaml" "sandwich-contexts-kubernetes:lib" )) ))) diff --git a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/MinioS3Server.hs b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/MinioS3Server.hs index feacfc46..83e393f6 100644 --- a/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/MinioS3Server.hs +++ b/sandwich-contexts-kubernetes/lib/Test/Sandwich/Contexts/Kubernetes/MinioS3Server.hs @@ -6,10 +6,6 @@ module Test.Sandwich.Contexts.Kubernetes.MinioS3Server ( , withK8SMinioS3Server ) where -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 @@ -24,6 +20,10 @@ import Network.Minio import Relude import System.Exit import Test.Sandwich +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 Test.Sandwich.Contexts.MinIO import Test.Sandwich.Contexts.Waits import UnliftIO.Environment diff --git a/sandwich-contexts-kubernetes/package.yaml b/sandwich-contexts-kubernetes/package.yaml index 3dfa5a68..6d7ff345 100644 --- a/sandwich-contexts-kubernetes/package.yaml +++ b/sandwich-contexts-kubernetes/package.yaml @@ -47,6 +47,7 @@ library: - base64-bytestring - bytestring - sandwich-contexts + - sandwich-contexts-minio - containers - exceptions - filepath diff --git a/sandwich-contexts-kubernetes/sandwich-contexts-kubernetes.cabal b/sandwich-contexts-kubernetes/sandwich-contexts-kubernetes.cabal index d0c30fbd..bc8af68f 100644 --- a/sandwich-contexts-kubernetes/sandwich-contexts-kubernetes.cabal +++ b/sandwich-contexts-kubernetes/sandwich-contexts-kubernetes.cabal @@ -90,6 +90,7 @@ library , safe , sandwich , sandwich-contexts + , sandwich-contexts-minio , string-interpolate , temporary , text diff --git a/sandwich-contexts-minio/.dir-locals.el b/sandwich-contexts-minio/.dir-locals.el new file mode 100644 index 00000000..cfb0f079 --- /dev/null +++ b/sandwich-contexts-minio/.dir-locals.el @@ -0,0 +1,6 @@ +((haskell-mode + . ( + (haskell-process-args-stack-ghci . ("--ghci-options=-ferror-spans" "--no-build" "--no-load" + "sandwich-contexts-minio:lib" + )) + ))) diff --git a/sandwich-contexts/lib/Test/Sandwich/Contexts/MinIO.hs b/sandwich-contexts-minio/lib/Test/Sandwich/Contexts/MinIO.hs similarity index 87% rename from sandwich-contexts/lib/Test/Sandwich/Contexts/MinIO.hs rename to sandwich-contexts-minio/lib/Test/Sandwich/Contexts/MinIO.hs index 6ef8cc75..996e5142 100644 --- a/sandwich-contexts/lib/Test/Sandwich/Contexts/MinIO.hs +++ b/sandwich-contexts-minio/lib/Test/Sandwich/Contexts/MinIO.hs @@ -54,6 +54,7 @@ import Test.Sandwich import Test.Sandwich.Contexts.Files import Test.Sandwich.Contexts.Nix import Test.Sandwich.Contexts.Types +import Test.Sandwich.Contexts.Types.S3 import Test.Sandwich.Contexts.Util.Aeson import Test.Sandwich.Contexts.Util.Container import Test.Sandwich.Contexts.Util.UUID @@ -66,41 +67,6 @@ import UnliftIO.Process -- * Types -testS3Server :: Label "testS3Server" TestS3Server -testS3Server = Label - -data TestS3Server = TestS3Server { - testS3ServerAddress :: NetworkAddress - -- | The address of the S3 server within its container, if present. - -- Useful if you're doing container-to-container networking. - , testS3ServerContainerAddress :: Maybe NetworkAddress - , testS3ServerAccessKeyId :: Text - , testS3ServerSecretAccessKey :: Text - , testS3ServerBucket :: Maybe Text - , testS3ServerHttpMode :: HttpMode - } deriving (Show, Eq) - -data HttpMode = HttpModeHttp | HttpModeHttps | HttpModeHttpsNoValidate - deriving (Show, Eq) - -type HasTestS3Server context = HasLabel context "testS3Server" TestS3Server - -testS3ServerEndpoint :: TestS3Server -> Text -testS3ServerEndpoint serv@(TestS3Server {testS3ServerAddress=(NetworkAddressTCP hostname port)}) = - [i|#{s3Protocol serv}://#{hostname}:#{port}|] -testS3ServerEndpoint serv@(TestS3Server {testS3ServerAddress=(NetworkAddressUnix path)}) = - [i|#{s3Protocol serv}://#{path}|] - -testS3ServerContainerEndpoint :: TestS3Server -> Maybe Text -testS3ServerContainerEndpoint serv@(TestS3Server {testS3ServerContainerAddress=(Just (NetworkAddressTCP hostname port))}) = - Just [i|#{s3Protocol serv}://#{hostname}:#{port}|] -testS3ServerContainerEndpoint serv@(TestS3Server {testS3ServerContainerAddress=(Just (NetworkAddressUnix path))}) = - Just [i|#{s3Protocol serv}://#{path}|] -testS3ServerContainerEndpoint _ = Nothing - -s3Protocol :: TestS3Server -> Text -s3Protocol (TestS3Server {..}) = if testS3ServerHttpMode == HttpModeHttp then "http" else "https" - testS3ServerConnectInfo :: TestS3Server -> ConnectInfo testS3ServerConnectInfo testServ@(TestS3Server {..}) = fromString (toString (testS3ServerEndpoint testServ)) diff --git a/sandwich-contexts-minio/package.yaml b/sandwich-contexts-minio/package.yaml new file mode 100644 index 00000000..5a76d78a --- /dev/null +++ b/sandwich-contexts-minio/package.yaml @@ -0,0 +1,69 @@ +name: sandwich-contexts-minio +version: 0.1.0.0 +synopsis: Sandwich test contexts for MinIO +description: Please see README.md +author: Tom McLaughlin +maintainer: tom@codedown.io +copyright: 2024 Tom McLaughlin +dependencies: +- base +- sandwich +- unliftio + +default-extensions: +- OverloadedStrings +- QuasiQuotes +- NamedFieldPuns +- RecordWildCards +- ScopedTypeVariables +- LambdaCase +- MultiWayIf +- ViewPatterns +- TupleSections +- FlexibleContexts +- NoImplicitPrelude +- NumericUnderscores + +ghc-options: +- -Wunused-packages # For GHC 8.10.1 and above +- -Wall +# - -Wpartial-fields +# - -Wredundant-constraints # Reports HasCallStack, so keep it off normally + +library: + source-dirs: lib + exposed-modules: + - Test.Sandwich.Contexts.MinIO + dependencies: + - aeson + - containers + - exceptions + - filepath + - minio-hs + - monad-logger + - mtl + - network + - network-uri + - relude + - retry + - safe + - sandwich-contexts + - string-interpolate + - temporary + - text + - unliftio-core + +tests: + tests: + main: Main.hs + source-dirs: test + ghc-options: + - -Wall + - -rtsopts + - -threaded + dependencies: + - filepath + - postgresql-simple + - relude + - sandwich-contexts + - string-interpolate diff --git a/sandwich-contexts-minio/sandwich-contexts-minio.cabal b/sandwich-contexts-minio/sandwich-contexts-minio.cabal new file mode 100644 index 00000000..2ff8aedf --- /dev/null +++ b/sandwich-contexts-minio/sandwich-contexts-minio.cabal @@ -0,0 +1,92 @@ +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: sandwich-contexts-minio +version: 0.1.0.0 +synopsis: Sandwich test contexts for MinIO +description: Please see README.md +author: Tom McLaughlin +maintainer: tom@codedown.io +copyright: 2024 Tom McLaughlin +build-type: Simple + +library + exposed-modules: + Test.Sandwich.Contexts.MinIO + other-modules: + Paths_sandwich_contexts_minio + hs-source-dirs: + lib + default-extensions: + OverloadedStrings + QuasiQuotes + NamedFieldPuns + RecordWildCards + ScopedTypeVariables + LambdaCase + MultiWayIf + ViewPatterns + TupleSections + FlexibleContexts + NoImplicitPrelude + NumericUnderscores + ghc-options: -Wunused-packages -Wall + build-depends: + aeson + , base + , containers + , exceptions + , filepath + , minio-hs + , monad-logger + , mtl + , network + , network-uri + , relude + , retry + , safe + , sandwich + , sandwich-contexts + , string-interpolate + , temporary + , text + , unliftio + , unliftio-core + default-language: Haskell2010 + +test-suite tests + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + Spec + Spec.Basic + Paths_sandwich_contexts_minio + hs-source-dirs: + test + default-extensions: + OverloadedStrings + QuasiQuotes + NamedFieldPuns + RecordWildCards + ScopedTypeVariables + LambdaCase + MultiWayIf + ViewPatterns + TupleSections + FlexibleContexts + NoImplicitPrelude + NumericUnderscores + ghc-options: -Wunused-packages -Wall -Wall -rtsopts -threaded + build-depends: + base + , filepath + , postgresql-simple + , relude + , sandwich + , sandwich-contexts + , string-interpolate + , unliftio + default-language: Haskell2010 diff --git a/sandwich-contexts-minio/test/Main.hs b/sandwich-contexts-minio/test/Main.hs new file mode 100644 index 00000000..2116ead8 --- /dev/null +++ b/sandwich-contexts-minio/test/Main.hs @@ -0,0 +1,11 @@ + +module Main where + +import Relude +import qualified Spec +import Test.Sandwich + + +main :: IO () +main = runSandwichWithCommandLineArgs defaultOptions $ + Spec.tests diff --git a/sandwich-contexts-minio/test/Spec.hs b/sandwich-contexts-minio/test/Spec.hs new file mode 100644 index 00000000..3f0a44eb --- /dev/null +++ b/sandwich-contexts-minio/test/Spec.hs @@ -0,0 +1,25 @@ +{-# OPTIONS_GHC -F -pgmF sandwich-discover #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-type-defaults #-} + +module Spec where + +import Test.Sandwich + +#insert_test_imports + + +tests :: TopSpec +tests = $(getSpecFromFolder defaultGetSpecFromFolderOptions) + +-- testsPooled :: PooledSpec +-- testsPooled = $(getSpecFromFolder $ defaultGetSpecFromFolderOptions { +-- getSpecCombiner = 'describeParallel +-- , getSpecIndividualSpecHooks = 'poolify +-- , getSpecWarnOnParseError = NoWarnOnParseError +-- }) + +-- main :: IO () +-- main = pooledMain (return ()) testsPooled diff --git a/sandwich-contexts-minio/test/Spec/Basic.hs b/sandwich-contexts-minio/test/Spec/Basic.hs new file mode 100644 index 00000000..7fd9aeaa --- /dev/null +++ b/sandwich-contexts-minio/test/Spec/Basic.hs @@ -0,0 +1,14 @@ +module Spec.Basic where + +import Data.String.Interpolate +import Relude +import System.FilePath +import Test.Sandwich +import Test.Sandwich.Contexts.Nix +import UnliftIO.Directory + + +tests :: TopSpec +tests = describe "Tests" $ do + it "should work" $ do + 2 `shouldBe` 2 diff --git a/sandwich-contexts/.dir-locals.el b/sandwich-contexts/.dir-locals.el index 22320352..737df5ea 100644 --- a/sandwich-contexts/.dir-locals.el +++ b/sandwich-contexts/.dir-locals.el @@ -1,8 +1,6 @@ ((haskell-mode . ( (haskell-process-args-stack-ghci . ("--ghci-options=-ferror-spans" "--no-build" "--no-load" - "--stack-yaml" "/home/tom/codedown/stack.yaml" - "codedown-core:lib" - "codedown-test-contexts:lib" + "sandwich-contexts:lib" )) ))) diff --git a/sandwich-contexts/lib/Test/Sandwich/Contexts/Types/S3.hs b/sandwich-contexts/lib/Test/Sandwich/Contexts/Types/S3.hs new file mode 100644 index 00000000..cf01ce3a --- /dev/null +++ b/sandwich-contexts/lib/Test/Sandwich/Contexts/Types/S3.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} + +module Test.Sandwich.Contexts.Types.S3 where + +import Data.String.Interpolate +import Relude +import Test.Sandwich +import Test.Sandwich.Contexts.Types + + +testS3Server :: Label "testS3Server" TestS3Server +testS3Server = Label + +data TestS3Server = TestS3Server { + testS3ServerAddress :: NetworkAddress + -- | The address of the S3 server within its container, if present. + -- Useful if you're doing container-to-container networking. + , testS3ServerContainerAddress :: Maybe NetworkAddress + , testS3ServerAccessKeyId :: Text + , testS3ServerSecretAccessKey :: Text + , testS3ServerBucket :: Maybe Text + , testS3ServerHttpMode :: HttpMode + } deriving (Show, Eq) + +data HttpMode = HttpModeHttp | HttpModeHttps | HttpModeHttpsNoValidate + deriving (Show, Eq) + +type HasTestS3Server context = HasLabel context "testS3Server" TestS3Server + +testS3ServerEndpoint :: TestS3Server -> Text +testS3ServerEndpoint serv@(TestS3Server {testS3ServerAddress=(NetworkAddressTCP hostname port)}) = + [i|#{s3Protocol serv}://#{hostname}:#{port}|] +testS3ServerEndpoint serv@(TestS3Server {testS3ServerAddress=(NetworkAddressUnix path)}) = + [i|#{s3Protocol serv}://#{path}|] + +testS3ServerContainerEndpoint :: TestS3Server -> Maybe Text +testS3ServerContainerEndpoint serv@(TestS3Server {testS3ServerContainerAddress=(Just (NetworkAddressTCP hostname port))}) = + Just [i|#{s3Protocol serv}://#{hostname}:#{port}|] +testS3ServerContainerEndpoint serv@(TestS3Server {testS3ServerContainerAddress=(Just (NetworkAddressUnix path))}) = + Just [i|#{s3Protocol serv}://#{path}|] +testS3ServerContainerEndpoint _ = Nothing + +s3Protocol :: TestS3Server -> Text +s3Protocol (TestS3Server {..}) = if testS3ServerHttpMode == HttpModeHttp then "http" else "https" diff --git a/sandwich-contexts/package.yaml b/sandwich-contexts/package.yaml index 1f7f9cf9..fca790d0 100644 --- a/sandwich-contexts/package.yaml +++ b/sandwich-contexts/package.yaml @@ -35,12 +35,16 @@ library: exposed-modules: - Test.Sandwich.Contexts.FakeSmtpServer - Test.Sandwich.Contexts.Files - - Test.Sandwich.Contexts.MinIO - Test.Sandwich.Contexts.Nix - Test.Sandwich.Contexts.PostgreSQL - Test.Sandwich.Contexts.Waits + - Test.Sandwich.Contexts.Types + - Test.Sandwich.Contexts.Types.S3 + - Test.Sandwich.Contexts.Util.Aeson + - Test.Sandwich.Contexts.Util.Container + - Test.Sandwich.Contexts.Util.UUID dependencies: - aeson - conduit @@ -53,11 +57,9 @@ library: - http-conduit - http-types - HTTP - - minio-hs - monad-logger - mtl - network - - network-uri - process - random - relude diff --git a/sandwich-contexts/sandwich-contexts.cabal b/sandwich-contexts/sandwich-contexts.cabal index 16888b31..ee8bc958 100644 --- a/sandwich-contexts/sandwich-contexts.cabal +++ b/sandwich-contexts/sandwich-contexts.cabal @@ -17,20 +17,20 @@ library exposed-modules: Test.Sandwich.Contexts.FakeSmtpServer Test.Sandwich.Contexts.Files - Test.Sandwich.Contexts.MinIO Test.Sandwich.Contexts.Nix Test.Sandwich.Contexts.PostgreSQL Test.Sandwich.Contexts.Waits + Test.Sandwich.Contexts.Types + Test.Sandwich.Contexts.Types.S3 Test.Sandwich.Contexts.Util.Aeson + Test.Sandwich.Contexts.Util.Container + Test.Sandwich.Contexts.Util.UUID other-modules: Test.Sandwich.Contexts.FakeSmtpServer.Derivation Test.Sandwich.Contexts.ReverseProxy.TCP - Test.Sandwich.Contexts.Types - Test.Sandwich.Contexts.Util.Container Test.Sandwich.Contexts.Util.Nix Test.Sandwich.Contexts.Util.Ports Test.Sandwich.Contexts.Util.SocketUtil - Test.Sandwich.Contexts.Util.UUID Paths_sandwich_contexts hs-source-dirs: lib @@ -61,11 +61,9 @@ library , http-client , http-conduit , http-types - , minio-hs , monad-logger , mtl , network - , network-uri , process , random , relude diff --git a/stack.yaml b/stack.yaml index e629eeb0..f25d2407 100644 --- a/stack.yaml +++ b/stack.yaml @@ -20,6 +20,7 @@ packages: - ./sandwich-contexts - ./sandwich-contexts-docker - ./sandwich-contexts-kubernetes +- ./sandwich-contexts-minio - ./sandwich-hedgehog - ./sandwich-quickcheck - ./sandwich-slack