Add error logging to Sync uploads

Author: ChrisPenner

src/Share/Utils/Logging.hs

@@ -244,3 +244,26 @@ ioLogger handle formatter msg = liftIO do
 
 instance Loggable Sync.EntityValidationError where
   toLog = withSeverity Error . showLog
+
+instance Loggable Sync.HashMismatchForEntity where
+  toLog = withSeverity Error . showLog
+
+instance Loggable Sync.UploadEntitiesError where
+  toLog = \case
+    Sync.UploadEntitiesError'EntityValidationFailure err -> toLog err
+    Sync.UploadEntitiesError'HashMismatchForEntity mismatch -> toLog mismatch
+    Sync.UploadEntitiesError'InvalidRepoInfo msg repoInfo ->
+      textLog ("Invalid repo info: " <> msg <> " RepoInfo: " <> tShow repoInfo)
+        & withSeverity Error
+    Sync.UploadEntitiesError'NeedDependencies nd ->
+      textLog ("Need dependencies: " <> tShow nd)
+        & withSeverity Error
+    Sync.UploadEntitiesError'NoWritePermission repoInfo ->
+      textLog ("No write permission for repo: " <> tShow repoInfo)
+        & withSeverity UserFault
+    Sync.UploadEntitiesError'ProjectNotFound projectShorthand ->
+      textLog ("Project not found: " <> projectShorthand)
+        & withSeverity UserFault
+    Sync.UploadEntitiesError'UserNotFound userHandle ->
+      textLog ("User not found: " <> userHandle)
+        & withSeverity UserFault

src/Share/Web/Errors.hs

@@ -404,9 +404,25 @@ throwSomeServerError = throwError . SomeServerError . withCallstack
 
 -- Instances from unison types.
 
+
 instance ToServerError Sync.EntityValidationError where
   toServerError = \case
     Sync.EntityHashMismatch {} -> ("entity-hash-mismatch", err500)
     Sync.UnsupportedEntityType {} -> ("unsupported-entity-type", err500)
     Sync.InvalidByteEncoding {} -> ("invalid-byte-encoding", err500)
     Sync.HashResolutionFailure {} -> ("hash-resolution-failure", err500)
+
+instance ToServerError Sync.HashMismatchForEntity where
+  toServerError _ = ("hash-mismatch-for-entity", err400 {errBody = "Hash Mismatch for Entity"})
+
+instance ToServerError Sync.UploadEntitiesError where
+  toServerError = \case
+    Sync.UploadEntitiesError'EntityValidationFailure err -> toServerError err
+    Sync.UploadEntitiesError'HashMismatchForEntity mismatch -> toServerError mismatch
+    Sync.UploadEntitiesError'InvalidRepoInfo _ _ -> ("invalid-repo-info", err400 {errBody = "Invalid Repo Info"})
+    Sync.UploadEntitiesError'NeedDependencies _ -> ("need-dependencies", err400 {errBody = "Need Dependencies"})
+    Sync.UploadEntitiesError'NoWritePermission _ -> ("no-write-permission", err403 {errBody = "No Write Permission"})
+    Sync.UploadEntitiesError'ProjectNotFound _ -> ("project-not-found", err404 {errBody = "Project Not Found"})
+    Sync.UploadEntitiesError'UserNotFound _ -> ("user-not-found", err404 {errBody = "User Not Found"})
+
+

src/Share/Web/UCM/Sync/Impl.hs

@@ -189,7 +189,7 @@ downloadEntitiesEndpoint mayUserId DownloadEntitiesRequest {repoInfo, hashes = h
 
 uploadEntitiesEndpoint :: UserId -> UploadEntitiesRequest -> WebApp UploadEntitiesResponse
 uploadEntitiesEndpoint callingUserId (UploadEntitiesRequest {repoInfo, entities}) = do
-  either id id <$> runExceptT do
+  finalizeResponse =<< runExceptT do
     addRequestTag "repo-info" (unRepoInfo repoInfo)
     codebase <-
       case repoInfoKind repoInfo of
@@ -224,6 +224,14 @@ uploadEntitiesEndpoint callingUserId (UploadEntitiesRequest {repoInfo, entities}
         Right Nothing -> UploadEntitiesSuccess
         -- There were missing dependencies, so we need to ask the client for them.
         Right (Just missingDeps) -> UploadEntitiesFailure $ Share.UploadEntitiesError'NeedDependencies (NeedDependencies missingDeps)
+  where
+    finalizeResponse :: Either UploadEntitiesResponse UploadEntitiesResponse -> WebApp UploadEntitiesResponse
+    finalizeResponse result = case either id id result of
+      success@(UploadEntitiesSuccess) -> pure success
+      failure@(UploadEntitiesFailure err) -> do
+        -- Report the error, but return it to the client as well.
+        reportError err
+        pure failure
 
 -- | Insert entities to the user's codebase (either temp storage or main), returning the hashes of any missing dependencies
 -- we still need from the client.