[WPB-1226] Servantify internal Galley conversation endpoints

changelog.d/5-internal/WPB-1226-servantify-internal-galley-conv-endpoints

@@ -0,0 +1 @@
+Migrate to Servant the Galley conversation internal endpoints

libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs

@@ -250,6 +250,7 @@ type InternalAPIBase =
            )
     :<|> IFeatureAPI
     :<|> IFederationAPI
+    :<|> IConversationAPI
 
 type ILegalholdWhitelistedTeamsAPI =
   "legalhold"
@@ -446,6 +447,65 @@ type IFederationAPI =
         :> Get '[Servant.JSON] FederationStatus
     )
 
+type IConversationAPI =
+  Named
+    "conversation-get-member"
+    ( "conversations"
+        :> Capture "cnv" ConvId
+        :> "members"
+        :> Capture "usr" UserId
+        :> Get '[Servant.JSON] (Maybe Member)
+    )
+    -- This endpoint can lead to the following events being sent:
+    -- - MemberJoin event to you, if the conversation existed and had < 2 members before
+    -- - MemberJoin event to other, if the conversation existed and only the other was member
+    --   before
+    :<|> Named
+           "conversation-accept-v2"
+           ( CanThrow 'InvalidOperation
+               :> CanThrow 'ConvNotFound
+               :> ZLocalUser
+               :> ZOptConn
+               :> "conversations"
+               :> Capture "cnv" ConvId
+               :> "accept"
+               :> "v2"
+               :> Put '[Servant.JSON] Conversation
+           )
+    :<|> Named
+           "conversation-block"
+           ( CanThrow 'InvalidOperation
+               :> CanThrow 'ConvNotFound
+               :> ZUser
+               :> "conversations"
+               :> Capture "cnv" ConvId
+               :> "block"
+               :> Put '[Servant.JSON] ()
+           )
+    -- This endpoint can lead to the following events being sent:
+    -- - MemberJoin event to you, if the conversation existed and had < 2 members before
+    -- - MemberJoin event to other, if the conversation existed and only the other was member
+    --   before
+    :<|> Named
+           "conversation-unblock"
+           ( CanThrow 'InvalidOperation
+               :> CanThrow 'ConvNotFound
+               :> ZLocalUser
+               :> ZOptConn
+               :> "conversations"
+               :> Capture "cnv" ConvId
+               :> "unblock"
+               :> Put '[Servant.JSON] Conversation
+           )
+    :<|> Named
+           "conversation-meta"
+           ( CanThrow 'ConvNotFound
+               :> "conversations"
+               :> Capture "cnv" ConvId
+               :> "meta"
+               :> Get '[Servant.JSON] ConversationMetadata
+           )
+
 swaggerDoc :: OpenApi
 swaggerDoc =
   toOpenApi (Proxy @InternalAPI)

services/galley/src/Galley/API.hs

@@ -16,7 +16,7 @@
 -- with this program. If not, see <https://www.gnu.org/licenses/>.
 
 module Galley.API
-  ( sitemap,
+  ( waiSitemap,
     servantSitemap,
   )
 where
@@ -28,7 +28,7 @@ import Galley.App (GalleyEffects)
 import Network.Wai.Routing (Routes)
 import Polysemy
 
-sitemap :: Routes () (Sem GalleyEffects) ()
-sitemap = do
+waiSitemap :: Routes () (Sem GalleyEffects) ()
+waiSitemap = do
   Public.sitemap
-  internalSitemap
+  waiInternalSitemap

services/galley/src/Galley/API/Internal.hs

@@ -16,7 +16,7 @@
 -- with this program. If not, see <https://www.gnu.org/licenses/>.
 
 module Galley.API.Internal
-  ( internalSitemap,
+  ( waiInternalSitemap,
     internalAPI,
     InternalAPI,
     deleteLoop,
@@ -73,7 +73,6 @@ import Galley.Types.UserList
 import Imports hiding (head)
 import Network.AMQP qualified as Q
 import Network.Wai.Predicate hiding (Error, err, result, setStatus)
-import Network.Wai.Predicate qualified as Predicate hiding (result)
 import Network.Wai.Routing hiding (App, route, toList)
 import Network.Wai.Utilities hiding (Error)
 import Network.Wai.Utilities.ZAuth
@@ -117,11 +116,20 @@ internalAPI =
       <@> mkNamedAPI @"upsert-one2one" iUpsertOne2OneConversation
       <@> featureAPI
       <@> federationAPI
+      <@> conversationAPI
 
 federationAPI :: API IFederationAPI GalleyEffects
 federationAPI =
   mkNamedAPI @"get-federation-status" (const getFederationStatus)
 
+conversationAPI :: API IConversationAPI GalleyEffects
+conversationAPI =
+  mkNamedAPI @"conversation-get-member" Query.internalGetMember
+    <@> mkNamedAPI @"conversation-accept-v2" Update.acceptConv
+    <@> mkNamedAPI @"conversation-block" Update.blockConv
+    <@> mkNamedAPI @"conversation-unblock" Update.unblockConv
+    <@> mkNamedAPI @"conversation-meta" Query.getConversationMeta
+
 legalholdWhitelistedTeamsAPI :: API ILegalholdWhitelistedTeamsAPI GalleyEffects
 legalholdWhitelistedTeamsAPI = mkAPI $ \tid -> hoistAPIHandler Imports.id (base tid)
   where
@@ -228,43 +236,8 @@ featureAPI =
     <@> mkNamedAPI @'("ilock", MlsMigrationConfig) (updateLockStatus @MlsMigrationConfig)
     <@> mkNamedAPI @"feature-configs-internal" (maybe getAllFeatureConfigsForServer getAllFeatureConfigsForUser)
 
-internalSitemap :: Routes a (Sem GalleyEffects) ()
-internalSitemap = unsafeCallsFed @'Galley @"on-client-removed" $ unsafeCallsFed @'Galley @"on-mls-message-sent" $ do
-  -- Conversation API (internal) ----------------------------------------
-  put "/i/conversations/:cnv/channel" (continue $ const (pure empty)) $
-    zauthUserId
-      .&. (capture "cnv" :: (HasCaptures r) => Predicate r Predicate.Error ConvId)
-      .&. request
-
-  get "/i/conversations/:cnv/members/:usr" (continue Query.internalGetMemberH) $
-    capture "cnv"
-      .&. capture "usr"
-
-  -- This endpoint can lead to the following events being sent:
-  -- - MemberJoin event to you, if the conversation existed and had < 2 members before
-  -- - MemberJoin event to other, if the conversation existed and only the other was member
-  --   before
-  put "/i/conversations/:cnv/accept/v2" (continueE Update.acceptConvH) $
-    zauthUserId
-      .&. opt zauthConnId
-      .&. capture "cnv"
-
-  put "/i/conversations/:cnv/block" (continueE Update.blockConvH) $
-    zauthUserId
-      .&. capture "cnv"
-
-  -- This endpoint can lead to the following events being sent:
-  -- - MemberJoin event to you, if the conversation existed and had < 2 members before
-  -- - MemberJoin event to other, if the conversation existed and only the other was member
-  --   before
-  put "/i/conversations/:cnv/unblock" (continueE Update.unblockConvH) $
-    zauthUserId
-      .&. opt zauthConnId
-      .&. capture "cnv"
-
-  get "/i/conversations/:cnv/meta" (continue Query.getConversationMetaH) $
-    capture "cnv"
-
+waiInternalSitemap :: Routes a (Sem GalleyEffects) ()
+waiInternalSitemap = unsafeCallsFed @'Galley @"on-client-removed" $ unsafeCallsFed @'Galley @"on-mls-message-sent" $ do
   -- Misc API (internal) ------------------------------------------------
 
   get "/i/users/:uid/team/members" (continueE Teams.getBindingTeamMembersH) $

services/galley/src/Galley/API/Query.hs

@@ -29,8 +29,8 @@ module Galley.API.Query
     listConversations,
     iterateConversations,
     getLocalSelf,
-    internalGetMemberH,
-    getConversationMetaH,
+    internalGetMember,
+    getConversationMeta,
     getConversationByReusableCode,
     ensureGuestLinksEnabled,
     getConversationGuestLinksStatus,
@@ -43,6 +43,7 @@ where
 
 import Cassandra qualified as C
 import Control.Lens
+import Control.Monad.Extra
 import Data.ByteString.Lazy qualified as LBS
 import Data.Code
 import Data.CommaSeparatedList
@@ -77,7 +78,6 @@ import Galley.Options
 import Galley.Types.Conversations.Members
 import Galley.Types.Teams
 import Imports hiding (cs)
-import Network.HTTP.Types
 import Network.Wai
 import Network.Wai.Predicate hiding (Error, result, setStatus)
 import Network.Wai.Utilities hiding (Error)
@@ -577,16 +577,17 @@ iterateConversations luid pageSize handleConvs = go Nothing
         _ -> pure []
       pure $ resultHead : resultTail
 
-internalGetMemberH ::
+internalGetMember ::
   ( Member ConversationStore r,
     Member (Input (Local ())) r,
     Member MemberStore r
   ) =>
-  ConvId ::: UserId ->
-  Sem r Response
-internalGetMemberH (cnv ::: usr) = do
+  ConvId ->
+  UserId ->
+  Sem r (Maybe Public.Member)
+internalGetMember cnv usr = do
   lusr <- qualifyLocal usr
-  json <$> getLocalSelf lusr cnv
+  getLocalSelf lusr cnv
 
 getLocalSelf ::
   ( Member ConversationStore r,
@@ -602,26 +603,17 @@ getLocalSelf lusr cnv = do
       then Mapping.localMemberToSelf lusr <$$> E.getLocalMember cnv (tUnqualified lusr)
       else Nothing <$ E.deleteConversation cnv
 
-getConversationMetaH ::
-  Member ConversationStore r =>
-  ConvId ->
-  Sem r Response
-getConversationMetaH cnv = do
-  getConversationMeta cnv <&> \case
-    Nothing -> setStatus status404 empty
-    Just meta -> json meta
-
 getConversationMeta ::
-  Member ConversationStore r =>
+  ( Member ConversationStore r,
+    Member (ErrorS 'ConvNotFound) r
+  ) =>
   ConvId ->
-  Sem r (Maybe ConversationMetadata)
-getConversationMeta cnv = do
-  alive <- E.isConversationAlive cnv
-  if alive
-    then E.getConversationMetadata cnv
-    else do
-      E.deleteConversation cnv
-      pure Nothing
+  Sem r ConversationMetadata
+getConversationMeta cnv =
+  ifM
+    (E.isConversationAlive cnv)
+    (E.getConversationMetadata cnv >>= noteS @'ConvNotFound)
+    (E.deleteConversation cnv >> throwS @'ConvNotFound)
 
 getConversationByReusableCode ::
   forall r.

services/galley/src/Galley/API/Update.hs

@@ -19,9 +19,9 @@
 
 module Galley.API.Update
   ( -- * Managing Conversations
-    acceptConvH,
-    blockConvH,
-    unblockConvH,
+    acceptConv,
+    blockConv,
+    unblockConv,
     checkReusableCode,
     joinConversationByReusableCode,
     joinConversationById,
@@ -144,23 +144,6 @@ import Wire.API.ServantProto (RawProto (..))
 import Wire.API.Team.Member
 import Wire.API.User.Client
 
-acceptConvH ::
-  ( Member ConversationStore r,
-    Member (Error InternalError) r,
-    Member (ErrorS 'ConvNotFound) r,
-    Member (ErrorS 'InvalidOperation) r,
-    Member GundeckAccess r,
-    Member (Input (Local ())) r,
-    Member (Input UTCTime) r,
-    Member MemberStore r,
-    Member TinyLog r
-  ) =>
-  UserId ::: Maybe ConnId ::: ConvId ->
-  Sem r Response
-acceptConvH (usr ::: conn ::: cnv) = do
-  lusr <- qualifyLocal usr
-  setStatus status200 . json <$> acceptConv lusr conn cnv
-
 acceptConv ::
   ( Member ConversationStore r,
     Member (Error InternalError) r,
@@ -181,17 +164,6 @@ acceptConv lusr conn cnv = do
   conv' <- acceptOne2One lusr conv conn
   conversationView lusr conv'
 
-blockConvH ::
-  ( Member ConversationStore r,
-    Member (ErrorS 'ConvNotFound) r,
-    Member (ErrorS 'InvalidOperation) r,
-    Member MemberStore r
-  ) =>
-  UserId ::: ConvId ->
-  Sem r Response
-blockConvH (zusr ::: cnv) =
-  empty <$ blockConv zusr cnv
-
 blockConv ::
   ( Member ConversationStore r,
     Member (ErrorS 'ConvNotFound) r,
@@ -209,23 +181,6 @@ blockConv zusr cnv = do
   when (zusr `isMember` mems) $
     E.deleteMembers cnv (UserList [zusr] [])
 
-unblockConvH ::
-  ( Member ConversationStore r,
-    Member (Error InternalError) r,
-    Member (ErrorS 'ConvNotFound) r,
-    Member (ErrorS 'InvalidOperation) r,
-    Member GundeckAccess r,
-    Member (Input (Local ())) r,
-    Member (Input UTCTime) r,
-    Member MemberStore r,
-    Member TinyLog r
-  ) =>
-  UserId ::: Maybe ConnId ::: ConvId ->
-  Sem r Response
-unblockConvH (usr ::: conn ::: cnv) = do
-  lusr <- qualifyLocal usr
-  setStatus status200 . json <$> unblockConv lusr conn cnv
-
 unblockConv ::
   ( Member ConversationStore r,
     Member (Error InternalError) r,

services/galley/src/Galley/Run.hs

@@ -94,7 +94,7 @@ mkApp opts =
     lift $ runClient (env ^. cstate) $ versionCheck schemaVersion
     let middlewares =
           versionMiddleware (opts ^. settings . disabledAPIVersions . traverse)
-            . servantPlusWAIPrometheusMiddleware API.sitemap (Proxy @CombinedAPI)
+            . servantPlusWAIPrometheusMiddleware API.waiSitemap (Proxy @CombinedAPI)
             . GZip.gunzip
             . GZip.gzip GZip.def
             . catchErrors logger [Right metrics]
@@ -104,7 +104,7 @@ mkApp opts =
       Log.close logger
     pure (middlewares $ servantApp env, env)
   where
-    rtree = compile API.sitemap
+    rtree = compile API.waiSitemap
     runGalley e r k = evalGalleyToIO e (route rtree r k)
     -- the servant API wraps the one defined using wai-routing
     servantApp e0 r =

services/galley/test/integration/Run.hs

@@ -36,7 +36,7 @@ import Data.Text (pack)
 import Data.Text.Encoding (encodeUtf8)
 import Data.Yaml (decodeFileEither)
 import Federation
-import Galley.API (sitemap)
+import Galley.API
 import Galley.Aws qualified as Aws
 import Galley.Options hiding (endpoint)
 import Galley.Options qualified as O
@@ -101,7 +101,7 @@ main = withOpenSSL $ runTests go
             assertEqual
               "inconsistent sitemap"
               mempty
-              (pathsConsistencyCheck . treeToPaths . compile $ Galley.API.sitemap),
+              (pathsConsistencyCheck . treeToPaths . compile $ Galley.API.waiSitemap),
           API.tests setup,
           test setup "isConvMemberL" isConvMemberLTests
         ]