Handle curl failure

app/Foliage/PrepareSource.hs

@@ -23,9 +23,16 @@ import System.Directory qualified as IO
 import System.FilePath ((<.>), (</>))
 
 data PrepareSourceRule = PrepareSourceRule PackageId PackageVersionSpec
-  deriving (Show, Eq, Generic)
+  deriving (Eq, Generic)
   deriving (Hashable, Binary, NFData)
 
+instance Show PrepareSourceRule where
+  show (PrepareSourceRule pkgId pkgSpec) =
+    "prepareSource "
+      ++ prettyShow pkgId
+      ++ " "
+      ++ show pkgSpec
+
 type instance RuleResult PrepareSourceRule = FilePath
 
 prepareSource :: PackageId -> PackageVersionSpec -> Action FilePath

app/Foliage/RemoteAsset.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE TypeFamilies #-}
 
@@ -8,6 +9,7 @@ module Foliage.RemoteAsset
 where
 
 import Control.Monad
+import Data.Aeson qualified as Aeson
 import Data.ByteString qualified as BS
 import Data.Char (isAlpha)
 import Data.List (dropWhileEnd)
@@ -16,14 +18,19 @@ import Development.Shake
 import Development.Shake.Classes
 import Development.Shake.FilePath
 import Development.Shake.Rule
+import GHC.Generics (Generic)
 import Network.URI (URI (..), URIAuth (..), pathSegments)
 import Network.URI.Orphans ()
 import System.Directory (createDirectoryIfMissing)
+import System.Exit (ExitCode (..))
 
 newtype RemoteAsset = RemoteAsset URI
-  deriving (Show, Eq)
+  deriving (Eq)
   deriving (Hashable, Binary, NFData) via URI
 
+instance Show RemoteAsset where
+  show (RemoteAsset uri) = "fetchRemoteAsset " ++ show uri
+
 type instance RuleResult RemoteAsset = FilePath
 
 fetchRemoteAsset :: URI -> Action FilePath
@@ -50,11 +57,61 @@ addFetchRemoteAssetRule cacheDir = addBuiltinRule noLint noIdentity run
       let oldETag = fromMaybe BS.empty old
 
       newETag <-
-        withTempFile $ \fp -> traced "curl" $ do
-          BS.writeFile fp oldETag
-          createDirectoryIfMissing True (takeDirectory path)
-          cmd_ Shell ["curl", "--silent", "--location", "--etag-compare", fp, "--etag-save", fp, "--output", path, show uri]
-          BS.readFile fp
+        withTempFile $ \etagFile -> do
+          liftIO $ BS.writeFile etagFile oldETag
+          liftIO $ createDirectoryIfMissing True (takeDirectory path)
+          (Exit exitCode, Stdout out) <-
+            traced "curl" $
+              cmd
+                Shell
+                [ "curl",
+                  -- Silent or quiet mode. Do not show progress meter or error messages. Makes Curl mute.
+                  "--silent",
+                  -- Fail fast with no output at all on server errors.
+                  "--fail",
+                  -- If the server reports that the requested page has moved to a different location this
+                  -- option will make curl redo the request on the new place.
+                  -- NOTE: This is needed because github always replies with a redirect
+                  "--location",
+                  -- This  option  makes  a conditional HTTP request for the specific ETag read from the
+                  -- given file by sending a custom If-None-Match header using the stored ETag.
+                  -- For correct results, make sure that the specified file contains only a single line
+                  -- with the desired ETag. An empty file is parsed as an empty ETag.
+                  "--etag-compare",
+                  etagFile,
+                  -- This option saves an HTTP ETag to the specified file. If no ETag is sent by the server,
+                  -- an empty file is created.
+                  "--etag-save",
+                  etagFile,
+                  -- Write output to <file> instead of stdout.
+                  "--output",
+                  path,
+                  "--write-out",
+                  "%{json}",
+                  -- URL to fetch
+                  show uri
+                ]
+          case exitCode of
+            ExitSuccess -> liftIO $ BS.readFile etagFile
+            ExitFailure c -> do
+              -- We show the curl exit code only if we cannot parse curl's write-out.
+              -- If we can parse it, we can craft a better error message.
+              case Aeson.eitherDecode out :: Either String CurlWriteOut of
+                Left err ->
+                  error $
+                    unlines
+                      [ "curl failed with return code " ++ show c ++ " while fetching " ++ show uri,
+                        "Error while reading curl diagnostic: " ++ err
+                      ]
+                -- We can consider displaying different messages based on some fields (e.g. response_code)
+                Right CurlWriteOut {errormsg} ->
+                  error errormsg
 
       let changed = if newETag == oldETag then ChangedRecomputeSame else ChangedRecomputeDiff
       return $ RunResult {runChanged = changed, runStore = newETag, runValue = path}
+
+-- Add what you need. See https://everything.curl.dev/usingcurl/verbose/writeout.
+newtype CurlWriteOut = CurlWriteOut
+  {errormsg :: String}
+  deriving (Show, Generic)
+  deriving anyclass (Aeson.FromJSON)

flake.nix

@@ -72,13 +72,9 @@
   nixConfig = {
     extra-substituters = [
       "https://cache.iog.io"
-      "https://foliage.cachix.org"
-      "https://cache.zw3rk.com"
     ];
     extra-trusted-public-keys = [
       "hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ="
-      "foliage.cachix.org-1:kAFyYLnk8JcRURWReWZCatM9v3Rk24F5wNMpEj14Q/g="
-      "loony-tools:pr9m4BkM/5/eSTZlkQyRt57Jz7OMBxNSUiMC4FkcNfk="
     ];
   };
 }