2 files changed, 16 insertions(+), 37 deletions(-)

M Network/Protocol/XMPP/JID.hs
M network-protocol-xmpp.cabal

@@ 25,9 25,7 @@ module Network.Protocol.XMPP.JID
 	, formatJID
 	) where
 import qualified Data.Text as T
-import qualified Text.StringPrep as SP
-import Text.NamePrep (namePrepProfile)
-import Data.Ranges (single)
+import qualified Data.Text.IDN.StringPrep as SP
 import Data.String (IsString, fromString)
 
 newtype Node = Node { strNode :: T.Text }


@@ 47,13 45,13 @@ instance Show Resource where
 		showString "Resource " . shows x
 
 instance Eq Node where
-	(==) = equaling (SP.runStringPrep nodePrep . strNode)
+	(==) = equaling strNode
 
 instance Eq Domain where
-	(==) = equaling (SP.runStringPrep domainPrep . strDomain)
+	(==) = equaling strDomain
 
 instance Eq Resource where
-	(==) = equaling (SP.runStringPrep resourcePrep . strResource)
+	(==) = equaling strResource
 
 data JID = JID
 	{ jidNode :: Maybe Node


@@ 79,13 77,18 @@ parseJID str = maybeJID where
 		(x, y) -> if T.null y
 			then (x, "")
 			else (x, T.drop 1 y)
-	mNode = if T.null node then Nothing else Just (Node node)
-	mResource = if T.null resource then Nothing else Just (Resource resource)
+	nullable x f = if T.null x then Just Nothing else fmap Just $ f x
 	maybeJID = do
-		SP.runStringPrep nodePrep node
-		SP.runStringPrep domainPrep domain
-		SP.runStringPrep resourcePrep resource
-		Just $ JID mNode (Domain domain) mResource
+		preppedNode <- nullable node $ stringprepM SP.profileNodeprep
+		preppedDomain <- stringprepM SP.profileNameprep domain
+		preppedResource <- nullable resource $ stringprepM SP.profileResourceprep
+		return $ JID
+			(fmap Node preppedNode)
+			(Domain preppedDomain)
+			(fmap Resource preppedResource)
+	stringprepM p x = case SP.stringprep p SP.defaultFlags x of
+		Left _ -> Nothing
+		Right y -> Just y
 
 parseJID_ :: T.Text -> JID
 parseJID_ text = case parseJID text of


@@ 98,29 101,6 @@ formatJID (JID node (Domain domain) resource) = formatted where
 	node' = maybe "" (\(Node x) -> T.append x "@") node
 	resource' = maybe "" (\(Resource x) -> T.append "/" x) resource
 
-nodePrep :: SP.StringPrepProfile
-nodePrep = SP.Profile
-	{ SP.maps = [SP.b1, SP.b2]
-	, SP.shouldNormalize = True
-	, SP.prohibited = [ SP.c11, SP.c12, SP.c21, SP.c22
-	                  , SP.c3, SP.c4, SP.c5, SP.c6, SP.c7, SP.c8, SP.c9
-	                  , map single "\"&'/:<>@"
-	                  ]
-	, SP.shouldCheckBidi = True
-	}
-
-domainPrep :: SP.StringPrepProfile
-domainPrep = namePrepProfile False
-
-resourcePrep :: SP.StringPrepProfile
-resourcePrep = SP.Profile
-	{ SP.maps = [SP.b1]
-	, SP.shouldNormalize = True
-	, SP.prohibited = [ SP.c12, SP.c21, SP.c22
-	                  , SP.c3, SP.c4, SP.c5, SP.c6, SP.c7, SP.c8, SP.c9]
-	, SP.shouldCheckBidi = True
-	}
-
 -- Similar to 'comparing'
 equaling :: Eq a => (b -> a) -> b -> b -> Bool
 equaling f x y = f x == f y

@@ 22,8 22,7 @@ library
   build-depends:
       base >=3 && < 5
     , text >= 0.7 && < 0.8
-    , stringprep >= 0.1.2 && < 0.2
-    , ranges >= 0.2.2 && < 0.3
+    , gnuidn >= 0.1 && < 0.2
     , hxt >= 8.5 && < 8.6
     , gnutls >= 0.1 && < 0.3
     , bytestring >= 0.9 && < 0.10