[Git][haskell-team/DHG_packages][master] http-client: Disable tests that access the network

Ilias Tsitsimpis (@iliastsi) gitlab at salsa.debian.org
Sun Oct 13 16:01:30 BST 2024



Ilias Tsitsimpis pushed to branch master at Debian Haskell Group / DHG_packages


Commits:
fef8b84a by Ilias Tsitsimpis at 2024-10-13T17:58:30+03:00
http-client: Disable tests that access the network

- - - - -


4 changed files:

- p/haskell-http-client/debian/changelog
- + p/haskell-http-client/debian/patches/disable-external-network-connection-test-2.diff
- p/haskell-http-client/debian/patches/disable-external-network-connection-test.diff
- p/haskell-http-client/debian/patches/series


Changes:

=====================================
p/haskell-http-client/debian/changelog
=====================================
@@ -1,3 +1,9 @@
+haskell-http-client (0.7.17-2) unstable; urgency=medium
+
+  * Disable tests that access the network (Closes: #1084839)
+
+ -- Ilias Tsitsimpis <iliastsi at debian.org>  Sun, 13 Oct 2024 17:57:38 +0300
+
 haskell-http-client (0.7.17-1) unstable; urgency=medium
 
   * Declare compliance with Debian policy 4.7.0


=====================================
p/haskell-http-client/debian/patches/disable-external-network-connection-test-2.diff
=====================================
@@ -0,0 +1,67 @@
+Description: Disable tests that access the network
+Author: Ilias Tsitsimpis <iliastsi at debian.org>
+Bug: https://github.com/snoyberg/http-client/issues/545
+Bug-Debian: https://bugs.debian.org/1084839
+
+Index: b/test-nonet/Network/HTTP/ClientSpec.hs
+===================================================================
+--- a/test-nonet/Network/HTTP/ClientSpec.hs
++++ b/test-nonet/Network/HTTP/ClientSpec.hs
+@@ -39,26 +39,6 @@ silentIOError a = a `E.catch` \e -> do
+   let _ = e :: IOError
+   return ()
+ 
+-redirectServerToDifferentHost :: Maybe Int -> (Int -> IO a) -> IO a
+-redirectServerToDifferentHost maxRedirects inner = bracket
+-    (N.bindRandomPortTCP "*4")
+-    (NS.close . snd)
+-    $ \(port, lsocket) -> withAsync
+-        (N.runTCPServer (N.serverSettingsTCPSocket lsocket) app)
+-        (const $ inner port)
+-    where
+-    redirect ad = do
+-        N.appWrite ad "HTTP/1.1 301 Redirect\r\nLocation: http://example.com\r\ncontent-length: 5\r\n\r\n"
+-        threadDelay 10000
+-        N.appWrite ad "hello\r\n"
+-        threadDelay 10000
+-    app ad = Async.race_
+-        (silentIOError $ forever (N.appRead ad))
+-        (silentIOError $ case maxRedirects of
+-            Nothing -> forever $ redirect ad
+-            Just n ->
+-              replicateM_ n (redirect ad) >>
+-              N.appWrite ad "HTTP/1.1 200 OK\r\ncontent-length: 5\r\n\r\nhello\r\n")
+ 
+ redirectServer :: Maybe Int
+                -- ^ If Just, stop redirecting after that many hops.
+@@ -198,30 +178,6 @@ spec = describe "Client" $ do
+           print $ map (requestHeaders . fst) $ hrRedirects hr
+           mapM_ (\r -> requestHeaders r `shouldBe` []) $
+             map fst $ tail $ hrRedirects hr
+-    it "does strips header on redirect, if hosts are different and set to strip them if host differ" $ redirectServerToDifferentHost (Just 1) $ \port -> do
+-        req' <- parseUrlThrow $ "http://127.0.0.1:" ++ show port
+-        let req = req' { requestHeaders = [(hAuthorization, "abguvatgbfrrurer")]
+-                       , redirectCount = 10
+-                       , shouldStripHeaderOnRedirect = (== hAuthorization)
+-                       , shouldStripHeaderOnRedirectIfOnDifferentHostOnly = True
+-                       }
+-        man <- newManager defaultManagerSettings
+-        withResponseHistory req man $ \hr -> do
+-          print $ map (requestHeaders . fst) $ hrRedirects hr
+-          mapM_ (\r -> requestHeaders r `shouldBe` []) $
+-            map fst $ tail $ hrRedirects hr
+-    it "does NOT strips header on redirect, if hosts are same and set to strip them if host differ" $ redirectServerToDifferentHost (Just 1) $ \port -> do
+-        req' <- parseUrlThrow $ "http://127.0.0.1:" ++ show port
+-        let req = req' { requestHeaders = [(hAuthorization, "abguvatgbfrrurer")]
+-                       , redirectCount = 10
+-                       , shouldStripHeaderOnRedirect = (== hAuthorization)
+-                       , shouldStripHeaderOnRedirectIfOnDifferentHostOnly = True
+-                       }
+-        man <- newManager defaultManagerSettings
+-        withResponseHistory req man $ \hr -> do
+-          print $ map (requestHeaders . fst) $ hrRedirects hr
+-          mapM_ (\r -> requestHeaders r `shouldBe` [("Authorization","abguvatgbfrrurer")]) $
+-            map fst $ tail $ hrRedirects hr
+     it "redirecting #41" $ redirectServer Nothing $ \port -> do
+         req' <- parseUrlThrow $ "http://127.0.0.1:" ++ show port
+         let req = req' { redirectCount = 1 }


=====================================
p/haskell-http-client/debian/patches/disable-external-network-connection-test.diff
=====================================
@@ -1,146 +1,13 @@
-Index: b/test/Network/HTTP/ClientSpec.hs
+
+Index: b/http-client.cabal
 ===================================================================
---- a/test/Network/HTTP/ClientSpec.hs
-+++ b/test/Network/HTTP/ClientSpec.hs
-@@ -17,140 +17,4 @@ main :: IO ()
- main = hspec spec
+--- a/http-client.cabal
++++ b/http-client.cabal
+@@ -83,6 +83,7 @@ library
+   default-language:    Haskell2010
  
- spec :: Spec
--spec = describe "Client" $ do
--    it "works" $ do
--        req <- parseUrlThrow "http://httpbin.org/"
--        man <- newManager defaultManagerSettings
--        res <- httpLbs req man
--        responseStatus res `shouldBe` status200
--
--    -- Test the failure condition described in https://github.com/snoyberg/http-client/issues/489
--    it "keeps connection alive long enough" $ do
--        req <- parseUrlThrow "http://httpbin.org/"
--        man <- newManager defaultManagerSettings
--        res <- responseOpen req man
--        responseStatus res `shouldBe` status200
--        let
--            getChunk = responseBody res
--            drainAll = do
--                chunk <- getChunk
--                if BS.null chunk then pure () else drainAll
--
--        -- The returned `BodyReader` used to not contain a reference to the `Managed Connection`,
--        -- only to the extracted connection and to the release action. Therefore, triggering a GC
--        -- would close the connection even though we were not done reading.
--        performGC
--        -- Not ideal, but weak finalizers run on a separate thread, so it's racing with our drain
--        -- call
--        threadDelay 500000
--
--        drainAll
--        -- Calling `responseClose res` here prevents the early collection from happening in this
--        -- test, but in a larger production application that did involve a `responseClose`, it still
--        -- occurred.
--
--    describe "method in URL" $ do
--        it "success" $ do
--            req <- parseUrlThrow "POST http://httpbin.org/post"
--            man <- newManager defaultManagerSettings
--            res <- httpLbs req man
--            responseStatus res `shouldBe` status200
--
--        it "failure" $ do
--            req <- parseRequest "PUT http://httpbin.org/post"
--            man <- newManager defaultManagerSettings
--            res <- httpLbs req man
--            responseStatus res `shouldBe` status405
--    describe "bearer auth" $ do
--        it "success" $ do
--            initialReq <- parseUrlThrow "http://httpbin.org/bearer"
--            let finalReq = applyBearerAuth "token" initialReq
--            man <- newManager defaultManagerSettings
--            res <- httpLbs finalReq man
--            responseStatus res `shouldBe` status200
--        it "failure" $ do
--            req <- parseRequest "http://httpbin.org/bearer"
--            man <- newManager defaultManagerSettings
--            res <- httpLbs req man
--            responseStatus res `shouldBe` status401
--
--    describe "redirects" $ do
--        xit "follows redirects" $ do
--            req <- parseRequest "http://httpbin.org/redirect-to?url=http://httpbin.org"
--            man <- newManager defaultManagerSettings
--            res <- httpLbs req man
--            responseStatus res `shouldBe` status200
--
--        xit "allows to disable redirect following" $ do
--            req <- (\ r -> r{ redirectCount = 0 }) <$>
--              parseRequest "http://httpbin.org/redirect-to?url=http://httpbin.org"
--            man <- newManager defaultManagerSettings
--            res <- httpLbs req man
--            responseStatus res `shouldBe` found302
--
--    context "managerModifyResponse" $ do
--      it "allows to modify the response status code" $ do
--        let modify :: Response BodyReader -> IO (Response BodyReader)
--            modify res = do
--              return res {
--                responseStatus = (responseStatus res) {
--                  statusCode = 201
--                }
--              }
--            settings = defaultManagerSettings { managerModifyResponse = modify }
--        man <- newManager settings
--        res <- httpLbs "http://httpbin.org" man
--        (statusCode.responseStatus) res `shouldBe` 201
--
--      it "modifies the response body" $ do
--        let modify :: Response BodyReader -> IO (Response BodyReader)
--            modify res = do
--              reader <- constBodyReader [BS.pack "modified response body"]
--              return res {
--                responseBody = reader
--              }
--            settings = defaultManagerSettings { managerModifyResponse = modify }
--        man <- newManager settings
--        res <- httpLbs "http://httpbin.org" man
--        responseBody res `shouldBe` "modified response body"
--
--    context "managerModifyRequest" $ do
--        it "port" $ do
--            let modify req = return req { port = 80 }
--                settings = defaultManagerSettings { managerModifyRequest = modify }
--            man <- newManager settings
--            res <- httpLbs "http://httpbin.org:1234" man
--            responseStatus res `shouldBe` status200
--
--        it "checkResponse" $ do
--            let modify req = return req { checkResponse = \_ _ -> error "some exception" }
--                settings = defaultManagerSettings { managerModifyRequest = modify }
--            man <- newManager settings
--            httpLbs "http://httpbin.org" man `shouldThrow` anyException
--
--        xit "redirectCount" $ do
--            let modify req = return req { redirectCount = 0 }
--                settings = defaultManagerSettings { managerModifyRequest = modify }
--            man <- newManager settings
--            response <- httpLbs "http://httpbin.org/redirect-to?url=foo" man
--            responseStatus response `shouldBe` found302
--
--    -- skipped because CI doesn't have working IPv6
--    xdescribe "raw IPV6 address as hostname" $ do
--        it "works" $ do
--            -- We rely on example.com serving a web page over IPv6.
--            -- The request (currently) actually ends up as 404 due to
--            -- virtual hosting, but we just care that the networking
--            -- side works.
--            (addr:_) <- NS.getAddrInfo
--                (Just NS.defaultHints { NS.addrFamily = NS.AF_INET6 })
--                (Just "example.com")
--                (Just "http")
--            -- ipv6Port will be of the form [::1]:80, which is good enough
--            -- for our purposes; ideally we'd easily get just the ::1.
--            let ipv6Port = show $ NS.addrAddress addr
--            ipv6Port `shouldStartWith` "["
--            req <- parseUrlThrow $ "http://" ++ ipv6Port
--            man <- newManager defaultManagerSettings
--            _ <- httpLbs (setRequestIgnoreStatus req) man
--            return ()
-+spec = return ()
+ test-suite spec
++  buildable: False
+   main-is:             Spec.hs
+   type:                exitcode-stdio-1.0
+   hs-source-dirs:      test


=====================================
p/haskell-http-client/debian/patches/series
=====================================
@@ -1 +1,2 @@
 disable-external-network-connection-test.diff
+disable-external-network-connection-test-2.diff



View it on GitLab: https://salsa.debian.org/haskell-team/DHG_packages/-/commit/fef8b84acbdf65b139ceaf224fb29c020489ffc7

-- 
View it on GitLab: https://salsa.debian.org/haskell-team/DHG_packages/-/commit/fef8b84acbdf65b139ceaf224fb29c020489ffc7
You're receiving this email because of your account on salsa.debian.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://alioth-lists.debian.net/pipermail/pkg-haskell-commits/attachments/20241013/0f7f62e4/attachment-0001.htm>


More information about the Pkg-haskell-commits mailing list