hw-polysemy 0.2.14.10 → 0.2.14.11
raw patch · 3 files changed
+80/−39 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- core/HaskellWorks/Polysemy/Data/ULID.hs +35/−0
- hw-polysemy.cabal +3/−1
- testcontainers-localstack/HaskellWorks/TestContainers/LocalStack.hs +42/−38
+ core/HaskellWorks/Polysemy/Data/ULID.hs view
@@ -0,0 +1,35 @@+module HaskellWorks.Polysemy.Data.ULID+ ( getULIDTime,+ getULID,+ ulidToInteger,+ ulidFromInteger,+ ) where++import Control.Monad.IO.Class (MonadIO (..))+import Data.Time.Clock.POSIX+import qualified Data.ULID as ULID+import HaskellWorks.Prelude+import Polysemy++getULIDTime :: forall r m. ()+ => MonadIO m+ => Member (Embed m) r+ => POSIXTime+ -> Sem r ULID.ULID+getULIDTime time =+ embed $ liftIO $ ULID.getULIDTime time++getULID :: forall r m. ()+ => MonadIO m+ => Member (Embed m) r+ => Sem r ULID.ULID+getULID =+ embed $ liftIO ULID.getULID++ulidToInteger :: ULID.ULID -> Integer+ulidToInteger =+ ULID.ulidToInteger++ulidFromInteger :: Integer -> Either Text ULID.ULID+ulidFromInteger =+ ULID.ulidFromInteger
hw-polysemy.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.4 name: hw-polysemy-version: 0.2.14.10+version: 0.2.14.11 synopsis: Opinionated polysemy library description: Opinionated polysemy library. license: Apache-2.0@@ -118,6 +118,7 @@ text, temporary, time,+ ulid, unliftio, Win32, yaml,@@ -149,6 +150,7 @@ HaskellWorks.Polysemy.Data.Text HaskellWorks.Polysemy.Data.Text.Lazy HaskellWorks.Polysemy.Data.Text.Strict+ HaskellWorks.Polysemy.Data.ULID HaskellWorks.Polysemy.Error HaskellWorks.Polysemy.Error.Types HaskellWorks.Polysemy.Except
testcontainers-localstack/HaskellWorks/TestContainers/LocalStack.hs view
@@ -4,13 +4,13 @@ {- HLINT ignore "Use camelCase" -} -module HaskellWorks.TestContainers.LocalStack- ( LocalStackEndpoint(..)- , TC.Container- , setupContainers- , setupContainers'- , waitForLocalStack- ) where+module HaskellWorks.TestContainers.LocalStack (+ LocalStackEndpoint (..),+ TC.Container,+ setupContainers,+ setupContainers',+ waitForLocalStack,+) where import Prelude @@ -23,47 +23,52 @@ import Data.Function import qualified Data.Text as T import Data.Time.Clock.POSIX (getPOSIXTime)-import HaskellWorks.Prelude-import HaskellWorks.TestContainers.LocalStack.Types (LocalStackEndpoint (LocalStackEndpoint)) import Network.HTTP.Conduit (HttpException, simpleHttp) import qualified System.Environment as IO++import HaskellWorks.Prelude+import HaskellWorks.TestContainers.LocalStack.Types (LocalStackEndpoint (LocalStackEndpoint)) import qualified TestContainers.Monad as TC import qualified TestContainers.Tasty as TC -- | Sets up and runs the containers required for this test suite.-setupContainers :: ()- => TC.MonadDocker m- => m TC.Container+setupContainers ::+ () =>+ (TC.MonadDocker m) =>+ m TC.Container setupContainers = setupContainers' "localstack/localstack-pro:latest" -- | Sets up and runs the containers required for this test suite.-setupContainers' :: ()- => TC.MonadDocker m- => Text- -> m TC.Container+setupContainers' ::+ () =>+ (TC.MonadDocker m) =>+ Text ->+ m TC.Container setupContainers' dockerTag = do- authToken <- liftIO $ IO.lookupEnv "LOCALSTACK_AUTH_TOKEN"- -- Launch the container based on the postgres image.- localstackContainer <- TC.run $ TC.containerRequest (TC.fromTag dockerTag)- & TC.setEnv [("LOCALSTACK_AUTH_TOKEN", maybe "" T.pack authToken)]- -- Expose the port 4566 from within the container. The respective port- -- on the host machine can be looked up using `containerPort` (see below).- & TC.setExpose- ( mconcat- [ [ 4566 ]- ]- )- -- Wait until the container is ready to accept requests. `run` blocks until- -- readiness can be established.- & TC.setWaitingFor (TC.waitUntilMappedPortReachable 4566)+ authToken <- liftIO $ IO.lookupEnv "LOCALSTACK_AUTH_TOKEN"+ -- Launch the container based on the postgres image.+ localstackContainer <-+ TC.run $+ TC.containerRequest (TC.fromTag dockerTag)+ & TC.setEnv [("LOCALSTACK_AUTH_TOKEN", maybe "" T.pack authToken)]+ -- Expose the port 4566 from within the container. The respective port+ -- on the host machine can be looked up using `containerPort` (see below).+ & TC.setExpose+ ( mconcat+ [ [4566]+ ]+ )+ -- Wait until the container is ready to accept requests. `run` blocks until+ -- readiness can be established.+ & TC.setWaitingFor (TC.waitUntilMappedPortReachable 4566) - -- Look up the corresponding port on the host machine for the exposed port 4566.- let localStackPort = TC.containerPort localstackContainer 4566+ -- Look up the corresponding port on the host machine for the exposed port 4566.+ let localStackPort = TC.containerPort localstackContainer 4566 - liftIO $ waitForLocalStack "localhost" localStackPort 100+ liftIO $ waitForLocalStack "localhost" localStackPort 100 - pure localstackContainer+ pure localstackContainer waitForLocalStack :: String -> Int -> Int -> IO () waitForLocalStack host port timeout = do@@ -75,14 +80,13 @@ result <- try $ simpleHttp url :: IO (Either HttpException LBS.ByteString) case result of Right _ -> do- putStrLn "LocalStack is ready!"- IO.threadDelay 100_000- putStrLn ""+ IO.threadDelay 1_000_000+ putStrLn "" Left e -> do currentTime <- getPOSIXTime let elapsedTime = currentTime - startTime when (elapsedTime < fromIntegral timeout) $ do- threadDelay 100_000+ threadDelay 500_000 checkLoop startTime url when (elapsedTime >= fromIntegral timeout) $ do putStrLn "Timeout reached. LocalStack is not ready."