Merge branch 'master' of https://github.com/nejla/pontarius

Conflicts:
	src/Network/XMPP/Bind.hs

src/Network/XMPP/Address.hs

@@ -1,189 +0,0 @@
--- Copyright © 2010-2012 Jon Kristensen. See the LICENSE file in the
--- Pontarius distribution for more details.
-
-{-# OPTIONS_HADDOCK hide #-}
-
--- TODO: When no longer using stringprep, do appropriate testing. (Including
--- testing addresses like a@b/c@d/e, a/b@c, a@/b, a/@b...)
-
--- TODO: Unicode 3.2 should be used.
-
-
--- This module deals with XMPP addresses (also known as JIDs and JabberIDs). For
--- more information on XMPP addresses, see RFC 6122: XMPP: Address Format.
---
--- This module does not internationalize hostnames.
-
-
-module Network.XMPP.Address (fromString, fromStrings, isBare, isFull) where
-
-import Network.XMPP.Types
-
-import Data.Maybe (fromJust, isJust)
-import Text.Parsec ((<|>), anyToken, char, eof, many, noneOf, parse)
-import Text.Parsec.ByteString (GenParser)
-
-import Text.StringPrep (StringPrepProfile (..), a1, b1, b2, c11, c12, c21, c22,
-                        c3, c4, c5, c6, c7, c8, c9, runStringPrep)
-import Text.NamePrep (namePrepProfile)
-
-import Network.URI (isIPv4address, isIPv6address)
-
-import qualified Data.ByteString.Char8 as DBC (pack)
-import qualified Data.Text as DT (pack, unpack)
-
-
--- |
--- Converts a string to an XMPP address.
-
-fromString :: String -> Maybe Address
-
-fromString s = fromStrings localpart domainpart resourcepart
-    where
-        Right (localpart, domainpart, resourcepart) =
-            parse addressParts "" (DBC.pack s)
-
-
--- |
--- Converts localpart, domainpart, and resourcepart strings to an XMPP address.
-
--- Runs the appropriate stringprep profiles and validates the parts.
-
-fromStrings :: Maybe String -> String -> Maybe String -> Maybe Address
-
-fromStrings l s r
-    | domainpart == Nothing = Nothing
-    | otherwise = if validateNonDomainpart localpart &&
-                     isJust domainpart' &&
-                     validateNonDomainpart resourcepart
-                  then Just (Address localpart (fromJust domainpart') resourcepart)
-                  else Nothing
-    where
-
-        -- Applies the nodeprep profile on the localpart string, if any.
-        localpart :: Maybe String
-        localpart = case l of
-            Just l' -> case runStringPrep nodeprepProfile (DT.pack l') of
-                Just l'' -> Just $ DT.unpack l''
-                Nothing -> Nothing
-            Nothing -> Nothing
-
-        -- Applies the nameprep profile on the domainpart string.
-        -- TODO: Allow unassigned?
-        domainpart :: Maybe String
-        domainpart = case runStringPrep (namePrepProfile False) (DT.pack s) of
-            Just s' -> Just $ DT.unpack s'
-            Nothing -> Nothing
-
-        -- Applies the resourceprep profile on the resourcepart string, if any.
-        resourcepart :: Maybe String
-        resourcepart = case r of
-            Just r' -> case runStringPrep resourceprepProfile (DT.pack r') of
-                Just r'' -> Just $ DT.unpack r''
-                Nothing -> Nothing
-            Nothing -> Nothing
-
-        -- Returns the domainpart if it was a valid IP or if the toASCII
-        -- function was successful, or Nothing otherwise.
-        domainpart' :: Maybe String
-        domainpart' | isIPv4address s || isIPv6address s = Just s
-                    | validHostname s = Just s
-                    | otherwise = Nothing
-
-        -- Validates that non-domainpart strings have an appropriate length.
-        validateNonDomainpart :: Maybe String -> Bool
-        validateNonDomainpart Nothing = True
-        validateNonDomainpart (Just l) = validPartLength l
-            where
-                validPartLength :: String -> Bool
-                validPartLength p = length p > 0 && length p < 1024
-
-        -- Validates a host name
-        validHostname :: String -> Bool
-        validHostname _ = True -- TODO
-
-
--- | Returns True if the address is `bare', and False otherwise.
-
-isBare :: Address -> Bool
-
-isBare j | resourcepart j == Nothing = True
-         | otherwise                 = False
-
-
--- | Returns True if the address is `full', and False otherwise.
-
-isFull :: Address -> Bool
-
-isFull jid = not $ isBare jid
-
-
--- Parses an address string and returns its three parts. It performs no
--- validation or transformations. We are using Parsec to parse the address.
--- There is no input for which 'addressParts' fails.
-
-addressParts :: GenParser Char st (Maybe String, String, Maybe String)
-
-addressParts = do
-
-    -- Read until we reach an '@', a '/', or EOF.
-    a <- many $ noneOf ['@', '/']
-
-    -- Case 1: We found an '@', and thus the localpart. At least the domainpart
-    -- is remaining. Read the '@' and until a '/' or EOF.
-    do
-        char '@'
-        b <- many $ noneOf ['/']
-
-        -- Case 1A: We found a '/' and thus have all the address parts. Read the
-        -- '/' and until EOF.
-        do
-            char '/' -- Resourcepart remaining
-            c <- many $ anyToken -- Parse resourcepart
-            eof
-            return (Just a, b, Just c)
-
-        -- Case 1B: We have reached EOF; the address is in the form
-        -- localpart@domainpart.
-            <|> do
-                eof
-                return (Just a, b, Nothing)
-
-        -- Case 2: We found a '/'; the address is in the form
-        -- domainpart/resourcepart.
-        <|> do
-            char '/'
-            b <- many $ anyToken
-            eof
-            return (Nothing, a, Just b)
-
-        -- Case 3: We have reached EOF; we have an address consisting of only a
-        -- domainpart.
-        <|> do
-            eof
-            return (Nothing, a, Nothing)
-
-
-nodeprepProfile :: StringPrepProfile
-
-nodeprepProfile = Profile { maps = [b1, b2]
-                          , shouldNormalize = True
-                          , prohibited = [a1] ++ [c11, c12, c21, c22, c3, c4, c5, c6, c7, c8, c9]
-                          , shouldCheckBidi = True }
-
-
--- These needs to be checked for after normalization. We could also look up the
--- Unicode mappings and include a list of characters in the prohibited field
--- above. Let's defer that until we know that we are going to use stringprep.
-
-nodeprepExtraProhibitedCharacters = ['\x22', '\x26', '\x27', '\x2F', '\x3A',
-                                     '\x3C', '\x3E', '\x40']
-
-
-
-resourceprepProfile :: StringPrepProfile
-
-resourceprepProfile = Profile { maps = [b1]
-                          , shouldNormalize = True
-                          , prohibited = [a1] ++ [c12, c21, c22, c3, c4, c5, c6, c7, c8, c9]
-                          , shouldCheckBidi = True }

src/Network/XMPP/Bind.hs

@@ -1,5 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
+-- TODO: Allow the client to retry the bind with another resource
+
 module Network.XMPP.Bind where
 
 import Data.Text as Text
@@ -11,24 +13,36 @@ import Network.XMPP.Types
 import Network.XMPP.Pickle
 import Network.XMPP.Concurrent
 
+
+-- A `bind' element.
+
 bindP  :: PU [Node] b -> PU [Node] b
 bindP c = xpElemNodes "{urn:ietf:params:xml:ns:xmpp-bind}bind" c
 
+
+-- If the (optional resource) parameter is a `Just' value, a
+-- `resource' child element will be added to the `bind' element.
+
 bindBody :: Maybe Text -> Element
 bindBody rsrc = (pickleElem
                     (bindP . xpOption $ xpElemNodes "resource" (xpContent xpId))
                      rsrc
                  )
 
+
+-- Extracts the character data in the `jid' element.
+
 jidP :: PU [Node] JID
 jidP = bindP $ xpElemNodes "jid" (xpContent xpPrim)
 
+
+-- Sends a (synchronous) IQ set request for a (`Just') given or
+-- server-generated resource and extract the JID from the non-error
+-- response.
+
 xmppThreadedBind  :: Maybe Text -> XMPPThread Text
 xmppThreadedBind rsrc = do
    answer <- sendIQ' Nothing Set Nothing (bindBody rsrc)
    let (Right IQResult{iqResultPayload = Just b}) = answer -- TODO: Error handling
    let Right (JID _n _d (Just r)) = unpickleElem jidP b
    return r
-
-
-

src/Network/XMPP/JID.hs

@@ -0,0 +1,197 @@
+-- Copyright © 2010-2012 Jon Kristensen. See the LICENSE file in the
+-- Pontarius distribution for more details.
+
+{-# OPTIONS_HADDOCK hide #-}
+
+-- TODO: When no longer using stringprep, do appropriate testing.
+-- (Including testing addresses like a@b/c@d/e, a/b@c, a@/b, a/@b...)
+-- Will we not be using stringprep?
+
+-- TODO: Unicode 3.2 should be used.
+
+
+-- This module deals with XMPP addresses, also known as JIDs. For more
+-- information on JIDs, see RFC 6122: XMPP: Address Format.
+--
+-- This module does not internationalize hostnames.
+
+
+module Network.XMPP.JID (fromString, fromStrings, isBare, isFull) where
+
+import Network.XMPP.Types
+
+import Data.Maybe (fromJust, isJust)
+import Text.Parsec ((<|>), anyToken, char, eof, many, noneOf, parse)
+import Text.Parsec.ByteString (GenParser)
+
+import Text.StringPrep (StringPrepProfile (..), a1, b1, b2, c11, c12, c21, c22,
+                        c3, c4, c5, c6, c7, c8, c9, runStringPrep)
+import Text.NamePrep (namePrepProfile)
+
+import Network.URI (isIPv4address, isIPv6address)
+
+import qualified Data.ByteString.Char8 as DBC (pack)
+import qualified Data.Text as DT (pack, unpack)
+
+
+-- |
+-- Converts a string to a JID.
+
+fromString :: String -> Maybe JID
+
+fromString s = fromStrings localpart domainpart resourcepart
+    where
+        Right (localpart, domainpart, resourcepart) =
+            parse jidParts "" (DBC.pack s)
+
+
+-- |
+-- Converts localpart, domainpart, and resourcepart strings to a JID.
+
+-- Runs the appropriate stringprep profiles and validates the parts.
+
+fromStrings :: Maybe String -> String -> Maybe String -> Maybe JID
+
+fromStrings l s r
+  | domainpart == Nothing = Nothing
+  | otherwise = if validateNonDomainpart localpart &&
+                   isJust domainpart' &&
+                   validateNonDomainpart resourcepart
+                then Just (JID localpart (fromJust domainpart') resourcepart)
+                else Nothing
+  where
+    
+    -- Applies the nodeprep profile on the localpart string, if any.
+    localpart :: Maybe String
+    localpart = case l of
+      Just l' -> case runStringPrep nodeprepProfile (DT.pack l') of
+        Just l'' -> Just $ DT.unpack l''
+        Nothing -> Nothing
+      Nothing -> Nothing
+
+    -- Applies the nameprep profile on the domainpart string.
+    -- TODO: Allow unassigned?
+    domainpart :: Maybe String
+    domainpart = case runStringPrep (namePrepProfile False) (DT.pack s) of
+      Just s' -> Just $ DT.unpack s'
+      Nothing -> Nothing
+
+    -- Applies the resourceprep profile on the resourcepart string, if
+    -- any.
+    resourcepart :: Maybe String
+    resourcepart = case r of
+      Just r' -> case runStringPrep resourceprepProfile (DT.pack r') of
+        Just r'' -> Just $ DT.unpack r''
+        Nothing -> Nothing
+      Nothing -> Nothing
+
+    -- Returns the domainpart if it was a valid IP or if the toASCII
+    -- function was successful, or Nothing otherwise.
+    domainpart' :: Maybe String
+    domainpart' | isIPv4address s || isIPv6address s = Just s
+                | validHostname s = Just s
+                | otherwise = Nothing
+
+    -- Validates that non-domainpart strings have an appropriate
+    -- length.
+    validateNonDomainpart :: Maybe String -> Bool
+    validateNonDomainpart Nothing = True
+    validateNonDomainpart (Just l) = validPartLength l
+      where
+        validPartLength :: String -> Bool
+        validPartLength p = length p > 0 && length p < 1024
+
+    -- Validates a host name
+    validHostname :: String -> Bool
+    validHostname _ = True -- TODO
+
+
+-- | Returns True if the JID is `bare', and False otherwise.
+
+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 = not $ isBare jid
+
+
+-- Parses an JID string and returns its three parts. It performs no
+-- validation or transformations. We are using Parsec to parse the
+-- JIDs. There is no input for which 'jidParts' fails.
+
+jidParts :: GenParser Char st (Maybe String, String, Maybe String)
+
+jidParts = do
+
+  -- Read until we reach an '@', a '/', or EOF.
+  a <- many $ noneOf ['@', '/']
+
+  -- Case 1: We found an '@', and thus the localpart. At least the
+  -- domainpart is remaining. Read the '@' and until a '/' or EOF.
+  do
+    char '@'
+    b <- many $ noneOf ['/']
+
+    -- Case 1A: We found a '/' and thus have all the JID parts. Read
+    -- the '/' and until EOF.
+    do
+      char '/' -- Resourcepart remaining
+      c <- many $ anyToken -- Parse resourcepart
+      eof
+      return (Just a, b, Just c)
+
+    -- Case 1B: We have reached EOF; the JID is in the form
+    -- localpart@domainpart.
+      <|> do
+        eof
+        return (Just a, b, Nothing)
+
+    -- Case 2: We found a '/'; the JID is in the form
+    -- domainpart/resourcepart.
+    <|> do
+      char '/'
+      b <- many $ anyToken
+      eof
+      return (Nothing, a, Just b)
+
+    -- Case 3: We have reached EOF; we have an JID consisting of only
+    -- a domainpart.
+    <|> do
+      eof
+      return (Nothing, a, Nothing)
+
+
+nodeprepProfile :: StringPrepProfile
+
+nodeprepProfile = Profile { maps = [b1, b2]
+                          , shouldNormalize = True
+                          , prohibited = [a1] ++ [c11, c12, c21, c22,
+                                                  c3, c4, c5, c6, c7,
+                                                  c8, c9]
+                          , shouldCheckBidi = True }
+
+
+-- These needs to be checked for after normalization. We could also
+-- look up the Unicode mappings and include a list of characters in
+-- the prohibited field above. Let's defer that until we know that we
+-- are going to use stringprep.
+
+nodeprepExtraProhibitedCharacters = ['\x22', '\x26', '\x27', '\x2F',
+                                     '\x3A', '\x3C', '\x3E', '\x40']
+
+
+
+resourceprepProfile :: StringPrepProfile
+
+resourceprepProfile = Profile { maps = [b1]
+                              , shouldNormalize = True
+                              , prohibited = [a1] ++ [c12, c21, c22,
+                                                      c3, c4, c5, c6,
+                                                      c7, c8, c9]
+                              , shouldCheckBidi = True }