From 3666904f3afa8d139f8fd85f7ff65c3b999563ce Mon Sep 17 00:00:00 2001
From: John Millikin <jmillikin@gmail.com>
Date: Mon, 26 Apr 2010 22:55:11 +0000
Subject: [PATCH] Use GNU IDN instead of 'text-icu' for Stringprep support.

---
 Network/Protocol/XMPP/JID.hs | 50 +++++++++++-------------------------
 network-protocol-xmpp.cabal  |  3 +--
 2 files changed, 16 insertions(+), 37 deletions(-)

diff --git a/Network/Protocol/XMPP/JID.hs b/Network/Protocol/XMPP/JID.hs
index 27508bb..b4a99d3 100644
--- a/Network/Protocol/XMPP/JID.hs
+++ b/Network/Protocol/XMPP/JID.hs
@@ -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
diff --git a/network-protocol-xmpp.cabal b/network-protocol-xmpp.cabal
index bf51286..e4577d5 100644
--- a/network-protocol-xmpp.cabal
+++ b/network-protocol-xmpp.cabal
@@ -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
-- 
2.45.2