Browse Source

rename JID to Jid

remove sUsername, aAuthzid, sResource from XmppConnection
add sJid to XmppConnection
master
Philipp Balzarek 14 years ago
parent
commit
1d54682baa
  1. 4
      source/Network/Xmpp.hs
  2. 4
      source/Network/Xmpp/Bind.hs
  3. 4
      source/Network/Xmpp/Concurrent/IQ.hs
  4. 6
      source/Network/Xmpp/IM/Presence.hs
  5. 24
      source/Network/Xmpp/Jid.hs
  6. 27
      source/Network/Xmpp/Monad.hs
  7. 2
      source/Network/Xmpp/Presence.hs
  8. 42
      source/Network/Xmpp/Types.hs
  9. 9
      tests/Tests.hs

4
source/Network/Xmpp.hs

@ -43,7 +43,7 @@ module Network.Xmpp @@ -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 @@ -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

4
source/Network/Xmpp/Bind.hs

@ -24,7 +24,7 @@ bindBody = pickleElem $ @@ -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 @@ -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.

4
source/Network/Xmpp/Concurrent/IQ.hs

@ -13,7 +13,7 @@ import Network.Xmpp.Types @@ -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 @@ -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

6
source/Network/Xmpp/IM/Presence.hs

@ -14,7 +14,7 @@ presence = Presence { presenceID = Nothing @@ -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 @@ -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 @@ -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
}

24
source/Network/Xmpp/JID.hs → source/Network/Xmpp/Jid.hs

@ -3,8 +3,8 @@ @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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

27
source/Network/Xmpp/Monad.hs

@ -99,9 +99,7 @@ xmppNoConnection = XmppConnection @@ -99,9 +99,7 @@ xmppNoConnection = XmppConnection
, sFeatures = SF Nothing [] []
, sConnectionState = XmppConnectionClosed
, sHostname = Nothing
, sAuthzid = Nothing
, sUsername = Nothing
, sResource = Nothing
, sJid = Nothing
, sCloseConnection = return ()
}
where
@ -119,17 +117,16 @@ xmppRawConnect host hostname = do @@ -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 @@ -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

2
source/Network/Xmpp/Presence.hs

@ -6,5 +6,5 @@ import Data.Text(Text) @@ -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}

42
source/Network/Xmpp/Types.hs

@ -38,7 +38,7 @@ module Network.Xmpp.Types @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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. @@ -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 @@ -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 @@ -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 @@ -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
}

9
tests/Tests.hs

@ -19,13 +19,13 @@ import Network.Xmpp.Pickle @@ -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 @@ -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 @@ -161,4 +161,3 @@ run i = do
runMain debugOut (2 + i)
main = run 0

Loading…
Cancel
Save