sprinkle log statements to pin point issue with chunked

src/Network/HTTP/Pool/ConnectionPool.idr

@@ -91,10 +91,13 @@ total_active_connections protocol manager = do
 
 close_worker : Worker e -> IO ()
 close_worker worker = do
-  -- putStrLn "closing \{show worker}"
+  putStrLn "closing \{show worker}"
   close worker.socket
+  putStrLn "Closed worker.socket"
   let f = \w => w.uuid /= worker.uuid
-  modifyIORef worker.parent.workers (filter f)
+  res <- modifyIORef worker.parent.workers (filter f)
+  putStrLn "Modified io ref"
+  pure res
 
 close_pool : {e : _} -> Condition -> Pool e -> IO ()
 close_pool cond pool = do
@@ -104,17 +107,19 @@ close_pool cond pool = do
   traverse_ (flip channelPut (Left ConnectionClosed) . response) remaining
 
   -- close all sockets
+  putStrLn ("Traversing close_worker")
   workers <- readIORef pool.workers
   traverse_ close_worker workers
 
   -- broadcast kill event
+  putStrLn ("Broadcasting kill \{show workers}")
   broadcast queue (Kill $ Just cond)
 
 wait_for_worker_close : {e : _} -> Mutex -> Condition -> List (Pool e) -> IO ()
 wait_for_worker_close mutex cond pools = do
   conditionWaitTimeout cond mutex 1000000
   workers <- traverse (\p => readIORef p.workers) pools
-  -- putStrLn "waiting for pool close: \{show workers}"
+  putStrLn "waiting for pool close: \{show workers}"
   if null (join workers) then pure () else wait_for_worker_close mutex cond pools
 
 has_idle_worker : Pool e -> IO Bool
@@ -144,6 +149,7 @@ spawn_worker fetcher throw cert_check protocol hostname pool = do
   0 <- connect sock (Hostname hostname.domain) (cast port)
   | err => throw $ SocketError "unable to connect to \{hostname_str}: \{show err}"
   let closer = close_worker worker
+  putStrLn "Running worker_handle"
   worker_handle sock idle_ref closer fetcher throw cert_check protocol hostname_str
 
 min_by : (ty -> ty -> Ordering) -> List1 ty -> ty
@@ -197,6 +203,7 @@ export
       pure ()
 
   evict_all manager = do
+    putStrLn "Evict all"
     pools <- readIORef manager.pools
     condition <- makeCondition
     mutex <- makeMutex

src/Network/HTTP/Pool/Worker.idr

@@ -54,9 +54,11 @@ worker_write handle remaining stream = do
   worker_write handle (remaining - should_take) rest
 
 worker_finish : Maybe ConnectionAction -> (1 _ : Handle' t_ok t_closed) -> L1 IO (LogicOkOrError t_ok t_closed)
-worker_finish (Just KeepAlive) handle =
+worker_finish (Just KeepAlive) handle = do
+  putStrLn "Keeping alive"
   pure1 (True # handle)
 worker_finish _ handle = do
+  putStrLn "Closing handle"
   handle <- close handle
   pure1 (False # handle)
 
@@ -154,12 +156,15 @@ worker_logic request handle = do
     liftIO1 $ throw (SocketError "error while reading response header: \{error}")
     pure1 (False # handle)
 
+  putStrLn "Hello you"
+
   let Right response = deserialize_http_response $ (ltrim line <+> "\n") -- for some reason the end line sometimes is not sent
   | Left err => do
     handle <- close handle
     liftIO1 $ throw (SocketError "error parsing http response headers: \{err}")
     pure1 (False # handle)
   let connection_action = lookup_header response.headers Connection
+  putStrLn "Hello you"
 
   channel <- liftIO1 (makeChannel {a=(Either (HttpError e) (Maybe (List Bits8)))})
   let schedule_response = MkScheduleResponse response channel
@@ -168,10 +173,15 @@ worker_logic request handle = do
   let encodings = join $ toList (forget <$> lookup_header response.headers TransferEncoding)
   if elem Chunked encodings
     then do
+      putStrLn "Chunked"
       (True # handle) <- worker_read_chunked handle channel
       | (False # handle) => pure1 (False # handle)
-      worker_finish connection_action handle
+      putStrLn "Chunked finished"
+      res <- worker_finish connection_action handle
+      putStrLn "worker_finish finished"
+      pure1 res
     else do
+      putStrLn "Non chunked"
       let Just content_length = lookup_header response.headers ContentLength
       | Nothing => do
         handle <- close handle
@@ -183,9 +193,11 @@ worker_logic request handle = do
 
 worker_loop : {e : _} -> IORef Bool -> IO () -> Queue (Event e) -> (1 _ : Handle' t_ok ()) -> L IO ()
 worker_loop idle_ref closer queue handle = do
+  putStrLn "worker_loop"
   liftIO1 $ writeIORef idle_ref True
   Request request <- liftIO1 $ recv queue
   | Kill condition => do
+    putStrLn "Received kill"
     close handle
     liftIO1 closer
     case condition of
@@ -202,9 +214,11 @@ worker_handle : {e : _} -> Socket -> IORef Bool -> IO () -> Queue (Event e) -> (
 worker_handle socket idle_ref closer fetcher throw cert_checker protocol hostname = LIO.run $ do
   let handle = socket_to_handle socket
   case protocol of
-    HTTP =>
+    HTTP => do
+      putStrLn "worker_handle::HTTP"
       worker_loop idle_ref closer fetcher handle
     HTTPS => do
+      putStrLn "worker_handle::HTTPS"
       (True # handle) <-
         tls_handshake hostname
           (X25519 ::: [SECP256r1, SECP384r1])
@@ -213,4 +227,5 @@ worker_handle socket idle_ref closer fetcher throw cert_checker protocol hostnam
           handle
           (cert_checker hostname)
       | (False # (err # ())) => liftIO1 $ throw $ SocketError "error during TLS handshake: \{err}"
+      putStrLn "worker_handle :: running worker_loop"
       worker_loop idle_ref closer fetcher handle

tests/src/ClientTest.idr

@@ -117,9 +117,11 @@ export
 test_chunked_transfer_encoding : EitherT String IO () 
 test_chunked_transfer_encoding = map_error show $ with_client {e=()} new_client_default $ \client => do
   putStrLn "sending request stream"
-  (response, content) <- request client GET (url' "https://httpbin.org/stream/2") [] ()
+  (response, content) <- request client GET (url' "https://httpbin.org/stream/3") [] ()
   putStrLn "response header received"
   printLn response
-  content <- toList_ content
-  putStrLn $ maybe "Nothing" id $ utf8_pack $ content
+  -- (content, _) <- toList content
+  -- putStrLn "println content"
+  -- printLn $ utf8_pack $ content
+  putStrLn "closing client"
   close client

tests/src/Test.idr

@@ -24,17 +24,17 @@ run tests = do
 
 export
 main : IO ()
-main = run
-  [ run_test "decompress random.bin.gz" test_gzip_uncompressed
-  , run_test "decompress hello.gz" test_gzip_fixed_huffman
-  , run_test "decompress jabberwock.txt.gz" test_gzip_text
-  , run_test "decompress jabberwocky.jpg.gz" test_gzip_jpg
-  , run_test "decompress concatenated.gz" test_gzip_concated
-  , run_test "http close w/out read" test_close_without_read
-  , run_test "http cookie jar" test_cookie
-  , run_test "http httpbin deflate" test_json_deflate
-  , run_test "http httpbin gzip" test_json_gzip
-  , run_test "http httpbin post" test_post
-  , run_test "http openbsd redirect" test_redirect
-  --, run_test "chunked transfer encoding" test_chunked_transfer_encoding
-  ]
+main = run 
+  [ --run_test "decompress random.bin.gz" test_gzip_uncompressed
+  -- , run_test "decompress hello.gz" test_gzip_fixed_huffman
+  -- , run_test "decompress jabberwock.txt.gz" test_gzip_text
+  -- , run_test "decompress jabberwocky.jpg.gz" test_gzip_jpg
+  -- , run_test "decompress concatenated.gz" test_gzip_concated
+  -- , run_test "http close w/out read" test_close_without_read
+  -- , run_test "http cookie jar" test_cookie
+  -- , run_test "http httpbin deflate" test_json_deflate
+  -- , run_test "http httpbin gzip" test_json_gzip
+  -- , run_test "http httpbin post" test_post
+  -- , run_test "http openbsd redirect" test_redirect
+   run_test "chunked transfer encoding" test_chunked_transfer_encoding
+ ]