From ccc917c1de48ca1e66c93341d8d0b6ffa371932f Mon Sep 17 00:00:00 2001
From: Christopher Vollick <0@psycoti.ca>
Date: Tue, 9 Feb 2021 15:33:04 -0500
Subject: [PATCH] Handle Session Terminate When in Propose State

If a person calls us, we can make a proposal to have the phones ring.
But if they hang up, we're currently just sending them the session
terminate, when they don't actually have a session.

And so they ignore that, and the phone keeps ringing.

Similarly, if there are no resources online, the person on the other end
may hear it ring for a bit and then they'll stop for some reason.

Later, when the user comes back online, they'll be sent the messages
they missed while they were gone, including the session proposal, and
the phone will start to ring for them, no matter how long ago the phone
call was.

If they answer it, it'll be an error.
Not ideal, altogether.

Now, when the other side hangs up and we're still in the proposal state,
we retract the proposal, which means it will stop ringing in the online
case, and the user will know the phone call ended in the offline case.
---
 gateway.hs | 47 ++++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 40 insertions(+), 7 deletions(-)

diff --git a/gateway.hs b/gateway.hs
index 268d293..c32349b 100644
--- a/gateway.hs
+++ b/gateway.hs
@@ -132,6 +132,26 @@ sessionInitiateId (XMPP.ReceivedIQ iq)
 		(,) iq <$> XML.attributeText (s"sid") jingle
 sessionInitiateId _ = Nothing
 
+-- Return the sessionID of a session-terminate, and Nothing if it's something else
+-- (or the terminate doesn't have a session somehow)
+sessionTerminateId :: XMPP.ReceivedStanza -> Maybe Text
+sessionTerminateId (XMPP.ReceivedIQ iq)
+	| Just jingle <- child (s"{urn:xmpp:jingle:1}jingle") iq,
+	  XML.attributeText (s"action") jingle == Just (s"session-terminate") =
+		XML.attributeText (s"sid") jingle
+sessionTerminateId _ = Nothing
+
+-- Decodes the JID and otherwise fowards the stanza on as-is
+-- Also keeps the fullJidCache fresh
+forwardOn :: XMPP.JID -> Cache.Cache Text XMPP.JID -> XMPP.ReceivedStanza -> XMPP.XMPP ()
+forwardOn componentJid fullJidCache stanza = do
+		fullTo <- liftIO $ maybe (return Nothing) (Cache.lookup' fullJidCache) msid
+		liftIO $ forM_ msid $ \sid -> forM_ fullTo $ Cache.insert fullJidCache sid
+		bounceStanza stanza from (fromMaybe to fullTo)
+	where
+	Just (to, from) = asteriskToReal componentJid $ receivedTo stanza
+	msid = jingleSid stanza
+
 main :: IO ()
 main = do
 	hSetBuffering stdout LineBuffering
@@ -182,14 +202,27 @@ main = do
 											[XML.NodeElement $ XML.Element (s"{urn:xmpp:jingle:apps:rtp:1}description") [(s"media", [XML.ContentText $ s"audio"])] []]
 									]
 								}
+			Just sfrom
+				| sfrom == asteriskJid,
+				  Just (to, from) <- asteriskToReal componentJid $ receivedTo stanza,
+				  Just sid <- sessionTerminateId stanza -> do
+					mIq <- liftIO $ Cache.lookup' sessionInitiates sid
+					case mIq of
+						Just _ -> do
+							liftIO $ Cache.delete sessionInitiates sid
+							XMPP.putStanza $ (XMPP.emptyMessage XMPP.MessageChat) {
+									XMPP.messageID = Just $ s"retract%" ++ sid,
+									XMPP.messageTo = Just to,
+									XMPP.messageFrom = Just from,
+									XMPP.messagePayloads = [
+										XML.Element (s"{urn:xmpp:jingle-message:0}retract")
+											[(s"id", [XML.ContentText sid])]
+											[]
+									]
+								}
+						Nothing -> forwardOn componentJid fullJids stanza
 			Just sfrom | sfrom == asteriskJid ->
-				let
-					Just (to, from) = asteriskToReal componentJid $ receivedTo stanza
-					msid = jingleSid stanza
-				in do
-					fullTo <- liftIO $ maybe (return Nothing) (Cache.lookup' fullJids) msid
-					liftIO $ forM_ msid $ \sid -> forM_ fullTo $ Cache.insert fullJids sid
-					bounceStanza stanza from (fromMaybe to fullTo)
+				forwardOn componentJid fullJids stanza
 			sfrom
 				| XMPP.ReceivedPresence presence <- stanza,
 				  Just from <- sfrom,
-- 
2.45.2