From 1d54682baa1011e72cc1f816b1e798e9cc6825a4 Mon Sep 17 00:00:00 2001 From: Philipp Balzarek Date: Mon, 11 Jun 2012 20:00:50 +0200 Subject: [PATCH] rename JID to Jid remove sUsername, aAuthzid, sResource from XmppConnection add sJid to XmppConnection --- source/Network/Xmpp.hs | 4 +-- source/Network/Xmpp/Bind.hs | 4 +-- source/Network/Xmpp/Concurrent/IQ.hs | 4 +-- source/Network/Xmpp/IM/Presence.hs | 6 ++-- source/Network/Xmpp/{JID.hs => Jid.hs} | 24 +++++++-------- source/Network/Xmpp/Monad.hs | 39 +++++++++++------------- source/Network/Xmpp/Presence.hs | 2 +- source/Network/Xmpp/Types.hs | 42 ++++++++++++-------------- tests/Tests.hs | 9 +++--- 9 files changed, 64 insertions(+), 70 deletions(-) rename source/Network/Xmpp/{JID.hs => Jid.hs} (95%) diff --git a/source/Network/Xmpp.hs b/source/Network/Xmpp.hs index 11eacd6..b673831 100644 --- a/source/Network/Xmpp.hs +++ b/source/Network/Xmpp.hs @@ -43,7 +43,7 @@ module Network.Xmpp -- | A JID (historically: Jabber ID) is XMPPs native format -- for addressing entities in the network. It is somewhat similar to an e-mail -- address but contains three parts instead of two: - , JID(..) + , Jid(..) , isBare , isFull -- * Stanzas @@ -177,7 +177,7 @@ auth :: Text.Text -- ^ The username -> Text.Text -- ^ The password -> Maybe Text -- ^ The desired resource or 'Nothing' to let the server -- assign one - -> XmppConMonad (Either AuthError JID) + -> XmppConMonad (Either AuthError Jid) auth username passwd resource = runErrorT $ do ErrorT $ xmppSasl [scramSha1 username Nothing passwd] res <- lift $ xmppBind resource diff --git a/source/Network/Xmpp/Bind.hs b/source/Network/Xmpp/Bind.hs index e87ce0c..d09d82d 100644 --- a/source/Network/Xmpp/Bind.hs +++ b/source/Network/Xmpp/Bind.hs @@ -24,7 +24,7 @@ bindBody = pickleElem $ -- Sends a (synchronous) IQ set request for a (`Just') given or server-generated -- resource and extract the JID from the non-error response. -xmppBind :: Maybe Text -> XmppConMonad JID +xmppBind :: Maybe Text -> XmppConMonad Jid xmppBind rsrc = do answer <- xmppSendIQ' "bind" Nothing Set Nothing (bindBody rsrc) let Right IQResult{iqResultPayload = Just b} = answer -- TODO: Error handling @@ -32,7 +32,7 @@ xmppBind rsrc = do return jid where -- Extracts the character data in the `jid' element. - jidP :: PU [Node] JID + jidP :: PU [Node] Jid jidP = xpBind $ xpElemNodes "jid" (xpContent xpPrim) -- A `bind' element pickler. diff --git a/source/Network/Xmpp/Concurrent/IQ.hs b/source/Network/Xmpp/Concurrent/IQ.hs index 0441afa..0c2ccc4 100644 --- a/source/Network/Xmpp/Concurrent/IQ.hs +++ b/source/Network/Xmpp/Concurrent/IQ.hs @@ -13,7 +13,7 @@ import Network.Xmpp.Types -- | Sends an IQ, returns a 'TMVar' that will be filled with the first inbound -- IQ with a matching ID that has type @result@ or @error@. -sendIQ :: Maybe JID -- ^ Recipient (to) +sendIQ :: Maybe Jid -- ^ Recipient (to) -> IQRequestType -- ^ IQ type (@Get@ or @Set@) -> Maybe LangTag -- ^ Language tag of the payload (@Nothing@ for -- default) @@ -32,7 +32,7 @@ sendIQ to tp lang body = do -- TODO: Add timeout return ref -- | Like 'sendIQ', but waits for the answer IQ. -sendIQ' :: Maybe JID +sendIQ' :: Maybe Jid -> IQRequestType -> Maybe LangTag -> Element diff --git a/source/Network/Xmpp/IM/Presence.hs b/source/Network/Xmpp/IM/Presence.hs index c4f17ea..a999647 100644 --- a/source/Network/Xmpp/IM/Presence.hs +++ b/source/Network/Xmpp/IM/Presence.hs @@ -14,7 +14,7 @@ presence = Presence { presenceID = Nothing } -- | Request subscription with an entity. -presenceSubscribe :: JID -> Presence +presenceSubscribe :: Jid -> Presence presenceSubscribe to = presence { presenceTo = Just to , presenceType = Just Subscribe } @@ -24,7 +24,7 @@ isPresenceSubscribe :: Presence -> Bool isPresenceSubscribe pres = presenceType pres == (Just Subscribe) -- | Approve a subscripton of an entity. -presenceSubscribed :: JID -> Presence +presenceSubscribed :: Jid -> Presence presenceSubscribed to = presence { presenceTo = Just to , presenceType = Just Subscribed } @@ -34,7 +34,7 @@ isPresenceSubscribed :: Presence -> Bool isPresenceSubscribed pres = presenceType pres == (Just Subscribed) -- | End a subscription with an entity. -presenceUnsubscribe :: JID -> Presence +presenceUnsubscribe :: Jid -> Presence presenceUnsubscribe to = presence { presenceTo = Just to , presenceType = Just Unsubscribed } diff --git a/source/Network/Xmpp/JID.hs b/source/Network/Xmpp/Jid.hs similarity index 95% rename from source/Network/Xmpp/JID.hs rename to source/Network/Xmpp/Jid.hs index 06506c5..df1b889 100644 --- a/source/Network/Xmpp/JID.hs +++ b/source/Network/Xmpp/Jid.hs @@ -3,8 +3,8 @@ -- This module deals with JIDs, also known as XMPP addresses. For more -- information on JIDs, see RFC 6122: XMPP: Address Format. -module Network.Xmpp.JID - ( JID(..) +module Network.Xmpp.Jid + ( Jid(..) , fromText , fromStrings , isBare @@ -23,7 +23,7 @@ import qualified Data.Text as Text import qualified Text.NamePrep as SP import qualified Text.StringPrep as SP -data JID = JID { -- | The @localpart@ of a JID is an optional identifier placed +data Jid = Jid { -- | The @localpart@ of a JID is an optional identifier placed -- before the domainpart and separated from the latter by a -- \'\@\' character. Typically a localpart uniquely identifies -- the entity requesting and using network access provided by a @@ -56,21 +56,21 @@ data JID = JID { -- | The @localpart@ of a JID is an optional identifier placed , resourcepart :: !(Maybe Text) } deriving Eq -instance Show JID where - show (JID nd dmn res) = +instance Show Jid where + show (Jid nd dmn res) = maybe "" ((++ "@") . Text.unpack) nd ++ Text.unpack dmn ++ maybe "" (('/' :) . Text.unpack) res -instance Read JID where +instance Read Jid where readsPrec _ x = case fromText (Text.pack x) of Nothing -> [] Just j -> [(j,"")] -instance IsString JID where +instance IsString Jid where fromString = fromJust . fromText . Text.pack -- | Converts a Text to a JID. -fromText :: Text -> Maybe JID +fromText :: Text -> Maybe Jid fromText t = do (l, d, r) <- eitherToMaybe $ AP.parseOnly jidParts t fromStrings l d r @@ -79,7 +79,7 @@ fromText t = do -- | Converts localpart, domainpart, and resourcepart strings to a JID. Runs the -- appropriate stringprep profiles and validates the parts. -fromStrings :: Maybe Text -> Text -> Maybe Text -> Maybe JID +fromStrings :: Maybe Text -> Text -> Maybe Text -> Maybe Jid fromStrings l d r = do localPart <- case l of Nothing -> return Nothing @@ -97,7 +97,7 @@ fromStrings l d r = do r'' <- SP.runStringPrep resourceprepProfile r' guard $ validPartLength r'' return $ Just r'' - return $ JID localPart domainPart resourcePart + return $ Jid localPart domainPart resourcePart where validDomainPart :: Text -> Bool validDomainPart _s = True -- TODO @@ -106,12 +106,12 @@ fromStrings l d r = do validPartLength p = Text.length p > 0 && Text.length p < 1024 -- | Returns True if the JID is /bare/, and False otherwise. -isBare :: JID -> Bool +isBare :: Jid -> Bool isBare j | resourcepart j == Nothing = True | otherwise = False -- | Returns True if the JID is 'full', and False otherwise. -isFull :: JID -> Bool +isFull :: Jid -> Bool isFull = not . isBare -- Parses an JID string and returns its three parts. It performs no validation diff --git a/source/Network/Xmpp/Monad.hs b/source/Network/Xmpp/Monad.hs index 9843eb7..075b3cb 100644 --- a/source/Network/Xmpp/Monad.hs +++ b/source/Network/Xmpp/Monad.hs @@ -92,16 +92,14 @@ catchPush p = Ex.catch -- XmppConnection state used when there is no connection. xmppNoConnection :: XmppConnection xmppNoConnection = XmppConnection - { sConSrc = zeroSource - , sRawSrc = zeroSource - , sConPushBS = \_ -> return False -- Nothing has been sent. - , sConHandle = Nothing - , sFeatures = SF Nothing [] [] + { sConSrc = zeroSource + , sRawSrc = zeroSource + , sConPushBS = \_ -> return False -- Nothing has been sent. + , sConHandle = Nothing + , sFeatures = SF Nothing [] [] , sConnectionState = XmppConnectionClosed - , sHostname = Nothing - , sAuthzid = Nothing - , sUsername = Nothing - , sResource = Nothing + , sHostname = Nothing + , sJid = Nothing , sCloseConnection = return () } where @@ -119,17 +117,16 @@ xmppRawConnect host hostname = do let raw = sourceHandle con src <- liftIO . bufferSource $ raw $= XP.parseBytes def let st = XmppConnection - src - raw - (catchPush . BS.hPut con) - (Just con) - (SF Nothing [] []) - XmppConnectionPlain - (Just hostname) - Nothing - Nothing - Nothing - (hClose con) + { sConSrc = src + , sRawSrc = raw + , sConPushBS = (catchPush . BS.hPut con) + , sConHandle = (Just con) + , sFeatures = (SF Nothing [] []) + , sConnectionState = XmppConnectionPlain + , sHostname = (Just hostname) + , sJid = Nothing + , sCloseConnection = (hClose con) + } put st -- Execute a XmppConMonad computation. @@ -146,7 +143,7 @@ xmppKillConnection = do -- Sends an IQ request and waits for the response. If the response ID does not -- match the outgoing ID, an error is thrown. xmppSendIQ' :: StanzaId - -> Maybe JID + -> Maybe Jid -> IQRequestType -> Maybe LangTag -> Element diff --git a/source/Network/Xmpp/Presence.hs b/source/Network/Xmpp/Presence.hs index 6bb319b..c859f14 100644 --- a/source/Network/Xmpp/Presence.hs +++ b/source/Network/Xmpp/Presence.hs @@ -6,5 +6,5 @@ import Data.Text(Text) import Network.Xmpp.Types -- | Add a recipient to a presence notification. -presTo :: Presence -> JID -> Presence +presTo :: Presence -> Jid -> Presence presTo pres to = pres{presenceTo = Just to} \ No newline at end of file diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs index 087874b..a407983 100644 --- a/source/Network/Xmpp/Types.hs +++ b/source/Network/Xmpp/Types.hs @@ -38,7 +38,7 @@ module Network.Xmpp.Types , XmppT(..) , XmppStreamError(..) , parseLangTag - , module Network.Xmpp.JID + , module Network.Xmpp.Jid ) where @@ -60,7 +60,7 @@ import Data.XML.Types import qualified Network as N -import Network.Xmpp.JID +import Network.Xmpp.Jid import System.IO @@ -93,8 +93,8 @@ data Stanza = IQRequestS IQRequest -- | A "request" Info/Query (IQ) stanza is one with either "get" or "set" as -- type. They are guaranteed to always contain a payload. data IQRequest = IQRequest { iqRequestID :: StanzaId - , iqRequestFrom :: Maybe JID - , iqRequestTo :: Maybe JID + , iqRequestFrom :: Maybe Jid + , iqRequestTo :: Maybe Jid , iqRequestLangTag :: Maybe LangTag , iqRequestType :: IQRequestType , iqRequestPayload :: Element @@ -118,16 +118,16 @@ type IQResponse = Either IQError IQResult -- | The (non-error) answer to an IQ request. data IQResult = IQResult { iqResultID :: StanzaId - , iqResultFrom :: Maybe JID - , iqResultTo :: Maybe JID + , iqResultFrom :: Maybe Jid + , iqResultTo :: Maybe Jid , iqResultLangTag :: Maybe LangTag , iqResultPayload :: Maybe Element } deriving Show -- | The answer to an IQ request that generated an error. data IQError = IQError { iqErrorID :: StanzaId - , iqErrorFrom :: Maybe JID - , iqErrorTo :: Maybe JID + , iqErrorFrom :: Maybe Jid + , iqErrorTo :: Maybe Jid , iqErrorLangTag :: Maybe LangTag , iqErrorStanzaError :: StanzaError , iqErrorPayload :: Maybe Element -- should this be []? @@ -135,8 +135,8 @@ data IQError = IQError { iqErrorID :: StanzaId -- | The message stanza. Used for /push/ type communication. data Message = Message { messageID :: Maybe StanzaId - , messageFrom :: Maybe JID - , messageTo :: Maybe JID + , messageFrom :: Maybe Jid + , messageTo :: Maybe Jid , messageLangTag :: Maybe LangTag , messageType :: MessageType , messagePayload :: [Element] @@ -144,8 +144,8 @@ data Message = Message { messageID :: Maybe StanzaId -- | An error stanza generated in response to a 'Message'. data MessageError = MessageError { messageErrorID :: Maybe StanzaId - , messageErrorFrom :: Maybe JID - , messageErrorTo :: Maybe JID + , messageErrorFrom :: Maybe Jid + , messageErrorTo :: Maybe Jid , messageErrorLangTag :: Maybe LangTag , messageErrorStanzaError :: StanzaError , messageErrorPayload :: [Element] @@ -204,8 +204,8 @@ instance Read MessageType where -- | The presence stanza. Used for communicating status updates. data Presence = Presence { presenceID :: Maybe StanzaId - , presenceFrom :: Maybe JID - , presenceTo :: Maybe JID + , presenceFrom :: Maybe Jid + , presenceTo :: Maybe Jid , presenceLangTag :: Maybe LangTag , presenceType :: Maybe PresenceType , presencePayload :: [Element] @@ -214,8 +214,8 @@ data Presence = Presence { presenceID :: Maybe StanzaId -- | An error stanza generated in response to a 'Presence'. data PresenceError = PresenceError { presenceErrorID :: Maybe StanzaId - , presenceErrorFrom :: Maybe JID - , presenceErrorTo :: Maybe JID + , presenceErrorFrom :: Maybe Jid + , presenceErrorTo :: Maybe Jid , presenceErrorLangTag :: Maybe LangTag , presenceErrorStanzaError :: StanzaError , presenceErrorPayload :: [Element] @@ -324,7 +324,7 @@ data StanzaErrorCondition = BadRequest -- ^ Malformed XML. -- address. | InternalServerError | ItemNotFound - | JIDMalformed + | JidMalformed | NotAcceptable -- ^ Does not meet policy -- criteria. | NotAllowed -- ^ No entity may perform @@ -357,7 +357,7 @@ instance Show StanzaErrorCondition where show Gone = "gone" show InternalServerError = "internal-server-error" show ItemNotFound = "item-not-found" - show JIDMalformed = "jid-malformed" + show JidMalformed = "jid-malformed" show NotAcceptable = "not-acceptable" show NotAllowed = "not-allowed" show NotAuthorized = "not-authorized" @@ -381,7 +381,7 @@ instance Read StanzaErrorCondition where readsPrec _ "gone" = [(Gone , "")] readsPrec _ "internal-server-error" = [(InternalServerError , "")] readsPrec _ "item-not-found" = [(ItemNotFound , "")] - readsPrec _ "jid-malformed" = [(JIDMalformed , "")] + readsPrec _ "jid-malformed" = [(JidMalformed , "")] readsPrec _ "not-acceptable" = [(NotAcceptable , "")] readsPrec _ "not-allowed" = [(NotAllowed , "")] readsPrec _ "not-authorized" = [(NotAuthorized , "")] @@ -654,9 +654,7 @@ data XmppConnection = XmppConnection , sFeatures :: ServerFeatures , sConnectionState :: XmppConnectionState , sHostname :: Maybe Text - , sUsername :: Maybe Text - , sAuthzid :: Maybe Text - , sResource :: Maybe Text + , sJid :: Maybe Jid , sCloseConnection :: IO () -- TODO: add default Language } diff --git a/tests/Tests.hs b/tests/Tests.hs index 47f5ea3..7f5b3c1 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -19,13 +19,13 @@ import Network.Xmpp.Pickle import System.Environment import Text.XML.Stream.Elements -testUser1 :: JID +testUser1 :: Jid testUser1 = read "testuser1@species64739.dyndns.org/bot1" -testUser2 :: JID +testUser2 :: Jid testUser2 = read "testuser2@species64739.dyndns.org/bot2" -supervisor :: JID +supervisor :: Jid supervisor = read "uart14@species64739.dyndns.org" @@ -75,7 +75,7 @@ autoAccept = forever $ do st <- waitForPresence isPresenceSubscribe sendPresence $ presenceSubscribed (fromJust $ presenceFrom st) -simpleMessage :: JID -> Text -> Message +simpleMessage :: Jid -> Text -> Message simpleMessage to txt = message { messageTo = Just to , messagePayload = [Element "body" @@ -161,4 +161,3 @@ run i = do runMain debugOut (2 + i) main = run 0 -