From 4a7007731a1c1a82af50e240a84f1c02645bc6de Mon Sep 17 00:00:00 2001 From: Stephen Paul Weber Date: Sat, 15 Feb 2020 22:19:18 -0500 Subject: [PATCH] Fix some whitespace --- examples/echo.hs | 14 ++++++------ lib/Network/Protocol/XMPP.hs | 16 +++++++------- lib/Network/Protocol/XMPP/Client.hs | 14 ++++++------ .../Protocol/XMPP/Client/Authentication.hs | 16 +++++++------- lib/Network/Protocol/XMPP/JID.hs | 2 +- lib/Network/Protocol/XMPP/Monad.hs | 18 +++++++-------- lib/Network/Protocol/XMPP/Stanza.hs | 12 +++++----- lib/Network/Protocol/XMPP/XML.hs | 22 +++++++++---------- 8 files changed, 57 insertions(+), 57 deletions(-) diff --git a/examples/echo.hs b/examples/echo.hs index 83bcdb7..de6478d 100644 --- a/examples/echo.hs +++ b/examples/echo.hs @@ -58,7 +58,7 @@ runEcho hostname user password = do , serverJID = JID Nothing (jidDomain jid) Nothing , serverPort = PortNumber 5222 } - + -- 'runClient' and 'runComponent' open a connection to the remote server and -- establish an XMPP session. -- @@ -77,16 +77,16 @@ runEcho hostname user password = do -- When running a client session, most servers require the user to -- "bind" their JID before sending any stanzas. boundJID <- bindJID jid - + -- Some servers will close the XMPP connection after some period -- of inactivity. For this example, we'll simply send a "ping" every -- 60 seconds getSession >>= liftIO . forkIO . sendPings 60 - + -- 'XMPP' is an instance of 'MonadIO', so any IO may be performed -- within. liftIO $ putStrLn $ "Server bound our session to: " ++ show boundJID - + -- This is a simple loop which will echo received messages back to the -- sender; additionally, it prints *all* received stanzas to the console. forever $ do @@ -100,7 +100,7 @@ runEcho hostname user password = do then putStanza (subscribe msg) else return () _ -> return () - + -- If 'runClient' terminated due to an XMPP error, propagate it as an exception. -- In non-example code, you might want to show this error to the user. case res of @@ -113,12 +113,12 @@ echo :: Message -> Message echo msg = Message { messageType = MessageNormal , messageTo = messageFrom msg - + -- Note: Conforming XMPP servers populate the "from" attribute on -- stanzas, to prevent clients from spoofing it. Therefore, the -- 'messageFrom' field's value is irrelevant when sending stanzas. , messageFrom = Nothing - + , messageID = Nothing , messageLang = Nothing , messagePayloads = messagePayloads msg diff --git a/lib/Network/Protocol/XMPP.hs b/lib/Network/Protocol/XMPP.hs index d263232..5f8de3d 100644 --- a/lib/Network/Protocol/XMPP.hs +++ b/lib/Network/Protocol/XMPP.hs @@ -14,20 +14,20 @@ -- along with this program. If not, see . module Network.Protocol.XMPP - ( + ( -- * JIDs JID (..) , Node , Domain , Resource - + , strNode , strDomain , strResource - + , parseJID , formatJID - + -- * Stanzas , Stanza ( stanzaTo @@ -36,7 +36,7 @@ module Network.Protocol.XMPP , stanzaLang , stanzaPayloads ) - + , ReceivedStanza (..) , Message (..) , Presence (..) @@ -44,11 +44,11 @@ module Network.Protocol.XMPP , MessageType (..) , PresenceType (..) , IQType (..) - + , emptyMessage , emptyPresence , emptyIQ - + -- * The XMPP monad , XMPP , Server (..) @@ -58,7 +58,7 @@ module Network.Protocol.XMPP , putStanza , getStanza , bindJID - + -- ** Resuming sessions , Session , getSession diff --git a/lib/Network/Protocol/XMPP/Client.hs b/lib/Network/Protocol/XMPP/Client.hs index 080a4ab..4bf6c27 100644 --- a/lib/Network/Protocol/XMPP/Client.hs +++ b/lib/Network/Protocol/XMPP/Client.hs @@ -50,7 +50,7 @@ runClient server jid username password xmpp = do rawHandle <- connectTo host port IO.hSetBuffering rawHandle IO.NoBuffering let handle = H.PlainHandle rawHandle - + -- Open the initial stream and authenticate M.startXMPP handle "jabber:client" $ do features <- newStream sjid @@ -100,28 +100,28 @@ bindJID jid = do >=> X.elementNodes >=> X.isContent >=> return . X.contentText - + let maybeJID = do iq <- case bindResult of ReceivedIQ x -> Just x _ -> Nothing payload <- iqPayload iq - + case getJID payload of [] -> Nothing (str:_) -> J.parseJID str - + returnedJID <- case maybeJID of Just x -> return x Nothing -> throwError (M.InvalidBindResult bindResult) - + -- Session M.putStanza sessionStanza void M.getStanza - + M.putStanza (emptyPresence PresenceAvailable) void M.getStanza - + return returnedJID bindStanza :: Maybe J.Resource -> IQ diff --git a/lib/Network/Protocol/XMPP/Client/Authentication.hs b/lib/Network/Protocol/XMPP/Client/Authentication.hs index 09f2271..0a715d1 100644 --- a/lib/Network/Protocol/XMPP/Client/Authentication.hs +++ b/lib/Network/Protocol/XMPP/Client/Authentication.hs @@ -53,7 +53,7 @@ authenticate xmppMechanisms userJID serverJID username password = xmpp where mechanisms = map SASL.Mechanism xmppMechanisms authz = formatJID (userJID { jidResource = Nothing }) hostname = formatJID serverJID - + xmpp = do ctx <- M.getSession res <- liftIO . Exc.try . SASL.runSASL $ do @@ -66,7 +66,7 @@ authenticate xmppMechanisms userJID serverJID username password = xmpp where Right (Failure e) -> E.throwError (M.AuthenticationFailure e) Left (XmppError err) -> E.throwError err Left (SaslError err) -> E.throwError (M.AuthenticationError err) - + authSasl ctx mechanism = do let (SASL.Mechanism mechBytes) = mechanism sessionResult <- SASL.runClient mechanism $ do @@ -75,16 +75,16 @@ authenticate xmppMechanisms userJID serverJID username password = xmpp where SASL.setProperty SASL.PropertyPassword (encodeUtf8 password) SASL.setProperty SASL.PropertyService "xmpp" SASL.setProperty SASL.PropertyHostname (encodeUtf8 hostname) - + (b64text, rc) <- SASL.step64 "" putElement ctx $ X.element "{urn:ietf:params:xml:ns:xmpp-sasl}auth" [("mechanism", Data.Text.pack (Data.ByteString.Char8.unpack mechBytes))] [X.NodeContent (X.ContentText (Data.Text.pack (Data.ByteString.Char8.unpack b64text)))] - + case rc of SASL.Complete -> saslFinish ctx SASL.NeedsMore -> saslLoop ctx - + case sessionResult of Right x -> return x Left err -> saslError (show err) @@ -106,7 +106,7 @@ saslLoop ctx = do case rc of SASL.Complete -> saslFinish ctx SASL.NeedsMore -> saslLoop ctx - + -- The server has authenticated this client, but the client-side -- SASL protocol wants more data from the server. n | n == "{urn:ietf:params:xml:ns:xmpp-sasl}success" -> do @@ -115,10 +115,10 @@ saslLoop ctx = do case rc of SASL.Complete -> return Success SASL.NeedsMore -> saslError "Server didn't provide enough SASL data." - + -- The server has rejected this client's credentials. n | n == "{urn:ietf:params:xml:ns:xmpp-sasl}failure" -> return (Failure e) - + _ -> saslError ("Server sent unexpected element during authentication.") saslFinish :: M.Session -> SASL.Session Result diff --git a/lib/Network/Protocol/XMPP/JID.hs b/lib/Network/Protocol/XMPP/JID.hs index 91745e0..72e3a6e 100644 --- a/lib/Network/Protocol/XMPP/JID.hs +++ b/lib/Network/Protocol/XMPP/JID.hs @@ -21,7 +21,7 @@ module Network.Protocol.XMPP.JID , Node (..) , Domain (..) , Resource (..) - + , parseJID , parseJID_ , formatJID diff --git a/lib/Network/Protocol/XMPP/Monad.hs b/lib/Network/Protocol/XMPP/Monad.hs index d29c149..3af2e11 100644 --- a/lib/Network/Protocol/XMPP/Monad.hs +++ b/lib/Network/Protocol/XMPP/Monad.hs @@ -23,15 +23,15 @@ module Network.Protocol.XMPP.Monad , runXMPP , startXMPP , restartXMPP - + , getHandle , getSession , sessionIsSecure - + , readEvents , getElement , getStanza - + , putBytes , putElement , putStanza @@ -62,20 +62,20 @@ data Error -- provided. It may contain additional information about why -- authentication failed. = AuthenticationFailure X.Element - + -- | There was an error while authenticating with the remote host. | AuthenticationError Text - + -- | An unrecognized or malformed 'S.Stanza' was received from the remote -- host. | InvalidStanza X.Element - + -- | The remote host sent an invalid reply to a resource bind request. | InvalidBindResult S.ReceivedStanza - + -- | There was an error with the underlying transport. | TransportError Text - + -- | The remote host did not send a stream ID when accepting a component -- connection. | NoComponentStreamID @@ -189,7 +189,7 @@ getElement = xmpp where case X.eventsToElement events of Just x -> return x Nothing -> E.throwError (TransportError "getElement: invalid event list") - + endOfTree 0 (X.EventEndElement _) = True endOfTree _ _ = False diff --git a/lib/Network/Protocol/XMPP/Stanza.hs b/lib/Network/Protocol/XMPP/Stanza.hs index 2024d24..72fd2ca 100644 --- a/lib/Network/Protocol/XMPP/Stanza.hs +++ b/lib/Network/Protocol/XMPP/Stanza.hs @@ -17,7 +17,7 @@ module Network.Protocol.XMPP.Stanza ( Stanza (..) - + , ReceivedStanza (..) , Message (..) , Presence (..) @@ -25,11 +25,11 @@ module Network.Protocol.XMPP.Stanza , MessageType (..) , PresenceType (..) , IQType (..) - + , emptyMessage , emptyPresence , emptyIQ - + , elementToStanza ) where @@ -204,7 +204,7 @@ elementToStanza :: Text -> X.Element -> Maybe ReceivedStanza elementToStanza ns elemt = do let elemNS = X.nameNamespace (X.elementName elemt) when (elemNS /= Just ns) Nothing - + let elemName = X.nameLocalName (X.elementName elemt) case elemName of "message" -> ReceivedMessage `fmap` parseMessage elemt @@ -241,7 +241,7 @@ parsePresence elemt = do "probe" -> Just PresenceProbe "error" -> Just PresenceError _ -> Nothing - + msgTo <- xmlJID "to" elemt msgFrom <- xmlJID "from" elemt let msgID = X.attributeText "id" elemt @@ -258,7 +258,7 @@ parseIQ elemt = do "result" -> Just IQResult "error" -> Just IQError _ -> Nothing - + msgTo <- xmlJID "to" elemt msgFrom <- xmlJID "from" elemt let msgID = X.attributeText "id" elemt diff --git a/lib/Network/Protocol/XMPP/XML.hs b/lib/Network/Protocol/XMPP/XML.hs index 9f10c2e..c7868a5 100644 --- a/lib/Network/Protocol/XMPP/XML.hs +++ b/lib/Network/Protocol/XMPP/XML.hs @@ -17,22 +17,22 @@ module Network.Protocol.XMPP.XML ( module Data.XML.Types - + -- * Constructors , element - + -- * Misc , contentText , escape , serialiseElement , readEvents - + -- * libxml-sax-0.4 API imitation , Parser , newParser , parse , eventsToElement - + ) where import Control.Monad (when) @@ -82,7 +82,7 @@ serialiseElement e = text where Nothing -> [] Just ns -> [mkattr "xmlns" ns] contents = Data.Text.concat (map serialiseNode (elementNodes e)) - + serialiseNode (NodeElement e') = serialiseElement e' serialiseNode (NodeContent c) = escape (contentText c) serialiseNode (NodeComment _) = "" @@ -96,21 +96,21 @@ newParser :: IO Parser newParser = do ref <- newIORef (Right []) p <- SAX.newParserIO Nothing - + let addEvent e = do x <- readIORef ref case x of Left _ -> return () Right es -> writeIORef ref (Right (e:es)) return True - + SAX.setCallback p SAX.parsedBeginElement (\name attrs -> addEvent (EventBeginElement name attrs)) SAX.setCallback p SAX.parsedEndElement (addEvent . EventEndElement) SAX.setCallback p SAX.parsedCharacters (addEvent . EventContent . ContentText) SAX.setCallback p SAX.parsedComment (addEvent . EventComment) SAX.setCallback p SAX.parsedInstruction (addEvent . EventInstruction) SAX.setCallback p SAX.reportError (\err -> writeIORef ref (Left err) >> return False) - + return (Parser p ref) parse :: Parser -> ByteString -> Bool -> IO (Either Text [Event]) @@ -134,7 +134,7 @@ readEvents done nextEvents = readEvents' 0 [] where if done' then return acc' else readEvents' depth' acc' - + step [] depth acc = (False, depth, acc) step (e:es) depth acc = let depth' = depth + case e of @@ -162,7 +162,7 @@ eventsToNodes = concatMap blockToNodes . splitBlocks splitBlocks :: [Event] -> [[Event]] splitBlocks es = ret where (_, _, ret) = foldl splitBlocks' (0, [], []) es - + splitBlocks' (depth, accum, allAccum) e = split where split = if depth' == 0 then (depth', [], allAccum ++ [accum']) @@ -182,5 +182,5 @@ blockToNodes (begin:rest) = nodes where (EventBeginElement name attrs, EventEndElement _) -> [node name attrs] (EventContent c, _) -> [NodeContent c] _ -> [] - + node n as = NodeElement (Element n as (eventsToNodes (init rest))) -- 2.45.2