From 7079c70484dd66b53878339b4c773a26341e2a23 Mon Sep 17 00:00:00 2001
From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Date: Fri, 21 Apr 2023 21:07:38 +0400
Subject: [PATCH] xftp: fix permanent error reported as temporary from http
 client - logs

---
 src/Simplex/FileTransfer/Agent.hs               |  3 +++
 src/Simplex/Messaging/Transport/HTTP2/Client.hs | 15 +++++++++------
 2 files changed, 12 insertions(+), 6 deletions(-)

diff --git a/src/Simplex/FileTransfer/Agent.hs b/src/Simplex/FileTransfer/Agent.hs
index 11681d7b9..61ac492a7 100644
--- a/src/Simplex/FileTransfer/Agent.hs
+++ b/src/Simplex/FileTransfer/Agent.hs
@@ -390,6 +390,8 @@ runXFTPSndPrepareWorker c doWork = do
           else pure sndFile
       maxRecipients <- asks (xftpMaxRecipientsPerRequest . config)
       let numRecipients' = min numRecipients maxRecipients
+      liftIO $ print "finished encrypting"
+      threadDelay 30000000
       -- concurrently?
       forM_ (filter (not . chunkCreated) chunks) $ createChunk numRecipients'
       withStore' c $ \db -> updateSndFileStatus db sndFileId SFSUploading
@@ -463,6 +465,7 @@ runXFTPSndWorker c srv doWork = do
               `catchError` \e -> retryOnError "XFTP snd worker" (retryLoop loop e delay') (retryDone e) e
           where
             retryLoop loop e replicaDelay = do
+              liftIO $ print $ "replica " <> show sndChunkReplicaId <> " temporary error"
               flip catchError (\_ -> pure ()) $ do
                 notifyOnRetry <- asks (xftpNotifyErrsOnRetry . config)
                 when notifyOnRetry $ notify c sndFileEntityId $ SFERR e
diff --git a/src/Simplex/Messaging/Transport/HTTP2/Client.hs b/src/Simplex/Messaging/Transport/HTTP2/Client.hs
index 66d88f6c9..90b036b6d 100644
--- a/src/Simplex/Messaging/Transport/HTTP2/Client.hs
+++ b/src/Simplex/Messaging/Transport/HTTP2/Client.hs
@@ -108,16 +108,19 @@ getVerifiedHTTP2Client proxyUsername host port keyHash caStore config@HTTP2Clien
       atomically $ do
         writeTVar (connected c) True
         putTMVar cVar (Right c')
-      process c' sendReq `E.finally` disconnected
+      process c' sendReq `E.finally` (putStrLn "process error" >> disconnected)
 
     process :: HTTP2Client -> H.Client HTTP2Response
     process HTTP2Client {client_ = HClient {reqQ}} sendReq = forever $ do
       (req, respVar) <- atomically $ readTBQueue reqQ
-      sendReq req $ \r -> do
-        respBody <- getHTTP2Body r bodyHeadSize
-        let resp = HTTP2Response {response = r, respBody}
-        atomically $ putTMVar respVar resp
-        pure resp
+      do
+        ( sendReq req $ \r -> do
+            respBody <- getHTTP2Body r bodyHeadSize
+            let resp = HTTP2Response {response = r, respBody}
+            atomically $ putTMVar respVar resp
+            pure resp
+          )
+          `E.finally` print "sendReq error"
 
 -- | Disconnects client from the server and terminates client threads.
 closeHTTP2Client :: HTTP2Client -> IO ()