From b62e07c6b49d0f191883213aba7d28105df39c6b Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Mon, 21 Nov 2022 18:31:06 +0100 Subject: [PATCH] Add detail to error message --- services/galley/src/Galley/API/MLS/Message.hs | 8 ++++---- services/galley/src/Galley/Effects/BrigAccess.hs | 2 +- services/galley/src/Galley/Intra/Client.hs | 10 +++++++--- 3 files changed, 12 insertions(+), 8 deletions(-) diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index 078029a2bb..320ed554f3 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -695,14 +695,14 @@ processExternalCommit qusr mSenderClient lconv cm epoch groupId action updatePat & note (mlsProtocolError "An invalid key package in the update path") -- validate and update mapping in brig - mCid <- + eithCid <- nkpresClientIdentity <$$> validateAndAddKeyPackageRef NewKeyPackage { nkpConversation = Data.convId <$> qUntagged lconv, nkpKeyPackage = KeyPackageData (rmRaw newKeyPackage) } - cid <- mCid & note (mlsProtocolError "Tried to add invalid KeyPackage") + cid <- either (\errMsg -> throw (mlsProtocolError ("Tried to add invalid KeyPackage: " <> errMsg))) pure eithCid unless (cidQualifiedUser cid == qusr) $ throw . mlsProtocolError $ @@ -968,14 +968,14 @@ applyProposal convId (AddProposal kp) = do addKeyPackageMapping :: Local ConvId -> KeyPackageRef -> KeyPackageData -> Sem r ClientIdentity addKeyPackageMapping lconv ref kpdata = do -- validate and update mapping in brig - mCid <- + eithCid <- nkpresClientIdentity <$$> validateAndAddKeyPackageRef NewKeyPackage { nkpConversation = qUntagged lconv, nkpKeyPackage = kpdata } - cid <- mCid & note (mlsProtocolError "Tried to add invalid KeyPackage") + cid <- either (\errMsg -> throw (mlsProtocolError ("Tried to add invalid KeyPackage: " <> errMsg))) pure eithCid let qcid = cidQualifiedClient cid let qusr = fst <$> qcid -- update mapping in galley diff --git a/services/galley/src/Galley/Effects/BrigAccess.hs b/services/galley/src/Galley/Effects/BrigAccess.hs index 5257a591f7..570672a0b9 100644 --- a/services/galley/src/Galley/Effects/BrigAccess.hs +++ b/services/galley/src/Galley/Effects/BrigAccess.hs @@ -132,7 +132,7 @@ data BrigAccess m a where GetClientByKeyPackageRef :: KeyPackageRef -> BrigAccess m (Maybe ClientIdentity) GetLocalMLSClients :: Local UserId -> SignatureSchemeTag -> BrigAccess m (Set ClientInfo) AddKeyPackageRef :: KeyPackageRef -> Qualified UserId -> ClientId -> Qualified ConvId -> BrigAccess m () - ValidateAndAddKeyPackageRef :: NewKeyPackage -> BrigAccess m (Maybe NewKeyPackageResult) + ValidateAndAddKeyPackageRef :: NewKeyPackage -> BrigAccess m (Either Text NewKeyPackageResult) UpdateKeyPackageRef :: KeyPackageUpdate -> BrigAccess m () UpdateSearchVisibilityInbound :: Multi.TeamStatus SearchVisibilityInboundConfig -> diff --git a/services/galley/src/Galley/Intra/Client.hs b/services/galley/src/Galley/Intra/Client.hs index d21233576b..80caf13870 100644 --- a/services/galley/src/Galley/Intra/Client.hs +++ b/services/galley/src/Galley/Intra/Client.hs @@ -41,6 +41,7 @@ import Data.Misc import Data.Qualified import qualified Data.Set as Set import Data.Text.Encoding +import Data.Text.Lazy (toStrict) import Galley.API.Error import Galley.Effects import Galley.Env @@ -53,6 +54,7 @@ import qualified Network.HTTP.Types as HTTP import Network.HTTP.Types.Method import Network.HTTP.Types.Status import Network.Wai.Utilities.Error hiding (Error) +import qualified Network.Wai.Utilities.Error as Error import Polysemy import Polysemy.Error import Polysemy.Input @@ -227,7 +229,7 @@ updateKeyPackageRef keyPackageRef = . expect2xx ) -validateAndAddKeyPackageRef :: NewKeyPackage -> App (Maybe NewKeyPackageResult) +validateAndAddKeyPackageRef :: NewKeyPackage -> App (Either Text NewKeyPackageResult) validateAndAddKeyPackageRef nkp = do res <- call @@ -238,6 +240,8 @@ validateAndAddKeyPackageRef nkp = do ) let statusCode = HTTP.statusCode (Rq.responseStatus res) if - | statusCode `div` 100 == 2 -> Just <$> parseResponse (mkError status502 "server-error") res - | statusCode `div` 100 == 4 -> pure Nothing + | statusCode `div` 100 == 2 -> Right <$> parseResponse (mkError status502 "server-error") res + | statusCode `div` 100 == 4 -> do + err <- parseResponse (mkError status502 "server-error") res + pure (Left ("Error validating keypackage: " <> toStrict (Error.label err) <> ": " <> toStrict (Error.message err))) | otherwise -> throwM (mkError status502 "server-error" "Unexpected http status returned from /i/mls/key-packages/add")