From 1c5203204cbf9aeb72a38f2090f3f99998bff63f Mon Sep 17 00:00:00 2001
From: Philipp Balzarek <p.balzarek@googlemail.com>
Date: Fri, 22 Mar 2013 13:16:21 +0100
Subject: [PATCH] move host name checks from Network.Xmpp.Types to
 Network.Xmpp.Utilities

---
 source/Network/Xmpp/Types.hs     | 34 ++++------------------------
 source/Network/Xmpp/Utilities.hs | 39 ++++++++++++++++++++++++++++----
 2 files changed, 39 insertions(+), 34 deletions(-)

diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs
index 8f4e9e1..cc6e166 100644
--- a/source/Network/Xmpp/Types.hs
+++ b/source/Network/Xmpp/Types.hs
@@ -47,7 +47,6 @@ module Network.Xmpp.Types
     , jidFromTexts
     , StreamEnd(..)
     , InvalidXmppXml(..)
-    , checkHostName
     , SessionConfiguration(..)
     , TlsBehaviour(..)
     )
@@ -1055,32 +1054,6 @@ instance Default StreamConfiguration where
                                                                 }
                               }
 
--- | Validates the hostname string in accordance with RFC 1123.
-checkHostName :: Text -> Maybe Text
-checkHostName t = do
-    eitherToMaybeHostName $ AP.parseOnly hostnameP t
-  where
-    eitherToMaybeHostName = either (const Nothing) Just
-
--- Validation of RFC 1123 hostnames.
-hostnameP :: AP.Parser Text
-hostnameP = do
-    -- Hostnames may not begin with a hyphen.
-    h <- AP.satisfy $ AP.inClass $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9']
-    t <- AP.takeWhile $ AP.inClass $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ ['-']
-    let label = Text.concat [Text.pack [h], t]
-    if Text.length label > 63
-        then fail "Label too long."
-        else do
-            AP.endOfInput
-            return label
-            <|> do
-                _ <- AP.satisfy (== '.')
-                r <- hostnameP
-                if (Text.length label) + 1 + (Text.length r) > 255
-                    then fail "Hostname too long."
-                    else return $ Text.concat [label, Text.pack ".", r]
-
 type StanzaHandler =  TChan Stanza -- ^ outgoing stanza
                    -> Stanza       -- ^ stanza to handle
                    -> IO Bool      -- ^ True when processing should continue
@@ -1090,10 +1063,11 @@ data SessionConfiguration = SessionConfiguration
     { -- | Configuration for the @Stream@ object.
       sessionStreamConfiguration :: StreamConfiguration
       -- | Handler to be run when the session ends (for whatever reason).
-    , sessionClosedHandler :: XmppFailure -> IO ()
+    , sessionClosedHandler       :: XmppFailure -> IO ()
       -- | Function to generate the stream of stanza identifiers.
-    , sessionStanzaIDs :: IO (IO StanzaID)
-    , extraStanzaHandlers   :: [StanzaHandler]
+    , sessionStanzaIDs           :: IO (IO StanzaID)
+    , extraStanzaHandlers        :: [StanzaHandler]
+    , enableRoster               :: Bool
     }
 
 instance Default SessionConfiguration where
diff --git a/source/Network/Xmpp/Utilities.hs b/source/Network/Xmpp/Utilities.hs
index c11d58e..eef3c98 100644
--- a/source/Network/Xmpp/Utilities.hs
+++ b/source/Network/Xmpp/Utilities.hs
@@ -9,17 +9,22 @@ module Network.Xmpp.Utilities
     , answerMessage
     , openElementToEvents
     , renderOpenElement
-    , renderElement)
+    , renderElement
+    , checkHostName
+    )
     where
 
-import           Network.Xmpp.Types
-import           Prelude
-import           Data.XML.Types
+import           Control.Applicative ((<|>))
+import qualified Data.Attoparsec.Text as AP
 import qualified Data.ByteString as BS
 import           Data.Conduit as C
 import           Data.Conduit.List as CL
 import qualified Data.Text as Text
+import           Data.Text(Text)
 import qualified Data.Text.Encoding as Text
+import           Data.XML.Types
+import           Network.Xmpp.Types
+import           Prelude
 import           System.IO.Unsafe(unsafePerformIO)
 import qualified Text.XML.Stream.Render as TXSR
 import           Text.XML.Unresolved as TXU
@@ -77,3 +82,29 @@ renderElement e = Text.encodeUtf8 . Text.concat . unsafePerformIO
     elementToEvents :: Element -> [Event]
     elementToEvents el@(Element name _ _) = openElementToEvents el
                                               ++ [EventEndElement name]
+
+-- | Validates the hostname string in accordance with RFC 1123.
+checkHostName :: Text -> Maybe Text
+checkHostName t = do
+    eitherToMaybeHostName $ AP.parseOnly hostnameP t
+  where
+    eitherToMaybeHostName = either (const Nothing) Just
+
+-- Validation of RFC 1123 hostnames.
+hostnameP :: AP.Parser Text
+hostnameP = do
+    -- Hostnames may not begin with a hyphen.
+    h <- AP.satisfy $ AP.inClass $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9']
+    t <- AP.takeWhile $ AP.inClass $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ ['-']
+    let label = Text.concat [Text.pack [h], t]
+    if Text.length label > 63
+        then fail "Label too long."
+        else do
+            AP.endOfInput
+            return label
+            <|> do
+                _ <- AP.satisfy (== '.')
+                r <- hostnameP
+                if (Text.length label) + 1 + (Text.length r) > 255
+                    then fail "Hostname too long."
+                    else return $ Text.concat [label, Text.pack ".", r]