From 480340f4f244a3691750c4cbe72d7b283d63ae9e Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Mon, 31 May 2021 14:21:47 +0200 Subject: [PATCH] Move post otr message endpoint to servant The tests are not enough, they don't test lists being sent to ignore_missing and report_missing --- libs/wire-api/src/Wire/API/Message.hs | 92 +++++++---------- .../src/Wire/API/Routes/Public/Galley.hs | 99 ++++++++++++++++++- libs/wire-api/src/Wire/API/User/Client.hs | 35 +++---- .../Golden/Generated/ClientMismatch_user.hs | 41 ++++---- services/galley/src/Galley/API/Public.hs | 42 +------- services/galley/src/Galley/API/Update.hs | 31 +++--- 6 files changed, 190 insertions(+), 150 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Message.hs b/libs/wire-api/src/Wire/API/Message.hs index 73b9b907da6..d11c87c4c9f 100644 --- a/libs/wire-api/src/Wire/API/Message.hs +++ b/libs/wire-api/src/Wire/API/Message.hs @@ -42,11 +42,12 @@ module Wire.API.Message ) where -import Data.Aeson +import qualified Data.Aeson as A import Data.Id import Data.Json.Util +import Data.Schema +import qualified Data.Swagger as S import qualified Data.Swagger.Build.Api as Doc -import Data.Time import Imports import Wire.API.Arbitrary (Arbitrary (..), GenericUniform (..)) import Wire.API.User.Client (UserClientMap (..), UserClients (..), modelOtrClientMap, modelUserClients) @@ -69,6 +70,7 @@ data NewOtrMessage = NewOtrMessage } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform NewOtrMessage) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via (Schema NewOtrMessage) modelNewOtrMessage :: Doc.Model modelNewOtrMessage = Doc.defineModel "NewOtrMessage" $ do @@ -95,28 +97,17 @@ modelNewOtrMessage = Doc.defineModel "NewOtrMessage" $ do Doc.description "List of user IDs" Doc.optional -instance ToJSON NewOtrMessage where - toJSON otr = - object $ - "sender" .= newOtrSender otr - # "recipients" .= newOtrRecipients otr - # "native_push" .= newOtrNativePush otr - # "transient" .= newOtrTransient otr - # "native_priority" .= newOtrNativePriority otr - # "data" .= newOtrData otr - # "report_missing" .= newOtrReportMissing otr - # [] - -instance FromJSON NewOtrMessage where - parseJSON = withObject "new-otr-message" $ \o -> - NewOtrMessage - <$> o .: "sender" - <*> o .: "recipients" - <*> o .:? "native_push" .!= True - <*> o .:? "transient" .!= False - <*> o .:? "native_priority" - <*> o .:? "data" - <*> o .:? "report_missing" +instance ToSchema NewOtrMessage where + schema = + object "new-otr-message" $ + NewOtrMessage + <$> newOtrSender .= field "sender" schema + <*> newOtrRecipients .= field "recipients" schema + <*> newOtrNativePush .= (field "native_push" schema <|> pure True) + <*> newOtrTransient .= (field "transient" schema <|> pure False) + <*> newOtrNativePriority .= opt (field "native_priority" schema) + <*> newOtrData .= opt (field "data" schema) + <*> newOtrReportMissing .= opt (field "report_missing" (array schema)) -------------------------------------------------------------------------------- -- Priority @@ -134,6 +125,7 @@ instance FromJSON NewOtrMessage where data Priority = LowPriority | HighPriority deriving stock (Eq, Show, Ord, Enum, Generic) deriving (Arbitrary) via (GenericUniform Priority) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema Priority typePriority :: Doc.DataType typePriority = @@ -143,15 +135,13 @@ typePriority = "high" ] -instance ToJSON Priority where - toJSON LowPriority = String "low" - toJSON HighPriority = String "high" - -instance FromJSON Priority where - parseJSON = withText "Priority" $ \case - "low" -> pure LowPriority - "high" -> pure HighPriority - x -> fail $ "Invalid push priority: " ++ show x +instance ToSchema Priority where + schema = + enum @Text "Priority" $ + mconcat + [ element "low" LowPriority, + element "high" HighPriority + ] -------------------------------------------------------------------------------- -- Recipients @@ -161,7 +151,7 @@ newtype OtrRecipients = OtrRecipients { otrRecipientsMap :: UserClientMap Text } deriving stock (Eq, Show) - deriving newtype (ToJSON, FromJSON, Semigroup, Monoid, Arbitrary) + deriving newtype (ToSchema, A.ToJSON, A.FromJSON, Semigroup, Monoid, Arbitrary) -- FUTUREWORK: Remove when 'NewOtrMessage' has ToSchema modelOtrRecipients :: Doc.Model @@ -189,8 +179,11 @@ data OtrFilterMissing deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform OtrFilterMissing) +-- TODO: Verify if the change from UTCTime to UTCTimeMillis has any significant +-- effect. The ToJSON instance was already translating it to millis and fromJSON +-- didn't care for it (as it is never being sent by clients) data ClientMismatch = ClientMismatch - { cmismatchTime :: UTCTime, + { cmismatchTime :: UTCTimeMillis, -- | Clients that the message /should/ have been encrypted for, but wasn't. missingClients :: UserClients, -- | Clients that the message /should not/ have been encrypted for, but was. @@ -198,13 +191,12 @@ data ClientMismatch = ClientMismatch deletedClients :: UserClients } deriving stock (Eq, Show, Generic) + deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema ClientMismatch instance Arbitrary ClientMismatch where arbitrary = ClientMismatch - <$> (milli <$> arbitrary) <*> arbitrary <*> arbitrary <*> arbitrary - where - milli = fromUTCTimeMillis . toUTCTimeMillis + <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary modelClientMismatch :: Doc.Model modelClientMismatch = Doc.defineModel "ClientMismatch" $ do @@ -218,19 +210,11 @@ modelClientMismatch = Doc.defineModel "ClientMismatch" $ do Doc.property "deleted" (Doc.ref modelUserClients) $ Doc.description "Map of deleted clients per user." -instance ToJSON ClientMismatch where - toJSON m = - object - [ "time" .= toUTCTimeMillis (cmismatchTime m), - "missing" .= missingClients m, - "redundant" .= redundantClients m, - "deleted" .= deletedClients m - ] - -instance FromJSON ClientMismatch where - parseJSON = withObject "ClientMismatch" $ \o -> - ClientMismatch - <$> o .: "time" - <*> o .: "missing" - <*> o .: "redundant" - <*> o .: "deleted" +instance ToSchema ClientMismatch where + schema = + object "ClientMismatch" $ + ClientMismatch + <$> cmismatchTime .= field "time" schema + <*> missingClients .= field "missing" schema + <*> redundantClients .= field "redundant" schema + <*> deletedClients .= field "deleted" schema diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs index 873efaf5807..376cfc0d4fe 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -21,8 +21,9 @@ module Wire.API.Routes.Public.Galley where import Data.CommaSeparatedList -import Data.Id (ConvId, TeamId) +import Data.Id (ConvId, TeamId, UserId) import Data.Range +import qualified Data.Set as Set import Data.Swagger import Imports hiding (head) import Servant hiding (Handler, JSON, addHeader, contentType, respond) @@ -34,6 +35,7 @@ import qualified Wire.API.Conversation as Public import qualified Wire.API.Conversation.Role as Public import qualified Wire.API.Event.Conversation as Public import qualified Wire.API.Event.Team as Public () +import qualified Wire.API.Message as Public import Wire.API.Routes.Public (EmptyResult, ZConn, ZUser) import qualified Wire.API.Team.Conversation as Public @@ -47,6 +49,11 @@ type UpdateResponses = NoContent ] +type PostOtrResponses = + '[ WithStatus 201 Public.ClientMismatch, + WithStatus 412 Public.ClientMismatch + ] + -- FUTUREWORK: Make a PR to the servant-swagger package with this instance instance ToSchema Servant.NoContent where declareNamedSchema _ = declareNamedSchema (Proxy @()) @@ -205,11 +212,99 @@ data Api routes = Api :> Capture "tid" TeamId :> "conversations" :> Capture "cid" ConvId - :> Delete '[] (EmptyResult 200) + :> Delete '[] (EmptyResult 200), + -- | This endpoint can lead to the following events being sent: + -- + -- - OtrMessageAdd event to recipients + -- + -- TODO: Add 404 for conv not found + -- TODO: Add 403 for unknown sending client + postOtrMessage :: + routes + :- Summary "Post an encrypted message to a conversation (accepts JSON)" + :> ZUser + :> ZConn + :> "conversations" + :> Capture "cnv" ConvId + :> QueryParam "ignore_missing" IgnoreMissing + :> QueryParam "report_missing" ReportMissing + :> "otr" + :> "messages" + :> ReqBody '[Servant.JSON] Public.NewOtrMessage + :> UVerb 'POST '[Servant.JSON] PostOtrResponses } deriving (Generic) type ServantAPI = ToServantApi Api +data IgnoreMissing + = IgnoreMissingAll + | IgnoreMissingList (Set UserId) + deriving (Show, Eq) + +-- TODO: Fill this in +instance ToParamSchema IgnoreMissing where + toParamSchema _ = mempty + +-- TODO: Test what happens when empty string is sent, is it backwards compatible? +-- TODO: Test what happens when true and false have different cases, is it backwards compatible? +instance FromHttpApiData IgnoreMissing where + parseQueryParam = \case + "true" -> Right IgnoreMissingAll + "false" -> Right $ IgnoreMissingList mempty + list -> IgnoreMissingList . Set.fromList . fromCommaSeparatedList <$> parseQueryParam list + +data ReportMissing + = ReportMissingAll + | ReportMissingList (Set UserId) + +instance ToParamSchema ReportMissing where + toParamSchema _ = mempty + +-- TODO: Test what happens when empty string is sent, is it backwards compatible? +-- TODO: Test what happens when true and false have different cases, is it backwards compatible? +instance FromHttpApiData ReportMissing where + parseQueryParam = \case + "true" -> Right ReportMissingAll + "false" -> Right $ ReportMissingList mempty + list -> ReportMissingList . Set.fromList . fromCommaSeparatedList <$> parseQueryParam list + swaggerDoc :: Swagger swaggerDoc = toSwagger (Proxy @ServantAPI) + +-- post "/conversations/:cnv/otr/messages" (continue Update.postOtrMessageH) $ +-- zauthUserId +-- .&. zauthConnId +-- .&. capture "cnv" +-- .&. def Public.OtrReportAllMissing filterMissing +-- .&. jsonRequest @Public.NewOtrMessage +-- document "POST" "postOtrMessage" $ do +-- summary "Post an encrypted message to a conversation (accepts JSON)" +-- parameter Path "cnv" bytes' $ +-- description "Conversation ID" +-- parameter Query "ignore_missing" bool' $ do +-- description +-- "Force message delivery even when clients are missing. \ +-- \NOTE: can also be a comma-separated list of user IDs, \ +-- \in which case it specifies who exactly is allowed to \ +-- \have missing clients." +-- optional +-- parameter Query "report_missing" bool' $ do +-- description +-- "Don't allow message delivery when clients are missing \ +-- \('ignore_missing' takes precedence when present). \ +-- \NOTE: can also be a comma-separated list of user IDs, \ +-- \in which case it specifies who exactly is forbidden from \ +-- \having missing clients. \ +-- \To support large lists of user IDs exceeding the allowed \ +-- \URL length, you can also put this list in the body, in \ +-- \the optional field 'report_missing'. That body field takes \ +-- \prhttps://wearezeta.atlassian.net/wiki/spaces/ENGINEERIN/pages/376439791/Use%2Bcase%2BClassified%2Bdomains?focusedCommentId=384861252#comment-384861252ecedence over both query params." +-- optional +-- body (ref Public.modelNewOtrMessage) $ +-- description "JSON body" +-- returns (ref Public.modelClientMismatch) +-- response 201 "Message posted" end +-- response 412 "Missing clients" end +-- errorResponse Error.convNotFound +-- errorResponse Error.unknownClient diff --git a/libs/wire-api/src/Wire/API/User/Client.hs b/libs/wire-api/src/Wire/API/User/Client.hs index 89f16501563..e1f18465ec8 100644 --- a/libs/wire-api/src/Wire/API/User/Client.hs +++ b/libs/wire-api/src/Wire/API/User/Client.hs @@ -334,18 +334,21 @@ newtype UserClients = UserClients } deriving stock (Eq, Show, Generic) deriving newtype (Semigroup, Monoid) + deriving (ToJSON, FromJSON, Swagger.ToSchema) via Schema UserClients mkUserClients :: [(UserId, [ClientId])] -> UserClients mkUserClients xs = UserClients $ Map.fromList (xs <&> second Set.fromList) -instance Swagger.ToSchema UserClients where - declareNamedSchema _ = do - mapSch <- Swagger.declareSchema (Proxy @(Map UserId (Set ClientId))) - return $ - Swagger.NamedSchema (Just "UserClients") $ - mapSch - & Swagger.description ?~ "Map of user id to list of client ids." - & Swagger.example +-- TODO: Is using genericToSchema OK here? Maybe it is better to write a `set` +-- combinator? +instance ToSchema UserClients where + schema = + addDoc . named "UserClients" $ UserClients <$> userClients .= map_ (genericToSchema @(Set ClientId)) + where + addDoc sch = + sch + & Swagger.schema . Swagger.description ?~ "Map of user id to list of client ids." + & Swagger.schema . Swagger.example ?~ toJSON ( Map.fromList [ (generateExample @UserId, [newClientId 1684636986166846496, newClientId 4940483633899001999]), @@ -353,27 +356,13 @@ instance Swagger.ToSchema UserClients where ] ) --- FUTUREWORK: Remove when 'NewOtrMessage' has ToSchema +-- TODO: Remove when 'NewOtrMessage' has ToSchema modelUserClients :: Doc.Model modelUserClients = Doc.defineModel "UserClients" $ Doc.property "" (Doc.unique $ Doc.array Doc.bytes') $ Doc.description "Map of user IDs to sets of client IDs ({ UserId: [ClientId] })." -instance ToJSON UserClients where - toJSON = - toJSON . Map.foldrWithKey' fn Map.empty . userClients - where - fn u c m = - let k = Text.E.decodeLatin1 (toASCIIBytes (toUUID u)) - in Map.insert k c m - -instance FromJSON UserClients where - parseJSON = - A.withObject "UserClients" (fmap UserClients . foldrM fn Map.empty . HashMap.toList) - where - fn (k, v) m = Map.insert <$> parseJSON (A.String k) <*> parseJSON v <*> pure m - instance Arbitrary UserClients where arbitrary = UserClients <$> mapOf' arbitrary (setOf' arbitrary) diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/ClientMismatch_user.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/ClientMismatch_user.hs index 0a7e13ff632..8e6c984842e 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/ClientMismatch_user.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Generated/ClientMismatch_user.hs @@ -19,6 +19,7 @@ module Test.Wire.API.Golden.Generated.ClientMismatch_user where import Data.Id (ClientId (ClientId, client), Id (Id)) +import Data.Json.Util (toUTCTimeMillis) import qualified Data.UUID as UUID (fromString) import GHC.Exts (IsList (fromList)) import Imports (fromJust, read) @@ -27,7 +28,7 @@ import Wire.API.Message (ClientMismatch (ClientMismatch), UserClients (UserClien testObject_ClientMismatch_user_1 :: ClientMismatch testObject_ClientMismatch_user_1 = ( ClientMismatch - (read "1864-04-12 12:22:43.673 UTC") + (toUTCTimeMillis (read "1864-04-12 12:22:43.673 UTC")) ( UserClients { userClients = fromList @@ -88,7 +89,7 @@ testObject_ClientMismatch_user_1 = testObject_ClientMismatch_user_2 :: ClientMismatch testObject_ClientMismatch_user_2 = ( ClientMismatch - (read "1864-04-19 08:06:54.492 UTC") + (toUTCTimeMillis (read "1864-04-19 08:06:54.492 UTC")) ( UserClients { userClients = fromList @@ -151,7 +152,7 @@ testObject_ClientMismatch_user_2 = testObject_ClientMismatch_user_3 :: ClientMismatch testObject_ClientMismatch_user_3 = ( ClientMismatch - (read "1864-05-18 16:25:29.722 UTC") + (toUTCTimeMillis (read "1864-05-18 16:25:29.722 UTC")) ( UserClients { userClients = fromList @@ -211,7 +212,7 @@ testObject_ClientMismatch_user_3 = testObject_ClientMismatch_user_4 :: ClientMismatch testObject_ClientMismatch_user_4 = ( ClientMismatch - (read "1864-04-20 07:47:05.133 UTC") + (toUTCTimeMillis (read "1864-04-20 07:47:05.133 UTC")) ( UserClients { userClients = fromList @@ -249,7 +250,7 @@ testObject_ClientMismatch_user_4 = testObject_ClientMismatch_user_5 :: ClientMismatch testObject_ClientMismatch_user_5 = ( ClientMismatch - (read "1864-04-26 19:31:21.478 UTC") + (toUTCTimeMillis (read "1864-04-26 19:31:21.478 UTC")) ( UserClients { userClients = fromList @@ -339,7 +340,7 @@ testObject_ClientMismatch_user_5 = testObject_ClientMismatch_user_6 :: ClientMismatch testObject_ClientMismatch_user_6 = ( ClientMismatch - (read "1864-05-28 18:24:35.996 UTC") + (toUTCTimeMillis (read "1864-05-28 18:24:35.996 UTC")) ( UserClients { userClients = fromList @@ -363,7 +364,7 @@ testObject_ClientMismatch_user_6 = testObject_ClientMismatch_user_7 :: ClientMismatch testObject_ClientMismatch_user_7 = ( ClientMismatch - (read "1864-05-26 02:38:01.741 UTC") + (toUTCTimeMillis (read "1864-05-26 02:38:01.741 UTC")) (UserClients {userClients = fromList []}) ( UserClients { userClients = @@ -427,7 +428,7 @@ testObject_ClientMismatch_user_7 = testObject_ClientMismatch_user_8 :: ClientMismatch testObject_ClientMismatch_user_8 = ( ClientMismatch - (read "1864-04-11 13:11:44.951 UTC") + (toUTCTimeMillis (read "1864-04-11 13:11:44.951 UTC")) ( UserClients { userClients = fromList @@ -475,7 +476,7 @@ testObject_ClientMismatch_user_8 = testObject_ClientMismatch_user_9 :: ClientMismatch testObject_ClientMismatch_user_9 = ( ClientMismatch - (read "1864-04-20 09:37:09.767 UTC") + (toUTCTimeMillis (read "1864-04-20 09:37:09.767 UTC")) ( UserClients { userClients = fromList @@ -512,7 +513,7 @@ testObject_ClientMismatch_user_9 = testObject_ClientMismatch_user_10 :: ClientMismatch testObject_ClientMismatch_user_10 = ( ClientMismatch - (read "1864-06-08 05:23:30.672 UTC") + (toUTCTimeMillis (read "1864-06-08 05:23:30.672 UTC")) ( UserClients { userClients = fromList @@ -555,7 +556,7 @@ testObject_ClientMismatch_user_10 = testObject_ClientMismatch_user_11 :: ClientMismatch testObject_ClientMismatch_user_11 = ( ClientMismatch - (read "1864-04-14 22:55:33.894 UTC") + (toUTCTimeMillis (read "1864-04-14 22:55:33.894 UTC")) ( UserClients { userClients = fromList @@ -615,7 +616,7 @@ testObject_ClientMismatch_user_11 = testObject_ClientMismatch_user_12 :: ClientMismatch testObject_ClientMismatch_user_12 = ( ClientMismatch - (read "1864-05-08 01:07:14.883 UTC") + (toUTCTimeMillis (read "1864-05-08 01:07:14.883 UTC")) (UserClients {userClients = fromList []}) ( UserClients { userClients = @@ -669,7 +670,7 @@ testObject_ClientMismatch_user_12 = testObject_ClientMismatch_user_13 :: ClientMismatch testObject_ClientMismatch_user_13 = ( ClientMismatch - (read "1864-05-09 16:28:56.647 UTC") + (toUTCTimeMillis (read "1864-05-09 16:28:56.647 UTC")) ( UserClients { userClients = fromList @@ -747,7 +748,7 @@ testObject_ClientMismatch_user_13 = testObject_ClientMismatch_user_14 :: ClientMismatch testObject_ClientMismatch_user_14 = ( ClientMismatch - (read "1864-05-08 01:02:42.968 UTC") + (toUTCTimeMillis (read "1864-05-08 01:02:42.968 UTC")) ( UserClients { userClients = fromList @@ -799,7 +800,7 @@ testObject_ClientMismatch_user_14 = testObject_ClientMismatch_user_15 :: ClientMismatch testObject_ClientMismatch_user_15 = ( ClientMismatch - (read "1864-06-02 22:04:34.496 UTC") + (toUTCTimeMillis (read "1864-06-02 22:04:34.496 UTC")) ( UserClients { userClients = fromList @@ -850,7 +851,7 @@ testObject_ClientMismatch_user_15 = testObject_ClientMismatch_user_16 :: ClientMismatch testObject_ClientMismatch_user_16 = ( ClientMismatch - (read "1864-06-01 16:55:21.151 UTC") + (toUTCTimeMillis (read "1864-06-01 16:55:21.151 UTC")) ( UserClients { userClients = fromList @@ -910,7 +911,7 @@ testObject_ClientMismatch_user_16 = testObject_ClientMismatch_user_17 :: ClientMismatch testObject_ClientMismatch_user_17 = ( ClientMismatch - (read "1864-04-23 21:23:53.493 UTC") + (toUTCTimeMillis (read "1864-04-23 21:23:53.493 UTC")) ( UserClients { userClients = fromList @@ -965,7 +966,7 @@ testObject_ClientMismatch_user_17 = testObject_ClientMismatch_user_18 :: ClientMismatch testObject_ClientMismatch_user_18 = ( ClientMismatch - (read "1864-05-14 18:56:29.815 UTC") + (toUTCTimeMillis (read "1864-05-14 18:56:29.815 UTC")) ( UserClients { userClients = fromList @@ -1039,7 +1040,7 @@ testObject_ClientMismatch_user_18 = testObject_ClientMismatch_user_19 :: ClientMismatch testObject_ClientMismatch_user_19 = ( ClientMismatch - (read "1864-06-06 11:59:12.981 UTC") + (toUTCTimeMillis (read "1864-06-06 11:59:12.981 UTC")) ( UserClients { userClients = fromList @@ -1119,7 +1120,7 @@ testObject_ClientMismatch_user_19 = testObject_ClientMismatch_user_20 :: ClientMismatch testObject_ClientMismatch_user_20 = ( ClientMismatch - (read "1864-05-20 02:14:30.091 UTC") + (toUTCTimeMillis (read "1864-05-20 02:14:30.091 UTC")) ( UserClients { userClients = fromList diff --git a/services/galley/src/Galley/API/Public.hs b/services/galley/src/Galley/API/Public.hs index aacbf62b215..b8f481108b5 100644 --- a/services/galley/src/Galley/API/Public.hs +++ b/services/galley/src/Galley/API/Public.hs @@ -87,7 +87,8 @@ servantSitemap = GalleyAPI.getTeamConversationRoles = Teams.getTeamConversationRoles, GalleyAPI.getTeamConversations = Teams.getTeamConversations, GalleyAPI.getTeamConversation = Teams.getTeamConversation, - GalleyAPI.deleteTeamConversation = Teams.deleteTeamConversation + GalleyAPI.deleteTeamConversation = Teams.deleteTeamConversation, + GalleyAPI.postOtrMessage = Update.postOtrMessage } sitemap :: Routes ApiBuilder Galley () @@ -767,45 +768,6 @@ sitemap = do errorResponse Error.convNotFound errorResponse $ Error.invalidOp "Conversation type does not allow removing members" - -- This endpoint can lead to the following events being sent: - -- - OtrMessageAdd event to recipients - post "/conversations/:cnv/otr/messages" (continue Update.postOtrMessageH) $ - zauthUserId - .&. zauthConnId - .&. capture "cnv" - .&. def Public.OtrReportAllMissing filterMissing - .&. jsonRequest @Public.NewOtrMessage - document "POST" "postOtrMessage" $ do - summary "Post an encrypted message to a conversation (accepts JSON)" - parameter Path "cnv" bytes' $ - description "Conversation ID" - parameter Query "ignore_missing" bool' $ do - description - "Force message delivery even when clients are missing. \ - \NOTE: can also be a comma-separated list of user IDs, \ - \in which case it specifies who exactly is allowed to \ - \have missing clients." - optional - parameter Query "report_missing" bool' $ do - description - "Don't allow message delivery when clients are missing \ - \('ignore_missing' takes precedence when present). \ - \NOTE: can also be a comma-separated list of user IDs, \ - \in which case it specifies who exactly is forbidden from \ - \having missing clients. \ - \To support large lists of user IDs exceeding the allowed \ - \URL length, you can also put this list in the body, in \ - \the optional field 'report_missing'. That body field takes \ - \precedence over both query params." - optional - body (ref Public.modelNewOtrMessage) $ - description "JSON body" - returns (ref Public.modelClientMismatch) - response 201 "Message posted" end - response 412 "Missing clients" end - errorResponse Error.convNotFound - errorResponse Error.unknownClient - -- This endpoint can lead to the following events being sent: -- - OtrMessageAdd event to recipients post "/conversations/:cnv/otr/messages" (continue Update.postProtoOtrMessageH) $ diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index 7f687ef71a7..c59316fbb8c 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -43,7 +43,7 @@ module Galley.API.Update UpdateResponses, -- * Talking - postOtrMessageH, + postOtrMessage, postProtoOtrMessageH, postOtrBroadcastH, postProtoOtrBroadcastH, @@ -72,6 +72,7 @@ import Data.Code import Data.Domain (Domain) import Data.Id import Data.LegalHold (UserLegalHoldStatus (UserLegalHoldNoConsent), defUserLegalHoldStatus) +import Data.Json.Util (toUTCTimeMillis) import Data.List.Extra (nubOrdOn) import Data.List1 import qualified Data.Map.Strict as Map @@ -126,6 +127,7 @@ import Wire.API.Team.LegalHold (LegalholdProtectee (..)) import Wire.API.User (userTeam) import Wire.API.User.Client (UserClientsFull) import qualified Wire.API.User.Client as Client +import qualified Wire.API.Routes.Public.Galley as GalleyAPI acceptConvH :: UserId ::: Maybe ConnId ::: ConvId -> Galley Response acceptConvH (usr ::: conn ::: cnv) = do @@ -651,17 +653,24 @@ postProtoOtrMessageH :: UserId ::: ConnId ::: ConvId ::: Public.OtrFilterMissing postProtoOtrMessageH (zusr ::: zcon ::: cnv ::: val ::: req ::: _) = do message <- Proto.toNewOtrMessage <$> fromProtoBody req let val' = allowOtrFilterMissingInBody val message - handleOtrResult <$> postOtrMessage zusr zcon cnv val' message + handleOtrResult <$> postNewOtrMessage (ProtectedUser' zusr) (Just zcon) cnv val' message -postOtrMessageH :: UserId ::: ConnId ::: ConvId ::: Public.OtrFilterMissing ::: JsonRequest Public.NewOtrMessage -> Galley Response -postOtrMessageH (zusr ::: zcon ::: cnv ::: val ::: req) = do - message <- fromJsonBody req - let val' = allowOtrFilterMissingInBody val message - handleOtrResult <$> postOtrMessage zusr zcon cnv val' message +postOtrMessage :: UserId -> ConnId -> ConvId -> Maybe GalleyAPI.IgnoreMissing -> Maybe GalleyAPI.ReportMissing -> Public.NewOtrMessage -> Galley (Union GalleyAPI.PostOtrResponses) +postOtrMessage zusr zcon cnv ignoreMissing reportMissing message = do + let queryParamIndication = resolveQueryMissingOptions ignoreMissing reportMissing + overallResovedMissingOptions = allowOtrFilterMissingInBody queryParamIndication message + translateToServant =<< postNewOtrMessage (ProtectedUser' zusr) (Just zcon) cnv overallResovedMissingOptions message + where + translateToServant :: OtrResult -> Galley (Union GalleyAPI.PostOtrResponses) + translateToServant (OtrSent mismatch) = Servant.respond (WithStatus @201 mismatch) + translateToServant (OtrMissingRecipients mismatch) = Servant.respond (WithStatus @412 mismatch) -postOtrMessage :: UserId -> ConnId -> ConvId -> Public.OtrFilterMissing -> Public.NewOtrMessage -> Galley OtrResult -postOtrMessage zusr zcon cnv val message = - postNewOtrMessage (ProtectedUser' zusr) (Just zcon) cnv val message + resolveQueryMissingOptions :: Maybe GalleyAPI.IgnoreMissing -> Maybe GalleyAPI.ReportMissing -> Public.OtrFilterMissing + resolveQueryMissingOptions Nothing Nothing = Public.OtrReportAllMissing + resolveQueryMissingOptions (Just GalleyAPI.IgnoreMissingAll) _ = Public.OtrIgnoreAllMissing + resolveQueryMissingOptions (Just (GalleyAPI.IgnoreMissingList uids)) _ = Public.OtrIgnoreMissing uids + resolveQueryMissingOptions Nothing (Just GalleyAPI.ReportMissingAll )= Public.OtrReportAllMissing + resolveQueryMissingOptions Nothing (Just (GalleyAPI.ReportMissingList uids) )= Public.OtrReportMissing uids postProtoOtrBroadcastH :: UserId ::: ConnId ::: Public.OtrFilterMissing ::: Request ::: JSON -> Galley Response postProtoOtrBroadcastH (zusr ::: zcon ::: val ::: req ::: _) = do @@ -1105,7 +1114,7 @@ checkOtrRecipients usr sid prs vms vcs val now mismatch :: ClientMismatch mismatch = ClientMismatch - { cmismatchTime = now, + { cmismatchTime = toUTCTimeMillis now, missingClients = UserClients (Clients.toMap missing), redundantClients = UserClients (Clients.toMap redundant), deletedClients = UserClients (Clients.toMap deleted)