~singpolyma/jingle-xmpp

0fc76a3e42e32cf4353a40d9d41afeaa77ac3f2d — Stephen Paul Weber 25 days ago 86b6938 + f7bff5f master
Merge branch 'cv_unhandled_jingle'

* cv_unhandled_jingle:
  Handle Unknown Session
  Build JingleSID Higher Up
1 files changed, 36 insertions(+), 22 deletions(-)

M Jingle.hs
M Jingle.hs => Jingle.hs +36 -22
@@ 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