testcontainers 0.5.2.0 → 0.5.3.0
raw patch · 5 files changed
+128/−98 lines, 5 filesdep +scientificdep +vectordep −aeson-opticsdep −optics-core
Dependencies added: scientific, vector
Dependencies removed: aeson-optics, optics-core
Files
- CHANGELOG.md +4/−0
- src/TestContainers/Docker.hs +58/−69
- src/TestContainers/Docker/JSON.hs +53/−0
- src/TestContainers/Docker/State.hs +9/−25
- testcontainers.cabal +4/−4
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for testcontainer-hs +## 0.5.3.0 -- 2026-03-31++* Removed dependency on `optics-core` and `aeson-optics` (@alexbiehl, https://github.com/testcontainers/testcontainers-hs/pull/70)+ ## 0.5.2.0 -- 2025-08-28 * Introduce `withCopyFileToContainer` to copy local files to the container (@LaurentRDC, https://github.com/testcontainers/testcontainers-hs/pull/62)
src/TestContainers/Docker.hs view
@@ -180,11 +180,11 @@ runResourceT, ) import Data.Aeson (decode')-import qualified Data.Aeson.Optics as Optics import qualified Data.ByteString.Lazy.Char8 as LazyByteString import Data.Function ((&))+import Data.Functor ((<&>)) import Data.List (find, stripPrefix)-import Data.Maybe (fromMaybe)+import Data.Maybe (fromMaybe, listToMaybe) import Data.String (IsString (..)) import Data.Text (Text, pack, splitOn, strip, unpack) import Data.Text.Encoding (encodeUtf8)@@ -205,9 +205,6 @@ ) import Network.HTTP.Types (statusCode) import qualified Network.Socket as Socket-import Optics.Fold (pre)-import Optics.Operators ((^?))-import Optics.Optic ((%), (<&>)) import System.Directory (doesFileExist) import System.Environment (lookupEnv) import System.IO (Handle, hClose)@@ -233,6 +230,7 @@ dockerWithStdin, prefixedLogConsumer, )+import TestContainers.Docker.JSON (asText, eachMember, eachValue, lookupKey) import TestContainers.Docker.Network ( Network, NetworkId,@@ -923,7 +921,7 @@ internalInspect configTracer id let state = containerState inspectOutput- containerName = inspectOutput ^? Optics.key "Name" % Optics._String+ containerName = lookupKey "Name" inspectOutput >>= asText exception = InvalidStateException { id = id,@@ -1123,7 +1121,7 @@ case result of Nothing -> do let Container {image, inspectOutput} = container- containerName = inspectOutput ^? Optics.key "Name" % Optics._String+ containerName = lookupKey "Name" inspectOutput >>= asText throwM $ TimeoutException { id,@@ -1200,12 +1198,9 @@ -- | Get the IP address of a running Docker container using @docker inspect@. internalContainerIp :: Container -> Text internalContainerIp Container {id, inspectOutput, image} =- case inspectOutput- ^? Optics.key "NetworkSettings"- % Optics.key "IPAddress"- % Optics._String of+ case lookupKey "NetworkSettings" inspectOutput >>= lookupKey "IPAddress" >>= asText of Nothing -> do- let containerName = inspectOutput ^? Optics.key "Name" % Optics._String+ let containerName = lookupKey "Name" inspectOutput >>= asText throw $ InspectOutputUnexpected { id,@@ -1221,25 +1216,21 @@ -- @since 0.5.0.0 containerAlias :: Container -> Text containerAlias Container {id, inspectOutput, image} =- case inspectOutput- ^? pre- ( Optics.key "NetworkSettings"- % Optics.key "Networks"- % Optics.members- % Optics.key "Aliases"- % Optics.values- % Optics._String- ) of- Nothing -> do- let containerName = inspectOutput ^? Optics.key "Name" % Optics._String- throw $- InspectOutputMissingNetwork- { id,- imageName = Just (imageTag image),- containerName = containerName- }- Just alias ->- alias+ let aliases = do+ network <- maybe [] eachMember (lookupKey "NetworkSettings" inspectOutput >>= lookupKey "Networks")+ aliasValue <- maybe [] eachValue (lookupKey "Aliases" network)+ maybe [] pure (asText aliasValue)+ in case listToMaybe aliases of+ Nothing -> do+ let containerName = lookupKey "Name" inspectOutput >>= asText+ throw $+ InspectOutputMissingNetwork+ { id,+ imageName = Just (imageTag image),+ containerName = containerName+ }+ Just alias ->+ alias -- | Get the IP address for the container's gateway, i.e. the host. -- Takes the first gateway address found.@@ -1247,24 +1238,20 @@ -- @since 0.5.0.0 containerGateway :: Container -> Text containerGateway Container {id, inspectOutput, image} =- case inspectOutput- ^? pre- ( Optics.key "NetworkSettings"- % Optics.key "Networks"- % Optics.members- % Optics.key "Gateway"- % Optics._String- ) of- Nothing -> do- let containerName = inspectOutput ^? Optics.key "Name" % Optics._String- throw $- InspectOutputMissingNetwork- { id,- imageName = Just (imageTag image),- containerName = containerName- }- Just gatewayIp ->- gatewayIp+ let gateways = do+ network <- maybe [] eachMember (lookupKey "NetworkSettings" inspectOutput >>= lookupKey "Networks")+ maybe [] pure (lookupKey "Gateway" network >>= asText)+ in case listToMaybe gateways of+ Nothing -> do+ let containerName = lookupKey "Name" inspectOutput >>= asText+ throw $+ InspectOutputMissingNetwork+ { id,+ imageName = Just (imageTag image),+ containerName = containerName+ }+ Just gatewayIp ->+ gatewayIp -- | Looks up an exposed port on the host. --@@ -1278,26 +1265,28 @@ in -- TODO be more mindful, make sure to grab the -- port from the right host address - case inspectOutput- ^? pre- ( Optics.key "NetworkSettings"- % Optics.key "Ports"- % Optics.key textPort- % Optics.values- % Optics.key "HostPort"- % Optics._String- ) of- Nothing ->- let containerName = inspectOutput ^? Optics.key "Name" % Optics._String- in throw $- UnknownPortMapping- { id,- port = textPort,- imageName = Just (imageTag image),- containerName = containerName- }- Just hostPort ->- read (unpack hostPort)+ let hostPorts = do+ entry <-+ maybe+ []+ eachValue+ ( lookupKey "NetworkSettings" inspectOutput+ >>= lookupKey "Ports"+ >>= lookupKey (show port <> "/" <> unpack protocol)+ )+ maybe [] pure (lookupKey "HostPort" entry >>= asText)+ in case listToMaybe hostPorts of+ Nothing ->+ let containerName = lookupKey "Name" inspectOutput >>= asText+ in throw $+ UnknownPortMapping+ { id,+ port = textPort,+ imageName = Just (imageTag image),+ containerName = containerName+ }+ Just hostPort ->+ read (unpack hostPort) -- | Returns the domain and port exposing the given container's port. Differs -- from 'containerPort' in that 'containerAddress' will return the container's
+ src/TestContainers/Docker/JSON.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Helpers for navigating aeson 'Value' trees without+-- an optics dependency.+module TestContainers.Docker.JSON+ ( lookupKey,+ asText,+ asBool,+ asInteger,+ eachMember,+ eachValue,+ )+where++import Data.Aeson (Value (..), withObject)+import Data.Aeson.Types (parseMaybe, (.:))+import Data.Scientific (floatingOrInteger)+import Data.String (IsString (..))+import Data.Text (Text)+import qualified Data.Vector as Vector++-- | Look up a key in a JSON object. Works across aeson 1.x and 2.x+-- because '(.:)' accepts both 'Text' and 'Key' via 'IsString'.+lookupKey :: String -> Value -> Maybe Value+lookupKey k = parseMaybe (withObject "object" (\obj -> obj .: fromString k))++-- | Extract a 'Text' from a JSON 'String' value.+asText :: Value -> Maybe Text+asText (String t) = Just t+asText _ = Nothing++-- | Extract a 'Bool' from a JSON boolean value.+asBool :: Value -> Maybe Bool+asBool (Bool b) = Just b+asBool _ = Nothing++-- | Extract an 'Integer' from a JSON number value.+asInteger :: Value -> Maybe Integer+asInteger (Number n) =+ case floatingOrInteger n of+ Right i -> Just i+ Left _floatingPoint -> Nothing+asInteger _ = Nothing++-- | Collect all member values from a JSON object.+eachMember :: Value -> [Value]+eachMember (Object obj) = foldMap (: []) obj+eachMember _ = []++-- | Collect all elements from a JSON array.+eachValue :: Value -> [Value]+eachValue (Array arr) = Vector.toList arr+eachValue _ = []
src/TestContainers/Docker/State.hs view
@@ -19,11 +19,9 @@ import Control.Exception (Exception, throw) import Data.Aeson (Value)-import qualified Data.Aeson.Optics as Optics import Data.Text (Text)-import Optics.Operators ((^?))-import Optics.Optic ((%)) import TestContainers.Docker.Internal (InspectOutput)+import TestContainers.Docker.JSON (asBool, asInteger, asText, lookupKey) -- | An exception thrown in case the State object is invalid and couldn't be parsed. --@@ -57,7 +55,7 @@ -- @since 0.5.0.0 containerState :: InspectOutput -> State containerState inspectOutput =- case inspectOutput ^? Optics.key "State" of+ case lookupKey "State" inspectOutput of Just state -> State state Nothing -> State "dummy" @@ -66,9 +64,7 @@ -- @since 0.5.0.0 stateStatus :: State -> Status stateStatus (State value) =- case value- ^? Optics.key "Status"- % Optics._String of+ case lookupKey "Status" value >>= asText of Just "created" -> Created Just "running" -> Running Just "paused" -> Paused@@ -84,9 +80,7 @@ -- @since 0.5.0.0 stateOOMKilled :: State -> Bool stateOOMKilled (State value) =- case value- ^? Optics.key "OOMKilled"- % Optics._Bool of+ case lookupKey "OOMKilled" value >>= asBool of Just True -> True _ -> False @@ -95,9 +89,7 @@ -- @since 0.5.0.0 statePid :: State -> Maybe Int statePid (State value) =- case value- ^? Optics.key "Pid"- % Optics._Integer of+ case lookupKey "Pid" value >>= asInteger of Just pid -> Just (fromIntegral pid) _ -> Nothing @@ -106,9 +98,7 @@ -- @since 0.5.0.0 stateExitCode :: State -> Maybe Int stateExitCode (State value) =- case value- ^? Optics.key "ExitCode"- % Optics._Integer of+ case lookupKey "ExitCode" value >>= asInteger of Just exitCode -> Just (fromIntegral exitCode) _ -> Nothing @@ -117,9 +107,7 @@ -- @since 0.5.0.0 stateError :: State -> Maybe Text stateError (State value) =- case value- ^? Optics.key "Error"- % Optics._String of+ case lookupKey "Error" value >>= asText of Just err -> Just err _ -> Nothing @@ -128,9 +116,7 @@ -- @since 0.5.0.0 stateStartedAt :: State -> Maybe Text stateStartedAt (State value) =- case value- ^? Optics.key "StartedAt"- % Optics._String of+ case lookupKey "StartedAt" value >>= asText of Just err -> Just err _ -> Nothing @@ -139,8 +125,6 @@ -- @since 0.5.0.0 stateFinishedAt :: State -> Maybe Text stateFinishedAt (State value) =- case value- ^? Optics.key "FinishedAt"- % Optics._String of+ case lookupKey "FinishedAt" value >>= asText of Just err -> Just err _ -> Nothing
testcontainers.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: testcontainers-version: 0.5.2.0+version: 0.5.3.0 synopsis: Docker containers for your integration tests. description: testcontainers is a Haskell library that provides a friendly API to@@ -42,11 +42,10 @@ TestContainers.Tasty TestContainers.Trace - -- other-modules:+ other-modules: TestContainers.Docker.JSON -- other-extensions: build-depends: aeson >=1.4.6 && <3- , aeson-optics >=1.1 && <2 , async , base >=4.12 && <5 , bytestring >=0.10.8 && <0.13@@ -56,13 +55,14 @@ , http-types >=0.12.3 && <1 , mtl >=2.2.2 && <3 , network >=2.8.0 && <3.3- , optics-core >=0.1 && <0.5 , process >=1.6.5 && <1.7 , random >=1.2 && <2 , resourcet >=1.2.4 && <1.4+ , scientific >=0.3 && <0.4 , tasty >=1.0 && <1.6 , text >=1.2.3 && <3 , unliftio-core >=0.1.0 && <0.3+ , vector >=0.12 && <0.14 hs-source-dirs: src default-language: Haskell2010