M Network/Protocol/XMPP.hs => Network/Protocol/XMPP.hs +3 -3
@@ 60,9 60,9 @@ module Network.Protocol.XMPP
, getStanza
, bindJID
- -- ** Context hook
- , Context
- , getContext
+ -- ** Resuming sessions
+ , Session
+ , getSession
, runXMPP
) where
import Network.Protocol.XMPP.Client
M Network/Protocol/XMPP/Client/Authentication.hs => Network/Protocol/XMPP/Client/Authentication.hs +5 -5
@@ 55,7 55,7 @@ authenticate xmppMechanisms userJID serverJID username password = xmpp where
utf8 = TE.encodeUtf8 . T.concat . TL.toChunks
xmpp = do
- ctx <- M.getContext
+ ctx <- M.getSession
res <- liftIO $ Exc.try $ SASL.runSASL $ do
suggested <- SASL.clientSuggestMechanism mechanisms
case suggested of
@@ 89,7 89,7 @@ authenticate xmppMechanisms userJID serverJID username password = xmpp where
Right x -> return x
Left err -> saslError $ TL.pack $ show err
-saslLoop :: M.Context -> SASL.Session Result
+saslLoop :: M.Session -> SASL.Session Result
saslLoop ctx = do
elemt <- getElement ctx
let name = X.Name "challenge" (Just "urn:ietf:params:xml:ns:xmpp-sasl") Nothing
@@ 103,21 103,21 @@ saslLoop ctx = do
SASL.Complete -> saslFinish ctx
SASL.NeedsMore -> saslLoop ctx
-saslFinish :: M.Context -> SASL.Session Result
+saslFinish :: M.Session -> SASL.Session Result
saslFinish ctx = do
elemt <- getElement ctx
let name = X.Name "success" (Just "urn:ietf:params:xml:ns:xmpp-sasl") Nothing
let success = X.isNamed name elemt
return $ if null success then Failure else Success
-putElement :: M.Context -> X.Element -> SASL.Session ()
+putElement :: M.Session -> X.Element -> SASL.Session ()
putElement ctx elemt = liftIO $ do
res <- M.runXMPP ctx $ M.putElement elemt
case res of
Left err -> Exc.throwIO $ XmppError err
Right x -> return x
-getElement :: M.Context -> SASL.Session X.Element
+getElement :: M.Session -> SASL.Session X.Element
getElement ctx = liftIO $ do
res <- M.runXMPP ctx M.getElement
case res of
M Network/Protocol/XMPP/Monad.hs => Network/Protocol/XMPP/Monad.hs +15 -15
@@ 18,13 18,13 @@
module Network.Protocol.XMPP.Monad
( XMPP (..)
, Error (..)
- , Context (..)
+ , Session (..)
, runXMPP
, startXMPP
, restartXMPP
, getHandle
- , getContext
+ , getSession
, readEvents
, getElement
@@ 73,9 73,9 @@ data Error
| NoComponentStreamID
deriving (Show)
-data Context = Context H.Handle Text SAX.Parser
+data Session = Session H.Handle Text SAX.Parser
-newtype XMPP a = XMPP { unXMPP :: ErrorT Error (R.ReaderT Context IO) a }
+newtype XMPP a = XMPP { unXMPP :: ErrorT Error (R.ReaderT Session IO) a }
instance Functor XMPP where
fmap f = XMPP . fmap f . unXMPP
@@ 99,27 99,27 @@ instance A.Applicative XMPP where
instance MonadFix XMPP where
mfix f = XMPP $ mfix $ unXMPP . f
-runXMPP :: Context -> XMPP a -> IO (Either Error a)
-runXMPP ctx xmpp = R.runReaderT (runErrorT (unXMPP xmpp)) ctx
+runXMPP :: Session -> XMPP a -> IO (Either Error a)
+runXMPP s xmpp = R.runReaderT (runErrorT (unXMPP xmpp)) s
startXMPP :: H.Handle -> Text -> XMPP a -> IO (Either Error a)
startXMPP h ns xmpp = do
sax <- SAX.newParser
- runXMPP (Context h ns sax) xmpp
+ runXMPP (Session h ns sax) xmpp
restartXMPP :: Maybe H.Handle -> XMPP a -> XMPP a
restartXMPP newH xmpp = do
- Context oldH ns _ <- getContext
+ Session oldH ns _ <- getSession
sax <- liftIO SAX.newParser
- let ctx = Context (maybe oldH id newH) ns sax
- XMPP $ R.local (const ctx) (unXMPP xmpp)
+ let s = Session (maybe oldH id newH) ns sax
+ XMPP $ R.local (const s) (unXMPP xmpp)
-getContext :: XMPP Context
-getContext = XMPP R.ask
+getSession :: XMPP Session
+getSession = XMPP R.ask
getHandle :: XMPP H.Handle
getHandle = do
- Context h _ _ <- getContext
+ Session h _ _ <- getSession
return h
liftTLS :: ErrorT Text IO a -> XMPP a
@@ 143,7 143,7 @@ putStanza = putElement . S.stanzaToElement
readEvents :: (Integer -> SAX.Event -> Bool) -> XMPP [SAX.Event]
readEvents done = xmpp where
xmpp = do
- Context h _ p <- getContext
+ Session h _ p <- getSession
let nextEvents = do
-- TODO: read in larger increments
bytes <- liftTLS $ H.hGetBytes h 1
@@ 172,7 172,7 @@ getElement = xmpp where
getStanza :: XMPP S.ReceivedStanza
getStanza = do
elemt <- getElement
- Context _ ns _ <- getContext
+ Session _ ns _ <- getSession
case S.elementToStanza ns elemt of
Just x -> return x
Nothing -> E.throwError $ InvalidStanza elemt