Fix for mirroring hackage

exes/MirrorClient.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
 module Main (main) where
 
 -- stdlib
@@ -212,8 +214,9 @@ mirrorPackage verbosity opts sourceRepo targetRepo pkginfo = do
             notifyResponse (GetPackageFailed theError pkgid)
           Nothing -> do
             notifyResponse GetPackageOk
-            liftIO $ sanitiseTarball verbosity (stateDir opts) locTgz
-            uploadPackage targetRepo (mirrorUploaders opts) pkginfo locCab locTgz
+            mirrorHandle (\(e :: SomeException) -> liftIO $ putStrLn $ "An error occurred: " <> show e) $ do
+              liftIO $ sanitiseTarball verbosity (stateDir opts) locTgz
+              uploadPackage targetRepo (mirrorUploaders opts) pkginfo locCab locTgz
 
     removeTempFiles :: MirrorSession ()
     removeTempFiles = liftIO $ handle ignoreDoesNotExist $ do

src/Distribution/Client/Mirror/Session.hs

@@ -19,6 +19,7 @@ module Distribution.Client.Mirror.Session (
   , Unlift(..)
   , askUnlift
   , mirrorFinally
+  , mirrorHandle
     -- * Errors
   , MirrorError(..)
   , Entity(..)
@@ -222,6 +223,11 @@ mirrorFinally a b = do
     run <- askUnlift
     liftIO $ unlift run a `finally` unlift run b
 
+mirrorHandle :: Exception e => (e -> MirrorSession a) -> MirrorSession a -> MirrorSession a
+mirrorHandle k m = do
+    run <- askUnlift
+    liftIO $ handle (\e -> unlift run $ k e) $ unlift run m
+
 mirrorAskHttpLib :: MirrorSession Sec.HttpLib
 mirrorAskHttpLib = MirrorSession $ do
     MirrorInternalEnv{..} <- ask