1 files changed, 36 insertions(+), 22 deletions(-)

M Jingle.hs

@@ 29,8 29,8 @@ import qualified Jingle.Socks5Server as Socks5Server
 import Util
 import Jingle.StoreChunks
 
-sessionAccept :: Text -> Text -> XMPP.JID -> XML.Element -> XML.Element
-sessionAccept sid contentName responder transport =
+sessionAccept :: JingleSID -> Text -> XMPP.JID -> XML.Element -> XML.Element
+sessionAccept (JingleSID sid) contentName responder transport =
 	XML.Element (s"{urn:xmpp:jingle:1}jingle") [
 		(s"sid", [XML.ContentText sid]),
 		(s"action", [s"session-accept"]),


@@ 64,8 64,8 @@ ibbTransport tsid =
 		(s"sid", [XML.ContentText tsid])
 	] []
 
-ibbTransportAccept :: Text -> Text -> Text -> XMPP.JID -> XML.Element
-ibbTransportAccept sid tsid contentName initiator =
+ibbTransportAccept :: JingleSID -> Text -> Text -> XMPP.JID -> XML.Element
+ibbTransportAccept (JingleSID sid) tsid contentName initiator =
 	XML.Element (s"{urn:xmpp:jingle:1}jingle") [
 		(s"sid", [XML.ContentText sid]),
 		(s"action", [s"transport-accept"]),


@@ 85,8 85,8 @@ s5bCandidateError =
 	(s"{urn:xmpp:jingle:transports:s5b:1}candidate-error")
 	[] []
 
-s5bCandidateErrorTI :: Text -> Text -> Text -> XMPP.JID -> XML.Element
-s5bCandidateErrorTI sid tsid contentName initiator =
+s5bCandidateErrorTI :: JingleSID -> Text -> Text -> XMPP.JID -> XML.Element
+s5bCandidateErrorTI (JingleSID sid) tsid contentName initiator =
 	XML.Element (s"{urn:xmpp:jingle:1}jingle") [
 		(s"sid", [XML.ContentText sid]),
 		(s"action", [s"transport-info"]),


@@ 118,7 118,7 @@ sessionInitiate ::
 	-> (JingleTSID -> UIO ())
 	-> (JingleTSID -> Int -> UIO ())
 	-> XMPP.IQ
-	-> Text
+	-> JingleSID
 	-> [XML.Element]
 	-> Text
 	-> Maybe Int


@@ 212,18 212,20 @@ jingleHandler' ::
 	-> (JingleTSID -> Int -> UIO ())
 	-> XMPP.IQ
 	-> [XML.Element]
-	-> Text
+	-> JingleSID
+	-> Maybe (XMPP.IQ -> UIO ())
 	-> XMPP.XMPP ()
 jingleHandler' hostPort newSession newTransport setSize iq@XMPP.IQ {
 	XMPP.iqFrom = Just from
-} children sid
+} children sid handlerForUnknown
 	| jingleAction (s"session-initiate") iq,
 	  (desc:_) <- fileTransferDescription `overChildrenOf` content = do
-		liftIO $ UIO.run $ newSession (JingleSID sid) iq
+		liftIO $ UIO.run $ newSession sid iq
 		sessionInitiate hostPort
-			(newTransport (JingleSID sid))
+			(newTransport sid)
 			setSize
 			iq sid content contentName (fileSizeFromDescription desc)
+	| Just handler <- handlerForUnknown = liftIO $ UIO.run $ handler iq
 	| jingleAction (s"transport-info") iq,
 	  (_:_) <- jingleTransport `overChildrenOf` content =
 		XMPP.putStanza $ iqReply Nothing iq


@@ 236,7 238,7 @@ jingleHandler' hostPort newSession newTransport setSize iq@XMPP.IQ {
 	            (s"{urn:xmpp:jingle:transports:ibb:1}transport")
 	            `overChildrenOf` content = do
 		liftIO $ UIO.run $
-			newTransport (JingleSID sid) (JingleTSID tsid)
+			newTransport sid (JingleTSID tsid)
 		XMPP.putStanza $ iqReply Nothing iq
 
 		XMPP.putStanza $ iqNewRequest iq XMPP.IQSet


@@ 248,20 250,22 @@ jingleHandler' hostPort newSession newTransport setSize iq@XMPP.IQ {
 	content = XML.isNamed (s"{urn:xmpp:jingle:1}content") =<< children
 	contentName = fromMaybe mempty $
 		XML.attributeText (s"name") =<< headZ content
-jingleHandler' _ _ _ _ iq _ _ = XMPP.putStanza $ iqError notImplemented iq
+jingleHandler' _ _ _ _ iq _ _ _ = XMPP.putStanza $ iqError notImplemented iq
 
 jingleHandler ::
 	   (Text, Socket.PortNumber)
 	-> (JingleSID -> XMPP.IQ -> UIO ())
+	-> (JingleSID -> UIO (Maybe (XMPP.IQ -> UIO ())))
 	-> (JingleSID -> JingleTSID -> UIO ())
 	-> (JingleTSID -> Int -> UIO ())
 	-> XMPP.IQ
 	-> XML.Element
 	-> XMPP.XMPP ()
-jingleHandler hostPort newSession newTransport setSize iq jingle
-	| Just sid <- XML.attributeText (s"sid") jingle =
+jingleHandler hostPort newSession handlerWhenUnknown newTransport setSize iq jingle
+	| Just sid <- JingleSID <$> XML.attributeText (s"sid") jingle = do
+		handlerForUnknown <- liftIO $ UIO.run $ handlerWhenUnknown sid
 		jingleHandler' hostPort newSession newTransport setSize
-			iq (XML.elementChildren jingle) sid
+			iq (XML.elementChildren jingle) sid handlerForUnknown
 	| otherwise = XMPP.putStanza $ iqError notImplemented iq
 
 ibbHandler ::


@@ 310,14 314,15 @@ iqSetHandler ::
 	FilePath
 	-> (Text, Socket.PortNumber)
 	-> (JingleSID -> XMPP.IQ -> UIO ())
+	-> (JingleSID -> UIO (Maybe (XMPP.IQ -> UIO ())))
 	-> (JingleSID -> JingleTSID -> UIO ())
 	-> (JingleTSID -> Int -> UIO ())
 	-> (JingleTSID -> FilePath -> UIO ())
 	-> XMPP.IQ
 	-> XMPP.XMPP ()
-iqSetHandler storePath hostPort newSession newTransport setSize transportDone iq
+iqSetHandler storePath hostPort newSession handleUnknownSession newTransport setSize transportDone iq
 	| Just jingle <- child (s"{urn:xmpp:jingle:1}jingle") iq =
-		jingleHandler hostPort newSession newTransport setSize iq jingle
+		jingleHandler hostPort newSession handleUnknownSession newTransport setSize iq jingle
 	| Just (s"http://jabber.org/protocol/ibb") ==
 	  (XML.nameNamespace =<< XML.elementName <$> XMPP.iqPayload iq) =
 		ibbHandler storePath transportDone iq


@@ 361,17 366,25 @@ tsidToSizeMap =
 
 sidToIqMap :: (Unexceptional m) =>
 	   (XMPP.IQ -> FilePath -> UIO ())
+	-> (XMPP.IQ -> UIO ())
 	-> m (
 		JingleSID -> XMPP.IQ -> UIO (),
+		JingleSID -> UIO (Maybe (XMPP.IQ -> UIO ())),
 		JingleSID -> FilePath -> UIO ()
 	)
-sidToIqMap notifyByIq =
+sidToIqMap notifyByIq handleUnknownSession =
 	fromIO_ (Cache.newCache (Just $ TimeSpec 900 0)) >>= \cache ->
 	return (
 		\(JingleSID sid) iq -> do
 			fromIO_ $ Cache.purgeExpired cache
 			fromIO_ $ Cache.insert cache sid iq
 		,
+		\(JingleSID sid) -> do
+			session <- fromIO_ (Cache.lookup' cache sid)
+			return $ case session of
+				Just _ -> Nothing
+				Nothing -> Just handleUnknownSession
+		,
 		\(JingleSID sid) path -> do
 			miq <- fromIO_ $ Cache.lookup' cache sid
 			case miq of


@@ 386,13 399,14 @@ setupJingleHandlers :: (Unexceptional m) =>
 	-> (Text, Socket.PortNumber)
 	-> (String -> UIO ())
 	-> (XMPP.IQ -> FilePath -> UIO ())
+	-> (XMPP.IQ -> UIO ())
 	-> m (Either IOError (XMPP.IQ -> XMPP.XMPP ()))
-setupJingleHandlers storePath ports hostPort logger transferDoneIq = do
-	(newSession, transferDone) <- sidToIqMap transferDoneIq
+setupJingleHandlers storePath ports hostPort logger transferDoneIq otherJingle = do
+	(newSession, handlerWhenUnknown, transferDone) <- sidToIqMap transferDoneIq otherJingle
 	(newTransport, transportDone) <- tsidToSidMap transferDone
 	(setSize, getSize) <- tsidToSizeMap
 	(fmap.fmap) (\() ->
 			iqSetHandler storePath hostPort
-				newSession newTransport setSize transportDone
+				newSession handlerWhenUnknown newTransport setSize transportDone
 		) $
 		Socks5Server.start storePath ports logger getSize transportDone