tmp-proc 0.6.1.0 → 0.6.2.0
raw patch · 13 files changed
+836/−427 lines, 13 filesdep +crypton-connectiondep +crypton-x509-systemdep +directorydep ~bytestringdep ~data-defaultdep ~hspec
Dependencies added: crypton-connection, crypton-x509-system, directory, filepath, fmt, http-client-tls, mustache, random, temporary, test-certs, unix
Dependency ranges changed: bytestring, data-default, hspec, http-client, http-types, network, tls, warp-tls
Files
- ChangeLog.md +10/−0
- src/System/TmpProc/Docker.hs +241/−68
- src/System/TmpProc/Warp.hs +151/−129
- templates/nginx-test.conf.mustache +42/−0
- test/Test/HttpBin.hs +27/−34
- test/Test/NginxGateway.hs +240/−0
- test/Test/SimpleServer.hs +21/−16
- test/Test/System/TmpProc/HttpBinSpec.hs +4/−3
- test/Test/System/TmpProc/WarpSpec.hs +57/−33
- test_certs/certificate.csr +0/−27
- test_certs/certificate.pem +0/−30
- test_certs/key.pem +0/−51
- tmp-proc.cabal +43/−36
ChangeLog.md view
@@ -2,6 +2,15 @@ `tmp-proc` uses [PVP Versioning][1]. +## 0.6.2.0 -- 2024-04-19++* Introduce the Preparer typeclass that allows dynamic setup of resources for+ containers++* Relax the upper version bounds of connection to allow 3.2++* Reenable the SSL integration tests using [test-certs][2]+ ## 0.6.1.0 -- 2024-03-14 * Extend the version bounds of tls to allow 2.1@@ -87,3 +96,4 @@ * First version. Extracted from some a non-public test library [1]: https://pvp.haskell.org+[2]: https://hackage.haskell.org/package/test-certs
src/System/TmpProc/Docker.hs view
@@ -3,12 +3,14 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilyDependencies #-}@@ -41,8 +43,15 @@ * A /'Proc'/ specifies a docker image that provides a service and other details related to its use in tests. +* @'Proc's@ may need additional setup before the docker command runs, this can+ be done using by providing a specific /'Preparer'/ instance for it++* @'Proc's@ may need additional arguments in the docker command that launches+ it; this can be done using by providing a specific /'ToRunCmd'/ instance for+ it+ * A /'ProcHandle'/ is created whenever a service specifed by a /'Proc'/ is-started, and is used to access and eventually terminate the running service.+started, and is used to access and eventually terminate the service. * Some @'Proc's@ will also be /'Connectable'/; these specify how access the service via some /'Conn'-ection/ type.@@ -58,23 +67,35 @@ , uriOf' , runArgs' - -- * @'ToRunCmd'@+ -- * customize docker startup , ToRunCmd (..)+ , Preparer (..) - -- * @'ProcHandle'@- , ProcHandle (..)- , Proc2Handle- , HandlesOf+ -- * start/stop multiple procs , startupAll+ , startupAll' , terminateAll+ , netwTerminateAll+ , netwStartupAll , withTmpProcs- , manyNamed++ -- * access a started @'Proc'@+ , ProcHandle (..)+ , SlimHandle (..)+ , Proc2Handle+ , HasHandle+ , HasNamedHandle+ , slim , handleOf , ixReset , ixPing , ixUriOf- , HasHandle- , HasNamedHandle++ -- * access multiple procs+ , HandlesOf+ , NetworkHandlesOf+ , manyNamed+ , genNetworkName , SomeNamedHandles -- * @'Connectable'@@@ -112,11 +133,13 @@ import qualified Data.ByteString.Char8 as C8 import Data.Kind (Type) import Data.List (dropWhileEnd)-import Data.Maybe (isJust)+import Data.Maybe (fromMaybe, isJust) import Data.Proxy (Proxy (..)) import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.IO as Text+import Data.Word (Word16)+import Fmt ((+|), (|+)) import GHC.TypeLits ( CmpSymbol , KnownSymbol@@ -139,6 +162,7 @@ , waitForProcess , withCreateProcess )+import System.Random (randomIO) import System.TmpProc.TypeLevel ( Drop , HList (..)@@ -179,11 +203,13 @@ -- | Set up some @'Proc's@, run an action that uses them, then terminate them. withTmpProcs ::- AreProcs procs =>+ (AreProcs procs) => HList procs -> (HandlesOf procs -> IO b) -> IO b-withTmpProcs procs = bracket (startupAll procs) terminateAll+withTmpProcs procs action =+ let wrapAction f (_, ps) = f ps+ in bracket (netwStartupAll procs) netwTerminateAll $ wrapAction action -- | Provides access to a 'Proc' that has been started.@@ -195,30 +221,97 @@ } +-- | Provides an untyped view of the data in a 'ProcHandle'+data SlimHandle = SlimHandle+ { shName :: !Text+ , shIpAddress :: !HostIpAddress+ , shPid :: !String+ , shUri :: !SvcURI+ }+ deriving (Eq, Show)+++-- | Obtain the 'SlimHandle'.+slim :: (Proc a) => ProcHandle a -> SlimHandle+slim x =+ SlimHandle+ { shName = nameOf $ hProc x+ , shIpAddress = hAddr x+ , shPid = hPid x+ , shUri = hUri x+ }+++slimMany :: (AreProcs procs) => HandlesOf procs -> [SlimHandle]+slimMany =+ let step x acc = slim x : acc+ in foldProcs step []++ -- | Start up processes for each 'Proc' type.-startupAll :: AreProcs procs => HList procs -> IO (HandlesOf procs)-startupAll = go procProof+startupAll :: (AreProcs procs) => HList procs -> IO (HandlesOf procs)+startupAll ps = snd <$> startupAll' Nothing ps+++-- | Like 'startupAll' but creates a new docker network and that the processes use+netwStartupAll :: (AreProcs procs) => HList procs -> IO (NetworkHandlesOf procs)+netwStartupAll ps = do+ netwName <- genNetworkName+ startupAll' (Just netwName) ps+++foldProcs ::+ forall procs b.+ (AreProcs procs) =>+ (forall a. (Proc a) => ProcHandle a -> b -> b) ->+ b ->+ HandlesOf procs ->+ b+foldProcs f acc = go procProof where- go :: Uniquely Proc AreProcs as -> HList as -> IO (HandlesOf as)- go UniquelyNil HNil = pure HNil- go (UniquelyCons cons) (x `HCons` y) = do+ go :: SomeProcs as -> HandlesOf as -> b+ go SomeProcsNil HNil = acc+ go (SomeProcsCons cons) (x `HCons` y) = f x $ go cons y+++-- | Start up processes for each 'Proc' type.+startupAll' :: (AreProcs procs) => Maybe Text -> HList procs -> IO (NetworkHandlesOf procs)+startupAll' ntwkMb ps =+ let+ mayCreateNetwork = case ntwkMb of+ Nothing -> pure ()+ Just name -> void $ readProcess "docker" (createNetworkArgs $ Text.unpack name) ""+ wrap x = (fromMaybe "" ntwkMb, x)++ go :: SomeProcs as -> HList as -> IO (HandlesOf as)+ go SomeProcsNil HNil = pure HNil+ go (SomeProcsCons cons) (x `HCons` y) = do others <- go cons y- h <- startup x `onException` terminateAll others- -- others <- go cons y `onException` terminate h+ h <- startup' ntwkMb (slimMany others) x `onException` terminateAll others pure $ h `HCons` others+ in+ do+ mayCreateNetwork+ wrap <$> go procProof ps -- | Terminate all processes owned by some @'ProcHandle's@.-terminateAll :: AreProcs procs => HandlesOf procs -> IO ()-terminateAll = go $ p2h procProof- where- go :: SomeHandles as -> HList as -> IO ()- go SomeHandlesNil HNil = pure ()- go (SomeHandlesCons cons) (x `HCons` y) = do- terminate x- go cons y+terminateAll :: (AreProcs procs) => HandlesOf procs -> IO ()+terminateAll =+ let step x acc = terminate x >> acc+ in foldProcs step $ pure () +{- | Like 'terminateAll', but also removes the docker network connecting the+processes.+-}+netwTerminateAll :: (AreProcs procs) => NetworkHandlesOf procs -> IO ()+netwTerminateAll (ntwk, ps) = do+ let name' = Text.unpack ntwk+ terminateAll ps+ void $ readProcess "docker" (removeNetworkArgs name') ""++ -- | Terminate the process owned by a @'ProcHandle's@. terminate :: ProcHandle p -> IO () terminate handle = do@@ -227,25 +320,53 @@ void $ readProcess "docker" ["rm", pid] "" +{- | Prepare resources for use by a @'Proc'@++ Preparation occurs before the @Proc's @docker container is a launched, and+ resources generated are made accessible via the @prepared@ data type.++ Usually, it will be used by @'toRunCmd'@ to provide additional arguments to the+ docker command++ There is an @Overlappable@ fallback instance that works for any @'Proc'@,+ so this typeclass need only be specified for @'Proc'@ that require some+ setup++ The 'prepare' method is given a list of 'SlimHandle' that represent preceding+ @tmp-proc@ managed containers, to allow preparation to establish links to these+ containers when necessary+-}+class Preparer a prepared | a -> prepared where+ -- * Generate a @prepared@ before the docker container is started+ prepare :: [SlimHandle] -> a -> IO prepared+++instance {-# OVERLAPPABLE #-} (a ~ a', Proc a) => Preparer a a' where+ prepare :: [SlimHandle] -> a -> IO a'+ prepare _ = pure++ {- | Allow customization of the docker command that launches a @'Proc'@-|-| The full command is-| `docker run -d <optional-args> $(imageText a)`-|-| A fallback instance is provided that works for any instance of @Proc a@-| Specify a new instance of @ToRunCmd@ to control <optional-args>++ The full command is+ `docker run -d <optional-args> --name $(name a) $(imageText a)`+ Specify a new instance of @ToRunCmd@ to control <optional-args>++ There is an @Overlappable@ fallback instance that works for any @'Proc'@,+ so this typeclass need only be specified for @'Proc'@ that need extra+ args in the docker command -}-class ToRunCmd a where- -- * Generate args that follow the initial ['docker', 'run', '-d']- toRunCmd :: a -> [Text]+class (Preparer a prepared) => ToRunCmd a prepared where+ -- * Generate docker command args to immeidately an initial ['docker', 'run', '-d']+ toRunCmd :: a -> prepared -> [Text] -instance {-# OVERLAPPABLE #-} (Proc a) => ToRunCmd a where- toRunCmd _ = runArgs @a+instance {-# OVERLAPPABLE #-} (a ~ a', Proc a) => ToRunCmd a a' where+ toRunCmd _ _ = runArgs @a -- | Specifies how to a get a connection to a 'Proc'.-class Proc a => Connectable a where+class (Proc a) => Connectable a where -- | The connection type. type Conn a = (conn :: Type) | conn -> a @@ -343,14 +464,21 @@ -- | The full args of a @docker run@ command for starting up a 'Proc'.-dockerCmdArgs :: forall a. (Proc a, ToRunCmd a) => a -> [Text]-dockerCmdArgs x = ["run", "-d"] <> toRunCmd x <> [imageText' @a]+dockerCmdArgs :: forall a prepared. (Proc a, ToRunCmd a prepared) => a -> prepared -> Maybe Text -> [Text]+dockerCmdArgs x prep ntwkMb =+ let toNetworkArgs n = ["--network", n]+ networkArg = maybe mempty toNetworkArgs ntwkMb+ in ["run", "-d"] <> nameArg @a <> networkArg <> toRunCmd x prep <> [imageText' @a] imageText' :: forall a. (Proc a) => Text-imageText' = Text.pack $ symbolVal (Proxy :: Proxy (Image a))+imageText' = Text.pack $ symbolVal $ Proxy @(Image a) +nameArg :: forall a. (Proc a) => [Text]+nameArg = ["--name", Text.pack $ symbolVal $ Proxy @(Name a)]++ -- | The IP address of the docker host. type HostIpAddress = Text @@ -366,12 +494,27 @@ Returns the 'ProcHandle' used to control the 'Proc' once a ping has succeeded. -}-startup :: (Proc a, ToRunCmd a) => a -> IO (ProcHandle a)-startup x = do- let fullArgs = map Text.unpack $ dockerCmdArgs x+startup :: (ProcPlus a prepared) => a -> IO (ProcHandle a)+startup = startup' Nothing mempty+++-- | A @Constraint@ that combines @'Proc'@ and its supporting typeclasses+type ProcPlus a prepared = (Proc a, ToRunCmd a prepared, Preparer a prepared)+++startup' ::+ (ProcPlus a prepared) =>+ Maybe Text ->+ [SlimHandle] ->+ a ->+ IO (ProcHandle a)+startup' ntwkMb addrs x = do+ x' <- prepare addrs x+ let fullArgs = map Text.unpack $ dockerCmdArgs x x' ntwkMb isGarbage = flip elem ['\'', '\n'] trim = dropWhileEnd isGarbage . dropWhile isGarbage- runCmd <- dockerRun fullArgs+ printDebug $ Text.pack $ show fullArgs+ runCmd <- createDockerCmdProcess fullArgs hPid <- trim <$> readCreateProcess runCmd "" hAddr <- Text.pack . trim@@ -391,7 +534,7 @@ fail $ pingedMsg x pinged -pingedMsg :: Proc a => a -> Pinged -> String+pingedMsg :: (Proc a) => a -> Pinged -> String pingedMsg _ OK = "" pingedMsg p NotOK = "tmp proc:" ++ Text.unpack (nameOf p) ++ ":could not be pinged" pingedMsg p (PingFailed err) =@@ -402,12 +545,16 @@ -- | Use an action that might throw an exception as a ping.-toPinged :: forall e a. Exception e => Proxy e -> IO a -> IO Pinged-toPinged _ action = (action >> pure OK) `catch` (\(_ :: e) -> pure NotOK)+toPinged :: forall e a. (Exception e) => Proxy e -> IO a -> IO Pinged+toPinged _ action =+ let handler (ex :: e) = do+ printDebug $ "toPinged:" <> Text.pack (show ex)+ pure NotOK+ in (action >> pure OK) `catch` handler -- | Ping a 'ProcHandle' several times.-nPings :: Proc a => ProcHandle a -> IO Pinged+nPings :: (Proc a) => ProcHandle a -> IO Pinged nPings h@ProcHandle {hProc = p} = let count = fromEnum $ pingCount' p@@ -462,7 +609,7 @@ -- | Run an action on a 'Connectable' handle as a callback on its 'Conn'-withTmpConn :: Connectable a => ProcHandle a -> (Conn a -> IO b) -> IO b+withTmpConn :: (Connectable a) => ProcHandle a -> (Conn a -> IO b) -> IO b withTmpConn handle = bracket (openConn handle) closeConn @@ -484,7 +631,7 @@ -- | Select the named @'ProcHandle's@ from an 'HList' of @'ProcHandle'@. manyNamed ::- SomeNamedHandles names namedProcs someProcs sortedProcs =>+ (SomeNamedHandles names namedProcs someProcs sortedProcs) => Proxy names -> HandlesOf someProcs -> HandlesOf namedProcs@@ -593,7 +740,7 @@ -- | Convert a 'ProcHandle' to a 'KV'.-toKV :: Proc a => ProcHandle a -> KV (Name a) (ProcHandle a)+toKV :: (Proc a) => ProcHandle a -> KV (Name a) (ProcHandle a) toKV = V @@ -607,6 +754,10 @@ type HandlesOf procs = HList (Proc2Handle procs) +-- | A list of @'ProcHandle'@ values with the docker network of their processes+type NetworkHandlesOf procs = (Text, HandlesOf procs)++ -- | Converts list of 'Proc' the corresponding @'Name'@ symbols. type family Proc2Name (as :: [Type]) = (nameTys :: [Symbol]) | nameTys -> as where Proc2Name '[] = '[]@@ -621,35 +772,40 @@ -- | Declares a proof that a list of types only contains @'Proc's@. class AreProcs as where- procProof :: Uniquely Proc AreProcs as+ procProof :: SomeProcs as instance AreProcs '[] where- procProof = UniquelyNil+ procProof = SomeProcsNil instance- ( Proc a- , ToRunCmd a+ ( ProcPlus a prepared , AreProcs as , IsAbsent a as ) => AreProcs (a ': as) where- procProof = UniquelyCons procProof+ procProof = SomeProcsCons procProof -- | Used to prove a list of types just contains @'ProcHandle's@. data SomeHandles (as :: [Type]) where SomeHandlesNil :: SomeHandles '[]- SomeHandlesCons :: Proc a => SomeHandles as -> SomeHandles (ProcHandle a ': as)+ SomeHandlesCons :: (ProcPlus a prepared) => SomeHandles as -> SomeHandles (ProcHandle a ': as) -p2h :: Uniquely Proc AreProcs as -> SomeHandles (Proc2Handle as)-p2h UniquelyNil = SomeHandlesNil-p2h (UniquelyCons cons) = SomeHandlesCons (p2h cons)+p2h :: SomeProcs as -> SomeHandles (Proc2Handle as)+p2h SomeProcsNil = SomeHandlesNil+p2h (SomeProcsCons cons) = SomeHandlesCons (p2h cons) +-- | Used to prove a list of types just contains @'Proc's@.+data SomeProcs (as :: [Type]) where+ SomeProcsNil :: SomeProcs '[]+ SomeProcsCons :: (ProcPlus a prepared, AreProcs as, IsAbsent a as) => SomeProcs as -> SomeProcs (a ': as)++ -- | Declares a proof that a list of types only contains @'Connectable's@. class Connectables as where connProof :: Uniquely Connectable Connectables as@@ -670,7 +826,7 @@ -- | Open all the 'Connectable' types to corresponding 'Conn' types.-openAll :: Connectables xs => HandlesOf xs -> IO (HList (ConnsOf xs))+openAll :: (Connectables xs) => HandlesOf xs -> IO (HList (ConnsOf xs)) openAll = go connProof where go :: Uniquely Connectable Connectables as -> HandlesOf as -> IO (HList (ConnsOf as))@@ -682,7 +838,7 @@ -- | Close some 'Connectable' types.-closeAll :: Connectables procs => HList (ConnsOf procs) -> IO ()+closeAll :: (Connectables procs) => HList (ConnsOf procs) -> IO () closeAll = go connProof where go :: Uniquely Connectable Connectables as -> HList (ConnsOf as) -> IO ()@@ -692,7 +848,7 @@ -- | Open some connections, use them in an action; close them. withConns ::- Connectables procs =>+ (Connectables procs) => HandlesOf procs -> (HList (ConnsOf procs) -> IO b) -> IO b@@ -781,8 +937,8 @@ devNull = openBinaryFile "/dev/null" WriteMode -dockerRun :: [String] -> IO CreateProcess-dockerRun args = do+createDockerCmdProcess :: [String] -> IO CreateProcess+createDockerCmdProcess args = do devNull' <- devNull pure $ (proc "docker" args) {std_err = UseHandle devNull'} @@ -799,3 +955,20 @@ printDebug t = do canPrint <- showDebug when canPrint $ Text.hPutStrLn stderr t+++-- | generate a random network name+genNetworkName :: IO Text+genNetworkName = networkNameOf <$> randomIO+++networkNameOf :: Word16 -> Text+networkNameOf suffix = "tmp-proc-" +| suffix |+ ""+++createNetworkArgs :: String -> [String]+createNetworkArgs name = ["network", "create", "-d", "bridge", name]+++removeNetworkArgs :: String -> [String]+removeNetworkArgs name = ["network", "remove", "-f", name]
src/System/TmpProc/Warp.hs view
@@ -1,15 +1,15 @@ {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-} {-# OPTIONS_HADDOCK prune not-home #-}-{-|++{- | Copyright : (c) 2020-2021 Tim Emiola SPDX-License-Identifier: BSD3 Maintainer : Tim Emiola <adetokunbo@users.noreply.github.com> Provides functions that make it easy to run /'Application's/ that access services running as @tmp@ @procs@ in integration tests.- -} module System.TmpProc.Warp ( -- * Continuation-style setup@@ -31,100 +31,120 @@ -- * Health check support , checkHealth )- where -import Control.Concurrent (myThreadId, newEmptyMVar, putMVar,- readMVar, takeMVar, threadDelay,- throwTo)-import Control.Exception (ErrorCall (..))-import Control.Monad (void, when)-import Control.Monad.Cont (cont, runCont)-import Network.Socket (Socket, close)-import Network.Wai (Application)-import qualified Network.Wai.Handler.Warp as Warp+import Control.Concurrent+ ( myThreadId+ , newEmptyMVar+ , putMVar+ , readMVar+ , takeMVar+ , threadDelay+ , throwTo+ )+import Control.Exception (ErrorCall (..))+import Control.Monad (void, when)+import Control.Monad.Cont (cont, runCont)+import Data.Text (Text)+import Network.Socket (Socket, close)+import Network.Wai (Application)+import qualified Network.Wai.Handler.Warp as Warp import qualified Network.Wai.Handler.WarpTLS as Warp-import UnliftIO (Async, async, bracket, cancel,- catch, onException, race, throwIO,- waitEither)--import System.TmpProc.Docker (AreProcs, HList (..), HandlesOf,- startupAll, terminateAll,- withTmpProcs)+import System.TmpProc.Docker+ ( AreProcs+ , HList (..)+ , HandlesOf+ , netwStartupAll+ , netwTerminateAll+ , withTmpProcs+ )+import UnliftIO+ ( Async+ , async+ , bracket+ , cancel+ , catch+ , onException+ , race+ , throwIO+ , waitEither+ ) -- | Represents a started Warp application and any 'AreProcs' dependencies. data ServerHandle procs = ServerHandle- { shServer :: !(Async ())- , shPort :: !Warp.Port- , shSocket :: !Socket+ { shServer :: !(Async ())+ , shPort :: !Warp.Port+ , shSocket :: !Socket , shHandles :: !(HandlesOf procs)+ , shNetwork :: !Text } + -- | Runs an 'Application' with @ProcHandle@ dependencies on a free port.-runServer- :: AreProcs procs- => HList procs- -> (HandlesOf procs -> IO Application)- -> IO (ServerHandle procs)+runServer ::+ (AreProcs procs) =>+ HList procs ->+ (HandlesOf procs -> IO Application) ->+ IO (ServerHandle procs) runServer = runReadyServer doNothing -{-| Like 'runServer'; with an additional @ready@ that determines if the server is ready.'. -}-runReadyServer- :: AreProcs procs- => (Warp.Port -> IO ()) -- ^ throws an exception if the server is not ready- -> HList procs -- ^ defines the dependent @Proc@s- -> (HandlesOf procs -> IO Application)- -> IO (ServerHandle procs)+-- | Like 'runServer'; with an additional @ready@ that determines if the server is ready.'.+runReadyServer ::+ (AreProcs procs) =>+ (Warp.Port -> IO ()) -> -- ^ throws an exception if the server is not ready+ HList procs -> -- ^ defines the dependent @Proc@s+ (HandlesOf procs -> IO Application) ->+ IO (ServerHandle procs) runReadyServer = runReadyServer' Warp.runSettingsSocket -{-| Like 'runServer'; the port is secured with 'Warp.TLSSettings'. -}-runTLSServer- :: AreProcs procs- => Warp.TLSSettings- -> HList procs- -> (HandlesOf procs -> IO Application)- -> IO (ServerHandle procs)-runTLSServer tlsSettings = runReadyServer' (Warp.runTLSSocket tlsSettings) doNothing+-- | Like 'runServer'; the port is secured with 'Warp.TLSSettings'.+runTLSServer ::+ (AreProcs procs) =>+ Warp.TLSSettings ->+ HList procs ->+ (HandlesOf procs -> IO Application) ->+ IO (ServerHandle procs)+runTLSServer tlsSettings = runReadyServer' (Warp.runTLSSocket tlsSettings) doNothing -{-| Like 'runReadyServer'; the port is secured with 'Warp.TLSSettings'. -}-runReadyTLSServer- :: AreProcs procs- => Warp.TLSSettings- -> (Warp.Port -> IO ()) -- ^ throws an exception if the server is not ready- -> HList procs -- ^ defines the dependent @Proc@s- -> (HandlesOf procs -> IO Application)- -> IO (ServerHandle procs)+-- | Like 'runReadyServer'; the port is secured with 'Warp.TLSSettings'.+runReadyTLSServer ::+ (AreProcs procs) =>+ Warp.TLSSettings ->+ (Warp.Port -> IO ()) -> -- ^ throws an exception if the server is not ready+ HList procs -> -- ^ defines the dependent @Proc@s+ (HandlesOf procs -> IO Application) ->+ IO (ServerHandle procs) runReadyTLSServer tlsSettings = runReadyServer' (Warp.runTLSSocket tlsSettings) -- | Used to implement 'runReadyServer'-runReadyServer'- :: AreProcs procs- => (Warp.Settings -> Socket -> Application -> IO ())- -> (Warp.Port -> IO ()) -- ^ throws an exception if the server is not ready- -> HList procs -- ^ defines the dependent @Proc@s- -> (HandlesOf procs -> IO Application)- -> IO (ServerHandle procs)+runReadyServer' ::+ (AreProcs procs) =>+ (Warp.Settings -> Socket -> Application -> IO ()) ->+ (Warp.Port -> IO ()) -> -- ^ throws an exception if the server is not ready+ HList procs -> -- ^ defines the dependent @Proc@s+ (HandlesOf procs -> IO Application) ->+ IO (ServerHandle procs) runReadyServer' runApp check procs mkApp = do callingThread <- myThreadId- h <- startupAll procs+ (netw, h) <- netwStartupAll procs (p, sock) <- Warp.openFreePort signal <- newEmptyMVar- let settings = readySettings(putMVar signal ())+ let settings = readySettings (putMVar signal ()) app <- mkApp h let wrappedApp request respond =- app request respond `catch` \ e -> do+ app request respond `catch` \e -> do when (Warp.defaultShouldDisplayException e) (throwTo callingThread e) throwIO e- s <- async (pure wrappedApp >>= runApp settings sock)+ s <- async $ runApp settings sock wrappedApp aConfirm <- async (takeMVar signal)- let result = ServerHandle s p sock h+ let result = ServerHandle s p sock h netw waitEither s aConfirm >>= \case Left _ -> do shutdown result@@ -135,16 +155,16 @@ -- | Shuts down the 'ServerHandle' server and its @tmp proc@ dependencies.-shutdown :: AreProcs procs => ServerHandle procs -> IO ()+shutdown :: (AreProcs procs) => ServerHandle procs -> IO () shutdown h = do- let ServerHandle { shServer, shSocket, shHandles } = h- terminateAll shHandles+ let ServerHandle {shServer, shSocket, shHandles, shNetwork} = h+ netwTerminateAll (shNetwork, shHandles) cancel shServer close shSocket -- | The @'ServerHandle's@ @ProcHandles@.-handles :: AreProcs procs => ServerHandle procs -> HandlesOf procs+handles :: (AreProcs procs) => ServerHandle procs -> HandlesOf procs handles = shHandles @@ -153,7 +173,7 @@ serverPort = shPort -{-| Set up some @ProcHandles@ then run an 'Application' that uses them on a free+{- | Set up some @ProcHandles@ then run an 'Application' that uses them on a free port. Allows the app to configure itself using the @tmp procs@, then provides a@@ -161,33 +181,33 @@ The @tmp procs@ are shut down when the application is shut down. -}-testWithApplication- :: AreProcs procs- => HList procs- -> (HandlesOf procs -> IO Application)- -> ((HandlesOf procs, Warp.Port) -> IO a)- -> IO a+testWithApplication ::+ (AreProcs procs) =>+ HList procs ->+ (HandlesOf procs -> IO Application) ->+ ((HandlesOf procs, Warp.Port) -> IO a) ->+ IO a testWithApplication procs mkApp = runCont $ do oh <- cont $ withTmpProcs procs p <- cont $ Warp.testWithApplication $ mkApp oh pure (oh, p) -{-| Like 'testWithApplication', but the port is secured using a 'Warp.TLSSettings. '-}-testWithTLSApplication- :: AreProcs procs- => Warp.TLSSettings- -> HList procs- -> (HandlesOf procs -> IO Application)- -> ((HandlesOf procs, Warp.Port) -> IO a)- -> IO a+-- | Like 'testWithApplication', but the port is secured using a 'Warp.TLSSettings. '+testWithTLSApplication ::+ (AreProcs procs) =>+ Warp.TLSSettings ->+ HList procs ->+ (HandlesOf procs -> IO Application) ->+ ((HandlesOf procs, Warp.Port) -> IO a) ->+ IO a testWithTLSApplication tlsSettings procs mkApp = runCont $ do oh <- cont $ withTmpProcs procs p <- cont $ withTLSApplicationSettings tlsSettings Warp.defaultSettings $ mkApp oh pure (oh, p) -{-| Set up some @ProcHandles@ then run an 'Application' that uses them on a free+{- | Set up some @ProcHandles@ then run an 'Application' that uses them on a free port. Allows the app to configure itself using the @tmp procs@, then provides a@@ -198,13 +218,13 @@ The @tmp procs@ are shut down when the application is shut down. -}-testWithReadyApplication- :: AreProcs procs- => (Warp.Port -> IO ()) -- throws an exception if the server is not ready- -> HList procs- -> (HandlesOf procs -> IO Application)- -> ((HandlesOf procs, Warp.Port) -> IO a)- -> IO a+testWithReadyApplication ::+ (AreProcs procs) =>+ (Warp.Port -> IO ()) -> -- throws an exception if the server is not ready+ HList procs ->+ (HandlesOf procs -> IO Application) ->+ ((HandlesOf procs, Warp.Port) -> IO a) ->+ IO a testWithReadyApplication check procs mkApp = runCont $ do oh <- cont $ withTmpProcs procs w <- cont $ bracket (mkWaiter check) doNothing@@ -213,15 +233,15 @@ return (oh, p) -{-| Like 'testWithReadyApplication'; the port is secured with 'Warp.TLSSettings'. -}-testWithReadyTLSApplication- :: AreProcs procs- => Warp.TLSSettings- -> (Warp.Port -> IO ()) -- throws an exception if the server is not ready- -> HList procs- -> (HandlesOf procs -> IO Application)- -> ((HandlesOf procs, Warp.Port) -> IO a)- -> IO a+-- | Like 'testWithReadyApplication'; the port is secured with 'Warp.TLSSettings'.+testWithReadyTLSApplication ::+ (AreProcs procs) =>+ Warp.TLSSettings ->+ (Warp.Port -> IO ()) -> -- throws an exception if the server is not ready+ HList procs ->+ (HandlesOf procs -> IO Application) ->+ ((HandlesOf procs, Warp.Port) -> IO a) ->+ IO a testWithReadyTLSApplication tlsSettings check procs mkApp = runCont $ do oh <- cont $ withTmpProcs procs w <- cont $ bracket (mkWaiter check) doNothing@@ -235,32 +255,31 @@ checkHealth tries h = go tries where go 0 = error "healthy: server isn't healthy"- go n = h >>= \case- Left _ -> threadDelay pingPeriod >> go (n - 1)- Right _ -> pure ()+ go n =+ h >>= \case+ Left _ -> threadDelay pingPeriod >> go (n - 1)+ Right _ -> pure () +{- | A 'Warp.Settings' configured with a ready action. --- | A 'Warp.Settings' configured with a ready action.------ The ready action is used to check if a server is healthy.+The ready action is used to check if a server is healthy.+-} readySettings :: IO () -> Warp.Settings readySettings ready = Warp.setBeforeMainLoop ready Warp.defaultSettings +{- | A 'Warp.Settings' configured with a ready action. --- | A 'Warp.Settings' configured with a ready action.------ The ready action is used to check if a server is healthy.+The ready action is used to check if a server is healthy.+-} waiterSettings :: PortWaiter () -> Warp.Settings waiterSettings w = Warp.setBeforeMainLoop (notify w ()) Warp.defaultSettings - -- | Simplifies creation of a ready action.-data PortWaiter a =- PortWaiter- { notify :: a -> IO ()+data PortWaiter a = PortWaiter+ { notify :: a -> IO () , waitFor :: Warp.Port -> IO a } @@ -273,10 +292,11 @@ res <- readMVar mvar void $ check p pure res- pure PortWaiter- { notify = putMVar mvar- , waitFor- }+ pure+ PortWaiter+ { notify = putMVar mvar+ , waitFor+ } -- | Gap between service pings in milliseconds.@@ -284,22 +304,24 @@ pingPeriod = 1000000 --- | Like 'Warp.testWithApplicationSettings' , but the port is secured using the--- provided 'Warp.TLSSettings'.-withTLSApplicationSettings- :: Warp.TLSSettings- -> Warp.Settings- -> IO Application- -> (Warp.Port -> IO a)- -> IO a+{- | Like 'Warp.testWithApplicationSettings' , but the port is secured using the+provided 'Warp.TLSSettings'.+-}+withTLSApplicationSettings ::+ Warp.TLSSettings ->+ Warp.Settings ->+ IO Application ->+ (Warp.Port -> IO a) ->+ IO a withTLSApplicationSettings tlsSettings settings mkApp action = do app <- mkApp- withFreePort $ \ (p, sock) -> do+ withFreePort $ \(p, sock) -> do started <- mkWaiter doNothing let settings' = Warp.setBeforeMainLoop (notify started ()) settings- result <- race- (Warp.runTLSSocket tlsSettings settings' sock app)- (waitFor started p >> action p)+ result <-+ race+ (Warp.runTLSSocket tlsSettings settings' sock app)+ (waitFor started p >> action p) case result of Left () -> throwIO $ ErrorCall "Unexpected: runSettingsSocket exited" Right x -> return x
+ templates/nginx-test.conf.mustache view
@@ -0,0 +1,42 @@+server {+ listen 80;+ listen [::]:80;+ server_name {{common_name}};+ location / {+ rewrite ^ https://$host$request_uri? permanent;+ }+}++server {+ listen 443 ssl;+ listen [::]:443 ssl;+ server_name {{commonName}};+ server_tokens off;+ ssl_certificate /etc/tmp-proc/certs/certificate.pem;+ ssl_certificate_key /etc/tmp-proc/certs/key.pem;+ ssl_buffer_size 8k;+ ssl_protocols TLSv1.2;+ ssl_prefer_server_ciphers on;+ ssl_ciphers ECDH+AESGCM:ECDH+AES256:ECDH+AES128:DH+3DES:!ADH:!AECDH:!MD5;+ ssl_ecdh_curve secp384r1;+ ssl_session_tickets off;+ ssl_stapling on;+ ssl_stapling_verify on;+ resolver 8.8.8.8;++ location / {+ try_files $uri @tmp-proc-target;+ }++ location @tmp-proc-target {+ proxy_pass http://{{targetName}}:{{targetPort}};+ add_header X-Frame-Options "SAMEORIGIN" always;+ add_header X-XSS-Protection "1; mode=block" always;+ add_header X-Content-Type-Options "nosniff" always;+ add_header Referrer-Policy "no-referrer-when-downgrade" always;+ add_header Content-Security-Policy "default-src * data: 'unsafe-eval' 'unsafe-inline'" always;+ }++ root /var/www/html;+ index index.html index.htm index.nginx-debian.html;+}
test/Test/HttpBin.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}@@ -19,35 +21,26 @@ , Proc (..) , ProcHandle (..) , SvcURI- , ToRunCmd (..) , manyNamed , startupAll , toPinged , (&:) , (&:&) )---setupHandles :: IO (HandlesOf '[HttpBinTest, NginxTest, HttpBinTest3])-setupHandles = startupAll $ HttpBinTest &: NginxTest &:& HttpBinTest3----- | A data type representing a connection to an Nginx server.-data NginxTest = NginxTest+import Test.NginxGateway (NginxGateway (..)) --- | Run Nginx as temporary process.-instance Proc NginxTest where- type Image NginxTest = "nginx:1.25.1"- type Name NginxTest = "nginx-test"- uriOf = mkUri'- runArgs = []- reset _ = pure ()- ping = ping'+anNginxGateway :: NginxGateway+anNginxGateway =+ NginxGateway+ { ngCommonName = "localhost"+ , ngTargetPort = 80+ , ngTargetName = "http-bin-test-3"+ } -instance ToRunCmd NginxTest where- toRunCmd _ = []+setupHandles :: IO (HandlesOf '[HttpBinTest, NginxGateway, HttpBinTest3])+setupHandles = startupAll $ HttpBinTest &: anNginxGateway &:& HttpBinTest3 -- | A data type representing a connection to a HttpBin server.@@ -58,10 +51,10 @@ instance Proc HttpBinTest where type Image HttpBinTest = "kennethreitz/httpbin" type Name HttpBinTest = "http-bin-test"- uriOf = mkUri'+ uriOf = httpUri runArgs = [] reset _ = pure ()- ping = ping'+ ping = pingHttp {- | Another data type representing a connection to a HttpBin server.@@ -76,10 +69,10 @@ instance Proc HttpBinTest2 where type Image HttpBinTest2 = "kennethreitz/httpbin" type Name HttpBinTest2 = "http-bin-test-2"- uriOf = mkUri'+ uriOf = httpUri runArgs = [] reset _ = pure ()- ping = ping'+ ping = pingHttp {- | Yet another data type representing a connection to a HttpBin server.@@ -94,26 +87,26 @@ instance Proc HttpBinTest3 where type Image HttpBinTest3 = "kennethreitz/httpbin" type Name HttpBinTest3 = "http-bin-test-3"- uriOf = mkUri'+ uriOf = httpUri runArgs = [] reset _ = pure ()- ping = ping'+ ping = pingHttp -- | Make a uri access the http-bin server.-mkUri' :: HostIpAddress -> SvcURI-mkUri' ip = "http://" <> C8.pack (Text.unpack ip) <> "/"+httpUri :: HostIpAddress -> SvcURI+httpUri ip = "http://" <> C8.pack (Text.unpack ip) <> "/" -ping' :: ProcHandle a -> IO Pinged-ping' handle = toPinged @HC.HttpException Proxy $ do- gotStatus <- handleGet handle "/status/200"+pingHttp :: ProcHandle a -> IO Pinged+pingHttp handle = toPinged @HC.HttpException Proxy $ do+ gotStatus <- httpGet handle "/status/200" if gotStatus == 200 then pure OK else pure NotOK --- | Determine the status from a Get on localhost.-handleGet :: ProcHandle a -> Text -> IO Int-handleGet handle urlPath = do+-- | Determine the status from a Get.+httpGet :: ProcHandle a -> Text -> IO Int+httpGet handle urlPath = do let theUri = "http://" <> hAddr handle <> "/" <> Text.dropWhile (== '/') urlPath manager <- HC.newManager HC.defaultManagerSettings getReq <- HC.parseRequest $ Text.unpack theUri@@ -139,7 +132,7 @@ pure $ manyNamed @'["http-bin-test-3", "http-bin-test"] Proxy allHandles -typeLevelCheck4 :: IO (HandlesOf '[HttpBinTest3, NginxTest, HttpBinTest])+typeLevelCheck4 :: IO (HandlesOf '[HttpBinTest3, NginxGateway, HttpBinTest]) typeLevelCheck4 = do allHandles <- setupHandles pure $ manyNamed @'["http-bin-test-3", "nginx-test", "http-bin-test"] Proxy allHandles
+ test/Test/NginxGateway.hs view
@@ -0,0 +1,240 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++{- |+Module : Test.NginxGateway+Copyright : (c) 2022 Tim Emiola+Maintainer : Tim Emiola <adetokunbo@emio.la>+SPDX-License-Identifier: BSD3+-}+module Test.NginxGateway+ ( -- * data types+ NginxGateway (..)+ , NginxPrep (..)++ -- * ping via https+ , pingHttps+ )+where++import qualified Data.ByteString.Char8 as C8+import Data.Data (Proxy (..))+import Data.Default (Default (..))+import Data.List (find)+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.IO as Text+import Network.Connection (TLSSettings (..))+import qualified Network.HTTP.Client as HC+import qualified Network.HTTP.Client.TLS as HC+import Network.HTTP.Types.Header (hHost)+import Network.HTTP.Types.Status (statusCode)+import Network.TLS (ClientParams (..), HostName, Shared (..), Supported (..), defaultParamsClient)+import Network.TLS.Extra (ciphersuite_default)+import Paths_tmp_proc (getDataDir)+import System.Directory (createDirectory)+import System.FilePath ((</>))+import System.IO.Temp (createTempDirectory, getCanonicalTemporaryDirectory)+import System.Posix.ByteString (getEffectiveGroupID, getEffectiveUserID)+import System.Posix.Types (GroupID, UserID)+import System.TmpProc+ ( HostIpAddress+ , Pinged (..)+ , Preparer (..)+ , Proc (..)+ , ProcHandle (..)+ , SlimHandle (..)+ , SvcURI+ , ToRunCmd (..)+ , toPinged+ )+import System.X509 (getSystemCertificateStore)+import Test.Certs.Temp (CertPaths (..), defaultConfig, generateAndStore)+import Text.Mustache+ ( ToMustache (..)+ , automaticCompile+ , object+ , substitute+ , (~>)+ )+++-- | Run Nginx as a temporary process.+instance Proc NginxGateway where+ -- use this linuxserver.io nginx as it is setup to allow easy override of+ -- config+ type Image NginxGateway = "lscr.io/linuxserver/nginx"+ type Name NginxGateway = "nginx-test"+ uriOf = httpUri+ runArgs = []+ reset _ = pure ()+ ping = pingHttps+++instance ToRunCmd NginxGateway NginxPrep where+ toRunCmd = toRunCmd'+++instance Preparer NginxGateway NginxPrep where+ prepare = prepare'+++{- | Configures launch of a container thats uses nginx as a gateway (a.k.a+reverse proxy).+-}+data NginxGateway = NginxGateway+ { ngCommonName :: !Text+ , ngTargetPort :: !Int+ , ngTargetName :: !Text+ }+ deriving (Eq, Show)+++instance ToMustache NginxGateway where+ toMustache nt =+ object+ [ "commonName" ~> ngCommonName nt+ , "targetPort" ~> ngTargetPort nt+ , "targetName" ~> ngTargetName nt+ ]+++-- | Values obtained while preparing to launch the nginx container+data NginxPrep = NginxPrep+ { npUserID :: !UserID+ , npGroupID :: !GroupID+ , npVolumeRoot :: !FilePath+ }+ deriving (Eq, Show)+++instance ToMustache NginxPrep where+ toMustache np =+ object+ [ "targetDir" ~> npVolumeRoot np+ ]+++templateName :: FilePath+templateName = "nginx-test.conf.mustache"+++toConfCertsDirs :: FilePath -> (FilePath, FilePath)+toConfCertsDirs topDir = (topDir </> "conf", topDir </> "certs")+++dockerCertsDir :: FilePath+dockerCertsDir = "/etc/tmp-proc/certs"+++dockerConf :: FilePath+dockerConf = "/data/conf/nginx.conf"+++createWorkingDirs :: IO FilePath+createWorkingDirs = do+ tmpDir <- getCanonicalTemporaryDirectory+ topDir <- createTempDirectory tmpDir "nginx-test"+ let (confDir, certsDir) = toConfCertsDirs topDir+ createDirectory confDir+ createDirectory certsDir+ pure topDir+++toRunCmd' :: NginxGateway -> NginxPrep -> [Text]+toRunCmd' _ np =+ -- specify user ID and group ID to fix volume mount permissions+ -- mount volume /etc/tmp-proc/certs as target-dir/certs+ -- mount volume /etc/tmp-proc/nginx as target-dir/nginx+ let (confDir, certsDir) = toConfCertsDirs $ npVolumeRoot np+ confPath = confDir </> "nginx.conf"+ envArg name v =+ [ "-e"+ , name ++ "=" ++ show v+ ]+ volumeArg actualPath hostedPath =+ [ "-v"+ , actualPath ++ ":" ++ hostedPath+ ]+ confArg = volumeArg confPath $ dockerConf ++ ":ro"+ certsArg = volumeArg certsDir dockerCertsDir+ puidArg = envArg "PUID" $ npUserID np+ guidArg = envArg "GUID" $ npGroupID np+ in Text.pack <$> confArg ++ certsArg ++ puidArg ++ guidArg+++-- Prepare+-- expand the template with commonName to target-dir/nginx+-- create certs with commonName to target-dir/certs+-- used fixed cert basenames (certificate.pem and key.pem)+prepare' :: [SlimHandle] -> NginxGateway -> IO NginxPrep+prepare' views nt@NginxGateway {ngTargetName = name} = do+ case find ((== name) . shName) views of+ Nothing -> error $ "could not find host " <> show name+ Just _ -> do+ templateDir <- (</> "templates") <$> getDataDir+ compiled <- automaticCompile [templateDir] templateName+ case compiled of+ Left err -> error $ "the template did not compile:" ++ show err+ Right template -> do+ npVolumeRoot <- createWorkingDirs+ npUserID <- getEffectiveUserID+ npGroupID <- getEffectiveGroupID+ let (confDir, cpDir) = toConfCertsDirs npVolumeRoot+ cp =+ CertPaths+ { cpKey = "key.pem"+ , cpCert = "certificate.pem"+ , cpDir+ }+ np = NginxPrep {npUserID, npGroupID, npVolumeRoot}+ generateAndStore cp defaultConfig+ Text.writeFile (confDir </> "nginx.conf") $ substitute template (nt, np)+ pure np+++-- | Make a uri access the http-bin server.+httpUri :: HostIpAddress -> SvcURI+httpUri ip = "http://" <> C8.pack (Text.unpack ip) <> "/"+++pingHttps :: ProcHandle a -> IO Pinged+pingHttps handle = toPinged @HC.HttpException Proxy $ do+ gotStatus <- httpsGet handle "/status/200"+ if gotStatus == 200 then pure OK else pure NotOK+++-- | Determine the status from a secure Get to host localhost.+httpsGet :: ProcHandle a -> Text -> IO Int+httpsGet handle urlPath = do+ -- _tlsSettings <- TLSSettings <$> _mkClientParams "localHost"+ let theUri = "https://" <> hAddr handle <> "/" <> Text.dropWhile (== '/') urlPath+ -- use TLS settings that disable hostname verification. What's not+ -- currently possible is to actually specify the hostname to use for SNI+ -- that differs from the connection IP address, that's not supported by+ -- http-client-tls+ tlsSettings = TLSSettingsSimple True False False+ manager <- HC.newTlsManagerWith $ HC.mkManagerSettings tlsSettings Nothing+ getReq <- HC.parseRequest $ Text.unpack theUri+ let withHost = getReq {HC.requestHeaders = [(hHost, "localhost")]}+ statusCode . HC.responseStatus <$> HC.httpLbs withHost manager+++-- currently unused, since the server specified in ClientParams for SNI is+-- overridden by Connection, which resets it to the connection hostname+_mkClientParams :: HostName -> IO ClientParams+_mkClientParams server = do+ cs <- getSystemCertificateStore+ pure $+ (defaultParamsClient server "")+ { clientSupported =+ def+ { supportedCiphers = ciphersuite_default+ }+ , clientShared = def {sharedCAStore = cs}+ , clientUseServerNameIndication = True+ }
test/Test/SimpleServer.hs view
@@ -1,14 +1,18 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} -module Test.SimpleServer (- -- * functions- statusOfGet,-) where+module Test.SimpleServer+ ( -- * functions+ statusOfGet+ , statusOfGet'+ )+where import Data.Text (Text) import qualified Data.Text as Text+import qualified Network.Connection as HC import qualified Network.HTTP.Client as HC+import Network.HTTP.Client.TLS (mkManagerSettings) import Network.HTTP.Types.Status (statusCode) import qualified Network.Wai.Handler.Warp as Warp @@ -29,17 +33,18 @@ let theReq = getReq {HC.port = p} statusCode . HC.responseStatus <$> HC.httpLbs theReq manager --- statusOfGet' :: Int -> Text -> IO Int--- statusOfGet' p path = do--- manager <- mkSimpleTLSManager--- runReq (defaultHttpConfig { httpConfigAltManager = Just manager }) $ do--- r <- req GET (localHttpsUrl path) NoReqBody ignoreResponse $ port p--- return $ responseStatusCode r --- localHttpsUrl :: Text -> Url 'Https--- localHttpsUrl p = foldl' (/:) (https "localhost")--- $ Text.splitOn "/" $ Text.dropWhile (== '/') p+-- | Determine the status from a Get on localhost.+statusOfGet' :: Warp.Port -> Text -> IO Int+statusOfGet' p urlPath = do+ let theUri = "GET https://localhost/" <> Text.dropWhile (== '/') urlPath+ manager <- mkSimpleTLSManager+ getReq <- HC.parseRequest $ Text.unpack theUri+ let theReq = getReq {HC.port = p}+ statusCode . HC.responseStatus <$> HC.httpLbs theReq manager --- mkSimpleTLSManager :: IO HC.Manager--- mkSimpleTLSManager = HC.newManager--- $ mkManagerSettings (HC.TLSSettingsSimple True False False) Nothing++mkSimpleTLSManager :: IO HC.Manager+mkSimpleTLSManager =+ HC.newManager $+ mkManagerSettings (HC.TLSSettingsSimple True False False) Nothing
test/Test/System/TmpProc/HttpBinSpec.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}@@ -14,9 +13,11 @@ , ixReset , terminateAll )+import System.TmpProc.Docker (ProcHandle, hOf) import Test.Hspec import Test.Hspec.TmpProc (tdescribe) import Test.HttpBin+import Test.NginxGateway (NginxGateway, pingHttps) spec :: Spec@@ -25,7 +26,7 @@ context "When accessing the services in the list of test tmp procs" $ do context "ixPing" $ do it "should succeed when accessing the nginx proc by name" $ \hs ->- ixPing @"nginx-test" Proxy hs `shouldReturn` OK+ pingHttps (hOf @(ProcHandle NginxGateway) Proxy hs) `shouldReturn` OK it "should succeed when accessing the http-bin proc by name" $ \hs -> ixPing @"http-bin-test" Proxy hs `shouldReturn` OK@@ -44,4 +45,4 @@ ixReset @HttpBinTest Proxy hs `shouldReturn` () it "should succeed when accessing the nginx proc by type" $ \hs ->- ixReset @NginxTest Proxy hs `shouldReturn` ()+ ixReset @NginxGateway Proxy hs `shouldReturn` ()
test/Test/System/TmpProc/WarpSpec.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -15,6 +16,9 @@ import qualified Network.HTTP.Client as HC import Network.HTTP.Types (status200, status400) import Network.Wai (Application, pathInfo, responseLBS)+import Network.Wai.Handler.WarpTLS (tlsSettings)+import qualified Network.Wai.Handler.WarpTLS as Warp+import System.IO.Temp (createTempDirectory, getCanonicalTemporaryDirectory) import System.TmpProc.Docker ( HList (..) , HandlesOf@@ -34,37 +38,70 @@ , testWithApplication , testWithTLSApplication )+import Test.Certs.Temp (CertPaths (..), certificatePath, defaultConfig, generateAndStore, keyPath, withCertPathsInTmp') import Test.Hspec import Test.Hspec.TmpProc (tdescribe) import Test.HttpBin-import Test.SimpleServer (statusOfGet)+import Test.NginxGateway (NginxGateway (..))+import Test.SimpleServer (statusOfGet, statusOfGet') spec :: Spec spec = tdescribe "Tmp.Proc: Warp server with Tmp.Proc dependency" $ do- beforeAllSpec >> aroundSpec+ checkBeforeAll prefixHttp setupBeforeAll statusOfGet+ checkBeforeAll prefixHttps setupBeforeAllTls statusOfGet'+ httpSpec prefixHttp setupAround statusOfGet+ httpSpec prefixHttps setupAroundTls statusOfGet' -testProcs :: HList '[HttpBinTest]+type TmpProcs = '[HttpBinTest]+++testProcs :: HList TmpProcs testProcs = only HttpBinTest -testApp :: HandlesOf '[HttpBinTest] -> IO Application+theGateway :: NginxGateway+theGateway =+ NginxGateway+ { ngCommonName = "localhost"+ , ngTargetPort = 80+ , ngTargetName = "http-bin-test"+ }+++testApp :: HandlesOf TmpProcs -> IO Application testApp hs = mkTestApp' (pingOrFail $ handleOf @"http-bin-test" Proxy hs) (pingOrFail $ handleOf @"http-bin-test" Proxy hs) -setupBeforeAll :: IO (ServerHandle '[HttpBinTest])+setupBeforeAll :: IO (ServerHandle TmpProcs) setupBeforeAll = runServer testProcs testApp --- setupBeforeAllTls :: IO (ServerHandle '[HttpBinTest])--- setupBeforeAllTls = do--- tls <- defaultTLSSettings--- runTLSServer tls testProcs testApp+setupBeforeAllTls :: IO (ServerHandle TmpProcs)+setupBeforeAllTls = do+ cp <- genCertPaths+ let tls = tlsSettings (certificatePath cp) (keyPath cp)+ runTLSServer tls testProcs testApp ++genCertPaths :: IO CertPaths+genCertPaths = do+ tmpDir <- getCanonicalTemporaryDirectory+ cpDir <- createTempDirectory tmpDir "tmp-proc-warp-spec"+ let cp =+ CertPaths+ { cpKey = "key.pem"+ , cpCert = "certificate.pem"+ , cpDir+ }+ generateAndStore cp defaultConfig+ pure cp++ suffixAround, suffixBeforeAll, prefixHttp, prefixHttps :: String suffixAround = " when the server is restarted for each test" suffixBeforeAll = " when the server starts beforeAll tests"@@ -72,16 +109,9 @@ prefixHttps = "Warp+HTTPS:" -beforeAllSpec :: Spec-beforeAllSpec = do- checkBeforeAll prefixHttp setupBeforeAll statusOfGet----- checkBeforeAll prefixHttps setupBeforeAllTls statusOfGet'- checkBeforeAll :: String ->- IO (ServerHandle '[HttpBinTest]) ->+ IO (ServerHandle TmpProcs) -> (Int -> Text -> IO Int) -> Spec checkBeforeAll descPrefix setup getter = beforeAll setup $ afterAll shutdown $ do@@ -93,29 +123,23 @@ getter (serverPort sh) "test" `shouldReturn` 200 -setupAround :: ((HandlesOf '[HttpBinTest], Int) -> IO a) -> IO a+setupAround :: ((HandlesOf TmpProcs, Int) -> IO a) -> IO a setupAround = testWithApplication testProcs testApp --- setupAroundTls :: ((HandlesOf '[HttpBinTest], Int) -> IO a) -> IO a--- setupAroundTls cont = do--- tls <- defaultTLSSettings--- testWithTLSApplication tls testProcs testApp cont--aroundSpec :: Spec-aroundSpec = do- checkEachTest prefixHttp setupAround statusOfGet+setupAroundTls :: ((HandlesOf TmpProcs, Int) -> IO a) -> IO a+setupAroundTls cont = withCertPathsInTmp' $ \cp -> do+ let tls = Warp.tlsSettings (certificatePath cp) (keyPath cp)+ testWithTLSApplication tls testProcs testApp cont --- checkEachTest prefixHttps setupAroundTls statusOfGet'--checkEachTest ::+httpSpec :: String ->- (ActionWith (HandlesOf '[HttpBinTest], Int) -> IO ()) ->+ (ActionWith (HandlesOf TmpProcs, Int) -> IO ()) -> (Int -> Text -> IO Int) -> Spec-checkEachTest descPrefix setup getter = around setup $ do- describe (descPrefix ++ suffixAround) $ do+httpSpec prefix setup getter = around setup $ do+ describe (prefix ++ suffixAround) $ do it "should ping the proc handle" $ \(h, _) -> ixPing @"http-bin-test" Proxy h `shouldReturn` OK @@ -151,7 +175,7 @@ fail "tmp proc:httpbin:ping failed" ) catchHttp $ do- gotStatus <- handleGet handle "/status/200"+ gotStatus <- httpGet handle "/status/200" if gotStatus == 200 then pure () else fail "tmp proc:httpbin:incorrect ping status"
− test_certs/certificate.csr
@@ -1,27 +0,0 @@------BEGIN CERTIFICATE REQUEST------MIIElTCCAn0CAQAwUDELMAkGA1UEBhMCSlAxDDAKBgNVBAgMA0ZVSzERMA8GA1UE-BwwISXRvc2hpbWExDDAKBgNVBAoMA0RpczESMBAGA1UEAwwJbG9jYWxob3N0MIIC-IjANBgkqhkiG9w0BAQEFAAOCAg8AMIICCgKCAgEA6I1BtufmkS2ztej42UsL9CKF-dvO64s1qLjlmKSx9pipR6O47mXqo1GLWthisLycHiVEdhy7/tPeWvuWvWQi3Ts/H-zvDS290tfKNOsCAC8lRAmW6ttLjJXFCJ9orS+mbCCdYKVwg8W99VKDZtv8krgJLl-s9GfU3kWNyUAL8V0FHSupZnap659qi2uG9sm822eRzLXvk+SjXG4qlbxyNTX+pEh-1WWNzshDg+lxp+b7rb6a7qUwOtSFyQTBSkDfIgh0w9nEju2TvKQWQACVujxtnr1F-nnaQ0PoOnz3AUq0O6sGi+Bw35C6aD/yfeF/u7s8Nt7VRa+zkDa9fNLwdBhrvqvDA-6ZYuQCjDDLmkCburNQNQWI+M4172A6DwGs9qEWHJPCCNqs1P82GMzaKva7BSebjA-juwpWdaU8T8UuJQZRDauofhEAqlCkrPRU2h+4d9rA2hYA+1rnOi2A8Ze2YTDm+BS-gU237oZyj4+d5R/kiQPIPXYVFZocN5luvzcg17EbNRqjR+w6ZiQS7M9Ow5tozqCx-ocZyjkYEGkQwuDtRnzWphWdZguISY5/wGD6cRLgA28Ww0/MNOvs891GDJyBIAiag-9xBtdNTA7Q1dGLb72Pn3UP/bSLvxSAFTPsE6x8xmkPuNPgx84KHiV+SqxFz9Y9ea-wMla4rxAbdoVV3J1J00CAwEAAaAAMA0GCSqGSIb3DQEBCwUAA4ICAQDUbiS9Tkkn-5ohDf07CZSsMOJRHsbWCe9UX4IjY9nR+FeHszcOY00H2gCoYLdiKA8JWeeeeBDBr-ymAhl4WQMaMjUQoPAjTY3v+mNZpltLlYzUYsWl6LVXoFGKk4V9tforx6XGzCcicr-YF1Vmsr9Bp32GKiqESjdaVBKWp+9FFqZQrI7ymKVbXJ9WdckHCsUTnZWJQbN3Doh-sy/VWW8Jlq6+gDv9gaLBjXtPfIhw+EU/5zURkmZcRNpwW4TTZbOaR58w64ecWuKn-k0hmqMN0uA4gj2VwxtErJSAZ3EawwqGEZ8j29eKDWwcZS3ptg+dQUQzMuhF7J1OK-rz1AmdQViuy3NYMNFNsD0cYeZXfGoe4iwpNxeH6lPbsth5vxIs0eGMrLW5/40fgt-Kp0NTE23dfkaCHolfCRs6s36WhwGooUn0MnisZDclCYPjgmbt6fyZs2273KC2fUK-Dlb256jVx1imo00muNATChA2nd1ynrdQgniEZZULGd3s6NPVrLgqCu6we6Vcbn6S-pH+nwSTSY+jwWPUl41dVbNdc7q72z0TLGlPUrk6DwqVJMunjn8j6X1RyjgfckYQH-LFAneruxFFd9sHYYDoC6Vq8nu+cyHFlDElbI3Vedclh2ddXZOpDZT8pAwWNM11Et-+9HudI6f7d/0ttbjxMoxWaewGFsFvJRFmw==------END CERTIFICATE REQUEST-----
− test_certs/certificate.pem
@@ -1,30 +0,0 @@------BEGIN CERTIFICATE------MIIFHDCCAwQCCQCZ1MePuiS6ezANBgkqhkiG9w0BAQsFADBQMQswCQYDVQQGEwJK-UDEMMAoGA1UECAwDRlVLMREwDwYDVQQHDAhJdG9zaGltYTEMMAoGA1UECgwDRGlz-MRIwEAYDVQQDDAlsb2NhbGhvc3QwHhcNMTkwMjI2MDY0MzU5WhcNMTkwMzI4MDY0-MzU5WjBQMQswCQYDVQQGEwJKUDEMMAoGA1UECAwDRlVLMREwDwYDVQQHDAhJdG9z-aGltYTEMMAoGA1UECgwDRGlzMRIwEAYDVQQDDAlsb2NhbGhvc3QwggIiMA0GCSqG-SIb3DQEBAQUAA4ICDwAwggIKAoICAQDojUG25+aRLbO16PjZSwv0IoV287rizWou-OWYpLH2mKlHo7juZeqjUYta2GKwvJweJUR2HLv+095a+5a9ZCLdOz8fO8NLb3S18-o06wIALyVECZbq20uMlcUIn2itL6ZsIJ1gpXCDxb31UoNm2/ySuAkuWz0Z9TeRY3-JQAvxXQUdK6lmdqnrn2qLa4b2ybzbZ5HMte+T5KNcbiqVvHI1Nf6kSHVZY3OyEOD-6XGn5vutvprupTA61IXJBMFKQN8iCHTD2cSO7ZO8pBZAAJW6PG2evUWedpDQ+g6f-PcBSrQ7qwaL4HDfkLpoP/J94X+7uzw23tVFr7OQNr180vB0GGu+q8MDpli5AKMMM-uaQJu6s1A1BYj4zjXvYDoPAaz2oRYck8II2qzU/zYYzNoq9rsFJ5uMCO7ClZ1pTx-PxS4lBlENq6h+EQCqUKSs9FTaH7h32sDaFgD7Wuc6LYDxl7ZhMOb4FKBTbfuhnKP-j53lH+SJA8g9dhUVmhw3mW6/NyDXsRs1GqNH7DpmJBLsz07Dm2jOoLGhxnKORgQa-RDC4O1GfNamFZ1mC4hJjn/AYPpxEuADbxbDT8w06+zz3UYMnIEgCJqD3EG101MDt-DV0YtvvY+fdQ/9tIu/FIAVM+wTrHzGaQ+40+DHzgoeJX5KrEXP1j15rAyVrivEBt-2hVXcnUnTQIDAQABMA0GCSqGSIb3DQEBCwUAA4ICAQCOi2MIn+PSjIEKz1p4x2b6-O4trvi3epP7BXIhseU++JhqR0x+hgR/Xmmir5lw5yuRwmnlG005rz9fLEK1q8W1Q-MZRQDU/2hX3+JJ/QczIaaOqQrnlzwiOj69TZtBxi9nNxMDtzoUA644s+2yngufxr-PIag7UupoeQVFrkSRgyREdszMKtZ0d7oZ0EZqEod0uUH89kkI3IE3fWW/fUtEIfV-ymscYPHlvIBCJQ9c2S/wXNxakXjCwYbiHE8yGeEJxBYcmSuZkei/kLvKmBuTmzo0-8rENCNSyvL1EBDIe9Gp2pvFhYUepjhq8lsbWV7EjMY+hqiMyuHk7v6HS14nmg9fv-1+3J61NsunHPzqSYzf3YI8aq1r4JaC644XlRQgrVuZtcH+lD785GTn3tBN0eYEen-6qGThiUIgC5VzuGrRX4FWoZsAE46NWVU0tMmYnpmEAdJUr3PEEFFkNNG1CzobYPK-e9otNUiRJ5A9PGCHK9auWkH5/7EJECaO5WW8wgBspQYu4GJM/NF5Yioph81X4XSi-l6TROBWapD2l3Z7v5kYL0N1SqOvdO2XuJKtKN8GTlSXRDHWg24MhGkb66M70H1Mw-dJMsxq+zd2SEVFn8+MhPwAN3q78l6W9XRxSn7Ox2VY8g9Unz4f2SIWL0AHPeKHAc-ES2bGzGq8NsKtYeky1Pjow==------END CERTIFICATE-----
− test_certs/key.pem
@@ -1,51 +0,0 @@------BEGIN RSA PRIVATE KEY------MIIJJwIBAAKCAgEA6I1BtufmkS2ztej42UsL9CKFdvO64s1qLjlmKSx9pipR6O47-mXqo1GLWthisLycHiVEdhy7/tPeWvuWvWQi3Ts/HzvDS290tfKNOsCAC8lRAmW6t-tLjJXFCJ9orS+mbCCdYKVwg8W99VKDZtv8krgJLls9GfU3kWNyUAL8V0FHSupZna-p659qi2uG9sm822eRzLXvk+SjXG4qlbxyNTX+pEh1WWNzshDg+lxp+b7rb6a7qUw-OtSFyQTBSkDfIgh0w9nEju2TvKQWQACVujxtnr1FnnaQ0PoOnz3AUq0O6sGi+Bw3-5C6aD/yfeF/u7s8Nt7VRa+zkDa9fNLwdBhrvqvDA6ZYuQCjDDLmkCburNQNQWI+M-4172A6DwGs9qEWHJPCCNqs1P82GMzaKva7BSebjAjuwpWdaU8T8UuJQZRDauofhE-AqlCkrPRU2h+4d9rA2hYA+1rnOi2A8Ze2YTDm+BSgU237oZyj4+d5R/kiQPIPXYV-FZocN5luvzcg17EbNRqjR+w6ZiQS7M9Ow5tozqCxocZyjkYEGkQwuDtRnzWphWdZ-guISY5/wGD6cRLgA28Ww0/MNOvs891GDJyBIAiag9xBtdNTA7Q1dGLb72Pn3UP/b-SLvxSAFTPsE6x8xmkPuNPgx84KHiV+SqxFz9Y9eawMla4rxAbdoVV3J1J00CAwEA-AQKCAgBRPLdOG+ixopN64q27yrmcSUryaOZKQJPtHeQQUhh6qaH/iumLDgxYVUbI-SgosVqgNUibMiKCPKUah3T7KDX9rqq4UHpCqebNgLPRaFnSxDrmaX82SqlK9Su1H-EOvuyWLTaNAn4xqixXvMFmd0beQigC56CKpt0IjwLp7IEWQhmTlBZGO72/rOLjL6-TC5pL0vxd1Niig2aF7X423KPQ7tHLtfw4g8Nw2vCcxRfIROeeE1LPK2Cf6dUt7KG-K+9Gxklz+WjuvRO0/GVBanLjoiRxJZFib+za89+TxVCgERB69bXmkoT700PCfe9/-b5PaHL6gBFkzKIfqN+88TtKcxWAfXo52xqbNiMTnf9SHmbNQjjB2qWai2EyvZvv9-+ZRqtjohYumA4Osm/TmGgIV2LvEAsxZ45e+zJ35pzqCr9p2trHMHS6atA8kahij0-ZWw7z+rl7uSgghJnanL4fdEhUH5Fu5s8d9a72Vhs8VAs1PBsY6waHAVVcaJeHA1b-GaCaDEuebM7HRnr9QmQ99iV778uGuezkm5sUUNmiKsBqskUdhtQZiWMlzZSNiCqO-rbPb7Fl1ovLwUsW7oPLNane4FMjFl7y9R78rpcNu34Ok2mAEAbvaLH2UeOGlVisM-cCilEg/pwfg9GGPgThJI1c5QKbUBEKlBBW1mq8ONFUPhIJD1gQKCAQEA9AlqZCWX-uaZGN4OfYI1avtmIkYBtSZ78OqGMIZZ5S8FpLIQcONPlMWJFgrXM8rCIKnJn11WV-MX7B7V+RoDMUTZue8cNV8Fvx/GEuwNF0lpXI8SAEZSez2v4lEkHU5CShZqZa4+LH-JoYndzwbVzHoc/vyRN67IBlBjTOgdhOCwKccuKTdgZeFvSfUxlIeQZq8j3L05hUQ-zhEy8El8q5Uaqj7z2e+aOB6q7fwtgH+LDlBFB6SxashrgfMwez7ZJC/NdKxl2L0K-ND2A7qmsUUFhRwzd1QHH2f4td8TrwAgUZIJEidAgEzLbWaeJ3zbyADmZo1EjBVOH-Tfvxc0ntwyxyXQKCAQEA8/O1QkwPjxaCsVBv7AZSqHbZAa3y0aZKP8fThR6qpBOu-ZiDRWqD0+tKIXtFyUkt3W7oxaK9v2Y6qzRtCYP6VPXIPuHPreGbnZRPXSz2BAf+W-XIhE4ALcAYDSX0qJ1Mz6f76fMGN7PRPPBFqQI7/rO9xUwzuR+RuhpD6eTpjGSsNH-JBluLpYK5oKbCej29wHQnT9RYUZBPkXXEJqH0JgLYJ2qhCt0lj7UWe1mTOwcN+iz-Or4GmlxPejNGRl1S4HcuZ7nIkBa3R7dpUFfRDqfmt14pc7bOZA/LTdFMJdcmxgK3-ME1JFZ0HHdfsdSW/47fWwRCi8lE/Gt6yvJ3aZNsZsQKCAQBx69tQuQPlVKu+yqEi-L5rHMUHButRJ5AAXVsbV/yrMpJN2ho2uMazyqs+MP1ZXjPVj61hye69UFbpuF4kh-4fZ+bEF81xVNSX7jtHJg7OaiTXYqqimjFy+s8atYpIa/oiH+i3Yun/UcFNBjpxmU-UOYVDu6AHAH68A9b3VfxBxao3NpZkA0frB5wuSFpG3ioY5XW2XFd30OjDwBaj9O1-Pbve8dhgSqwRuq9MvcZ4EBJYMjynXsi78qfNWDuvrR0s+WvOJZS94zHaRUPlJiwd-GopQ4r7D6zrilveey7zKPntWmEFqnE/85mbjqYSBQWMjm8APL5dLqzykuRJ0IXTv-Ada5AoIBAArr4DOFoDSxt0wk473XUqAEIhb3KKXGIhDU611MUCtkTix4T6cVCaKp-Bj3odovEoSVUIp4jLIi64F6qV8Br5VaI4rdJSUNsp/NYfgz6RepG/P5Lg3nb5umS-UNi/R4hlXNmXOR07dur3Fg+F1mojT26woILVCeXzHLtzqjaulEIImAi/srUXNom3-UyWQbm4EgMhpa0VFleopykUOBgKKrAe5R0b/gwqu6WbVP/01nNXL7yo0E6uZcl1w-KjdAOlOeQk+We6onujDVvzs/kzZqweN3rbdmebr1Eg77zcLr7Op0eKsK6riy/PyT-DBz6gaq6Mj0Wd5UNmhuj2LClCH/3ZyECggEALeaBlOCBR/r+CXIk0wQm2CCzsKH8-MgScDBUQniyxL0dhXvIIcvhb2k+watUzGWgt33FjT2jogCuaC0LkxsuhnhgAP8I7-eeWwGa2dSyRcl4vKZi43hkGDmIp9eTMY9mYxn7+FMnTQ2JLDbuaU/lF10Nk58Yqb-0K/OeSRMUwZcv8Am3lav+YUad1+nPg6JxdhDZ4u09LXtdshhr9VJfMKz21+lhLGT-oRgvyHQFKPinSn+FLzYu5rdZCiTDPaeFU6TzQec7QGnunuOCEpc4iiT+CfpSixwo-BnjO6N0VQhN6hPrVLc730cq9GhFlK/dOgvnJtfsruoUNctMezPigPNG2ng==------END RSA PRIVATE KEY-----
tmp-proc.cabal view
@@ -1,22 +1,16 @@ cabal-version: 3.0 name: tmp-proc-version: 0.6.1.0+version: 0.6.2.0 synopsis: Run 'tmp' processes in integration tests description: @tmp-proc@ runs services in docker containers for use in integration tests.- It aims to make using these services become like accessing /tmp/ processes, similar to how /tmp/ file or directories are used.- It aspires to provide a user-friendly API, while including useful features such as- * launch of multiple services on docker during test setup- * delayed test execution until the launched services are available- * simplified use of connections to the services from a [WAI](https://hackage.haskell.org/package/wai) server under test- * good integration with haskell testing frameworks like [hspec](https://hspec.github.io) and [tasty](https://hackage.haskell.org/package/tasty) @@ -27,19 +21,16 @@ maintainer: adetokunbo@users.noreply.github.com category: testing, docker bug-reports: https://github.com/adetokunbo/tmp-proc/issues-homepage: https://github.com/adetokunbo/tmp-proc/tree/master/tmp-proc#tmp-proc+homepage:+ https://github.com/adetokunbo/tmp-proc/tree/master/tmp-proc#tmp-proc+ build-type: Simple data-files:- test_certs/*.csr- test_certs/*.pem-extra-source-files:- ChangeLog.md-tested-with:- GHC == 8.10.7- GHC == 9.0.2- GHC == 9.2.8- GHC == 9.4.5+ templates/*.mustache +extra-source-files: ChangeLog.md+tested-with: GHC ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.5+ source-repository head type: git location: https://github.com/adetokunbo/tmp-proc.git@@ -57,12 +48,14 @@ build-depends: , async ^>=2.2.1 , base >=4.14 && <5- , bytestring >=0.10.8.2 && <0.12.2- , mtl >=2.2 && <2.3 || >= 2.3.1 && <2.4- , network >=2.6.3.6 && <3.2+ , bytestring >=0.10.8 && <0.11 || >=0.11.3 && <0.13+ , fmt >=0.6 && <0.7+ , mtl >=2.2 && <2.3 || >=2.3.1 && <2.4+ , network >=2.6.3 && <3.3 , process ^>=1.6.3.0- , text >=1.2.3 && <2.2- , tls >=1.7 && <2.2+ , random >=1.1 && <1.3+ , text >=1.2.3 && <2.2+ , tls >=1.7 && <2.2 , unliftio ^>=0.2.7 , wai >=3.2 && <3.3 , warp >=3.3 && <3.5@@ -75,42 +68,55 @@ type: exitcode-stdio-1.0 main-is: Spec.hs autogen-modules: Paths_tmp_proc- other-modules:+ Paths_tmp_proc Test.Hspec.TmpProc Test.HttpBin+ Test.NginxGateway Test.SimpleServer Test.System.TmpProc.Hspec Test.System.TmpProc.HttpBinSpec Test.System.TmpProc.WarpSpec- Paths_tmp_proc hs-source-dirs: test build-depends: , base , bytestring- , data-default- , hspec- , http-client- , http-types+ , crypton-connection >=0.3 && <0.4+ , crypton-x509-system >=1.6 && <1.8+ , data-default >=0.5 && <0.8+ , directory >=1.3 && <1.4+ , filepath >=1.4 && <1.6+ , hspec >=2.7 && <2.12+ , http-client >=0.5 && <0.8+ , http-client-tls >=0.3 && <0.4+ , http-types >=0.8+ , mustache >=2.3 && <2.5+ , temporary >=1.2 && <1.5+ , test-certs >=0.1 && <0.2 , text+ , tls , tmp-proc , wai , warp+ , warp-tls+ , unix >=2.7 && <2.9 default-language: Haskell2010 ghc-options: -threaded -rtsopts -with-rtsopts=-N -fno-ignore-asserts -Wall -Flag use-doc-tests+flag use-doc-tests description: Include the doctests in the package tests default: False test-suite doctests if flag(use-doc-tests)- buildable: True+ buildable: True+ else- buildable: False+ buildable: False+ type: exitcode-stdio-1.0 main-is: Main.hs build-depends:@@ -122,20 +128,21 @@ default-language: Haskell2010 ghc-options: -threaded --Flag build-the-readme+flag build-the-readme description: Allow the readme to build default: False - executable readme- if os(windows) || !flag(build-the-readme)+ if (os(windows) || !flag(build-the-readme)) buildable: False+ else buildable: True build-tool-depends: markdown-unlit:markdown-unlit- ghc-options: -pgmL markdown-unlit -threaded -rtsopts -with-rtsopts=-N+ ghc-options:+ -pgmL markdown-unlit -threaded -rtsopts -with-rtsopts=-N+ main-is: README.lhs default-language: Haskell2010 build-depends: