Create direct message state when creating conversation

2 files changed, 43 insertions, 0 deletions

diff --git a/src/Erebos/Conversation.hs b/src/Erebos/Conversation.hs
index f9724c2..2d007c9 100644
--- a/src/Erebos/Conversation.hs
+++ b/src/Erebos/Conversation.hs
@@ -78,6 +78,7 @@ isSameConversation _ _ = False
 
 directMessageConversation :: MonadHead LocalState m => ComposedIdentity -> m Conversation
 directMessageConversation peer = do
+    createOrUpdateDirectMessagePeer peer
     (find (sameIdentity peer . msgPeer) . dmThreadList . lookupSharedValue . lsShared . fromStored <$> getLocalHead) >>= \case
         Just thread -> return $ DirectMessageConversation thread
         Nothing -> return $ DirectMessageConversation $ DirectMessageThread peer [] [] [] []
diff --git a/src/Erebos/DirectMessage.hs b/src/Erebos/DirectMessage.hs
index 21ba5b3..7cb1829 100644
--- a/src/Erebos/DirectMessage.hs
+++ b/src/Erebos/DirectMessage.hs
@@ -1,6 +1,8 @@
 module Erebos.DirectMessage (
     DirectMessage(..),
     sendDirectMessage,
+    updateDirectMessagePeer,
+    createOrUpdateDirectMessagePeer,
 
     DirectMessageAttributes(..),
     defaultDirectMessageAttributes,
@@ -189,6 +191,46 @@ sendDirectMessage pid text = updateLocalState_ $ \ls -> do
             }
         return $ DirectMessageThreads [ next ] (dmThreadView [ next ])
 
+updateDirectMessagePeer
+    :: (Foldable f, Applicative f, MonadHead LocalState m)
+    => Identity f -> m ()
+updateDirectMessagePeer = createOrUpdateDirectMessagePeer' False
+
+createOrUpdateDirectMessagePeer
+    :: (Foldable f, Applicative f, MonadHead LocalState m)
+    => Identity f -> m ()
+createOrUpdateDirectMessagePeer = createOrUpdateDirectMessagePeer' True
+
+createOrUpdateDirectMessagePeer'
+    :: (Foldable f, Applicative f, MonadHead LocalState m)
+    => Bool -> Identity f -> m ()
+createOrUpdateDirectMessagePeer' create pid = do
+    let powner = finalOwner pid
+    updateLocalState_ $ updateSharedState_ $ \old@(DirectMessageThreads prev threads) -> do
+        let updatePeerThread = do
+                next <- mstore MessageState
+                    { msPrev = prev
+                    , msPeer = powner
+                    , msReady = []
+                    , msSent = []
+                    , msReceived = []
+                    , msSeen = []
+                    }
+                return $ DirectMessageThreads [ next ] (dmThreadView [ next ])
+        case find (sameIdentity powner . msgPeer) threads of
+            Nothing
+                | create
+                -> updatePeerThread
+
+            Just thread
+                | oldPeer <- msgPeer thread
+                , newPeer <- updateIdentity (idExtDataF powner) oldPeer
+                , oldPeer /= newPeer
+                -> updatePeerThread
+
+            _ -> return old
+
+
 syncDirectMessageToPeer :: DirectMessageThreads -> ServiceHandler DirectMessage ()
 syncDirectMessageToPeer (DirectMessageThreads mss _) = do
     pid <- finalOwner <$> asks svcPeerIdentity