@@ 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