catch exceptions in eg, tor socket setup

Socks can throw exceptions at connection time, and these are not caught
by the ExceptT, so catch at a higher level, and catch all exceptions to
prevent the client crashing.

1 files changed, 9 insertions, 1 deletions

diff --git a/HTTP/Client.hs b/HTTP/Client.hs
index b582fe7..48a430c 100644
--- a/HTTP/Client.hs
+++ b/HTTP/Client.hs
@@ -19,6 +19,7 @@ import Network.Wai.Handler.Warp (Port)
 import Network.HTTP.Client hiding (port, host, Proxy)
 import Network.HTTP.Client.Internal (Connection, makeConnection)
 import Control.Monad.Trans.Except (ExceptT, runExceptT)
+import Control.Exception
 import qualified Network.Socket
 import Network.Socket.ByteString (sendAll, recv)
 import Network.Socks5
@@ -35,6 +36,9 @@ putObject :: StorableObjectIdent -> Maybe ProofOfWork -> StorableObject -> Manag
 countObjects :: Maybe ProofOfWork -> Manager -> BaseUrl -> ClientM (POWGuarded CountResult)
 motd :<|> getObject :<|> putObject :<|> countObjects = client httpAPI
 
+tryA :: IO a -> IO (Either SomeException a)
+tryA = try
+
 serverRequest
 	:: POWIdent p
 	=> Server
@@ -43,7 +47,11 @@ serverRequest
 	-> p
 	-> (Maybe ProofOfWork -> Manager -> BaseUrl -> ExceptT ServantError IO (POWGuarded r))
 	-> IO a
-serverRequest srv onerr onsuccess p a = go Nothing maxProofOfWork
+serverRequest srv onerr onsuccess p a = do
+	r <- tryA $ go Nothing maxProofOfWork
+	case r of
+		Left e -> return $ onerr (show e)
+		Right v -> return v
   where
 	go pow (Seconds timeleft)
 		| timeleft <= 0 = return $ onerr "server asked for too much proof of work; gave up"