Catch exceptions whilst trying to fetch metadata (#325)

The previous way was only handling the case where the metadata fetched
could not be correctly parsed. Now it will also disable the global
cache if the HTTP request fails for any reason.

src/Spago/GlobalCache.hs

@@ -100,16 +100,21 @@ getMetadata cacheFlag = do
         Nothing -> mempty
         Just a  -> a
 
-      downloadMeta = do
-        metaBS <- (Http.httpBS metaURL >>= pure . Http.getResponseBody)
-        case decodeStrict' metaBS of
-          Nothing -> do
+      downloadMeta = handleAny
+        (\err -> do
+            echoDebug $ "Metadata fetch failed with exception: " <> tshow err
             echo "WARNING: Unable to download GitHub metadata, global cache will be disabled"
-            pure mempty
-          Just meta -> do
-            assertDirectory globalCacheDir
-            liftIO $ BS.writeFile globalPathToMeta metaBS
-            pure meta
+            pure mempty)
+        (do
+            metaBS <- Http.getResponseBody `fmap` Http.httpBS metaURL
+            case decodeStrict' metaBS of
+              Nothing -> do
+                echo "WARNING: Unable to parse GitHub metadata, global cache will be disabled"
+                pure mempty
+              Just meta -> do
+                assertDirectory globalCacheDir
+                liftIO $ BS.writeFile globalPathToMeta metaBS
+                pure meta)
 
   case cacheFlag of
     -- If we need to skip the cache we just get an empty map
@@ -123,7 +128,7 @@ getMetadata cacheFlag = do
       echo "Searching for packages cache metadata.."
 
       -- Check if the metadata is in global cache and fresher than 1 day
-      shouldDownloadMeta <- try (liftIO $ do
+      shouldDownloadMeta <- tryIO (liftIO $ do
           fileExists <- testfile $ Turtle.decodeString globalPathToMeta
           lastModified <- getModificationTime globalPathToMeta
           now <- Time.getCurrentTime
@@ -132,7 +137,7 @@ getMetadata cacheFlag = do
           pure $ not (fileExists && fileIsRecentEnough)
           ) >>= \case
         Right v -> pure v
-        Left (err :: IOException) -> do
+        Left err -> do
           echoDebug $ "Unable to read metadata file. Error was: " <> tshow err
           pure True
 

src/Spago/Prelude.hs

@@ -47,6 +47,7 @@ module Spago.Prelude
   , pathSeparator
   , headMay
   , for
+  , handleAny
   , try
   , tryIO
   , makeAbsolute
@@ -106,7 +107,7 @@ import           Turtle                        (ExitCode (..), FilePath, appendo
                                                 systemStrictWithErr, testdir, testfile)
 import           UnliftIO                      (MonadUnliftIO, withRunInIO)
 import           UnliftIO.Directory            (getModificationTime, makeAbsolute)
-import           UnliftIO.Exception            (IOException, try, tryIO)
+import           UnliftIO.Exception            (IOException, handleAny, try, tryIO)
 import           UnliftIO.Process              (callCommand)
 
 -- | Generic Error that we throw on program exit.