Fix incomplete-record-updates warnings (#1059)

Author: jhrcek

src/Distribution/Server/Features/Users.hs

@@ -495,7 +495,9 @@ userFeature templates usersState adminsState
           overrideResponse <- msum <$> runHook authFailHook err
           let resp' = fromMaybe defaultResponse overrideResponse
               -- reset authn to "0" on auth failures
-              resp'' = resp' { errorHeaders = ("Set-Cookie","authn=\"0\";Path=/;Version=\"1\""):errorHeaders resp' }
+              resp'' = case resp' of
+                r@ErrorResponse{} -> r { errorHeaders = ("Set-Cookie","authn=\"0\";Path=/;Version=\"1\""):errorHeaders r }
+                GenericErrorResponse -> GenericErrorResponse
           throwError resp''
 
     -- Check if there is an authenticated userid, and return info, if so.

src/Distribution/Server/Framework/Auth.hs

@@ -3,7 +3,7 @@
 -- We authenticate clients using HTTP Basic or Digest authentication and we
 -- authorise users based on membership of particular user groups.
 --
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE LambdaCase, PatternGuards #-}
 module Distribution.Server.Framework.Auth (
     -- * Checking authorisation
     guardAuthorised,
@@ -428,26 +428,29 @@ data AuthError = NoAuthError
 
 authErrorResponse :: MonadIO m => RealmName -> AuthError -> m ErrorResponse
 authErrorResponse realm autherr = do
-    digestHeader   <- liftIO (headerDigestAuthChallenge realm)
-    return $! (toErrorResponse autherr) { errorHeaders = [digestHeader] }
-  where
-    toErrorResponse :: AuthError -> ErrorResponse
-    toErrorResponse NoAuthError =
-      ErrorResponse 401 [] "No authorization provided" []
-
-    toErrorResponse UnrecognizedAuthError =
-      ErrorResponse 400 [] "Authorization scheme not recognized" []
-
-    toErrorResponse InsecureAuthError =
-      ErrorResponse 400 [] "Authorization scheme not allowed over plain http"
-        [ MText $ "HTTP Basic and X-ApiKey authorization methods leak "
-               ++ "information when used over plain HTTP. Either use HTTPS "
-               ++ "or if you must use plain HTTP for authorised requests then "
-               ++ "use HTTP Digest authentication." ]
-
-    toErrorResponse BadApiKeyError =
-      ErrorResponse 401 [] "Bad auth token" []
-
-    -- we don't want to leak info for the other cases, so same message for them all:
-    toErrorResponse _ =
-      ErrorResponse 401 [] "Username or password incorrect" []
+    digestHeader <- liftIO (headerDigestAuthChallenge realm)
+
+    let
+      toErrorResponse :: AuthError -> ErrorResponse
+      toErrorResponse = \case
+        NoAuthError ->
+          ErrorResponse 401 [digestHeader] "No authorization provided" []
+
+        UnrecognizedAuthError ->
+          ErrorResponse 400 [digestHeader] "Authorization scheme not recognized" []
+
+        InsecureAuthError ->
+          ErrorResponse 400 [digestHeader] "Authorization scheme not allowed over plain http"
+            [ MText $ "HTTP Basic and X-ApiKey authorization methods leak "
+                   ++ "information when used over plain HTTP. Either use HTTPS "
+                   ++ "or if you must use plain HTTP for authorised requests then "
+                   ++ "use HTTP Digest authentication." ]
+
+        BadApiKeyError ->
+          ErrorResponse 401 [digestHeader] "Bad auth token" []
+
+        -- we don't want to leak info for the other cases, so same message for them all:
+        _ ->
+          ErrorResponse 401 [digestHeader] "Username or password incorrect" []
+
+    return $! toErrorResponse autherr

src/Distribution/Server/Framework/HappstackUtils.hs

@@ -215,7 +215,8 @@ enableRange = do
     -- awkward; we'd have to parse the original Content-Length header to find
     -- out the original length.
     rangeFilter :: (Int64, Int64) -> Response -> Response
-    rangeFilter (fr, to) r =
+    rangeFilter _ r@SendFile{} = r
+    rangeFilter (fr, to) r@Response{} =
         setHeader "Content-Length" (show rangeLen)
       . setHeaderBS (BS.C8.pack "Content-Range") (contentRange fr to fullLen)
       . removeResponseHeader "Content-MD5"