WIP: Trying out a parameterised type for ConvOrSubConv

wireapp · Dec 2, 2022 · dab9fb5 · dab9fb5
1 parent 22da8a8
commit dab9fb5
Show file tree

Hide file tree

Showing 2 changed files with 25 additions and 6 deletions.
diff --git a/libs/wire-api/src/Wire/API/MLS/SubConversation.hs b/libs/wire-api/src/Wire/API/MLS/SubConversation.hs
@@ -93,6 +93,14 @@ data ConvOrSubConvId
   deriving (Show, Eq, Generic)
   deriving (Arbitrary) via (GenericUniform ConvOrSubConvId)
 
+data ConvOrSubConv (t :: ConvOrSubTag) a where
+  Conv' :: a -> ConvOrSubConv 'ConvTag a
+  SubConv' :: a -> ConvOrSubConv 'SubConvTag a
+
+instance Functor (ConvOrSubConv t) where
+  fmap f (Conv' v) = Conv' (f v)
+  fmap f (SubConv' v) = SubConv' (f v)
+
 makePrisms ''ConvOrSubConvId
 
 instance ToSchema ConvOrSubConvId where

diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs
@@ -136,6 +136,7 @@ postMLSMessageFromLocalUserV1 ::
          Input (Local ()),
          ProposalStore,
          Resource,
+         SubConversationStore,
          TinyLog
        ]
       r
@@ -171,6 +172,7 @@ postMLSMessageFromLocalUser ::
          Input (Local ()),
          ProposalStore,
          Resource,
+         SubConversationStore,
          TinyLog
        ]
       r
@@ -385,6 +387,7 @@ postMLSMessage ::
          Input (Local ()),
          ProposalStore,
          Resource,
+         SubConversationStore,
          TinyLog
        ]
       r
@@ -485,21 +488,26 @@ postMLSMessageToLocalConv ::
 postMLSMessageToLocalConv qusr senderClient con smsg convOrSubId = case rmValue smsg of
   SomeMessage tag msg -> do
     -- TODO: maybe factor out the next two blocks into a function
+    --
+    -- TODO(md): What is this block? It converts a 'ConvOrSubConvId' to the same
+    -- type. Probably the idea was to fetch a conversation or a subconversation,
+    -- not their IDs.
     lConvOrSub <- for convOrSubId $ \case
       Id.Conv convId -> do
-        Conv <$> getLocalConvForUser qusr (qualifyAs convOrSubId convId)
+        Id.Conv <$> getLocalConvForUser qusr (qualifyAs convOrSubId convId)
       Id.SubConv convId sconvId -> do
         let lconv = qualifyAs convOrSubId convId
         conv <- getLocalConvForUser qusr lconv
-        msubconv <- getSubConversation lconv sconvId
-        subconv <- noteS @'ConvNotFound msubconv
-        pure (SubConv conv subconv)
+        subconv <-
+          getSubConversation lconv sconvId
+            >>= noteS @'ConvNotFound
+        pure (Id.SubConv conv subconv)
 
     mlsMeta <-
       case tUnqualified lConvOrSub of
-        Conv conv ->
+        Id.Conv conv ->
           Data.mlsMetadata conv & noteS @'ConvNotFound
-        SubConv _ sconv ->
+        Id.SubConv _ sconv ->
           pure (scMLSData sconv)
 
     -- construct client map
@@ -670,7 +678,10 @@ processCommit ::
   Commit ->
   Sem r [LocalConversationUpdate]
 processCommit qusr senderClient con lconv mlsMeta cm epoch sender commit = do
+  -- NOTE(md): This one doesn't need the whole conversation 'lconv', but only its 'convId'.
   action <- getCommitData lconv mlsMeta epoch commit
+  -- NOTE(md): This one needs the whole conversation because
+  -- 'processInternalCommit' uses 'getConvMember', but 'processExternalCommit' needs only the 'Local convId'
   processCommitWithAction qusr senderClient con lconv mlsMeta cm epoch action sender commit
 
 processExternalCommit ::