network-protocol-xmpp 0.5.1 → 0.5.2

raw patch · 3 files changed

+25/−19 lines, 3 files

Files

• lib/Network/Protocol/XMPP/Client/Authentication.hs +2/−1
• lib/Network/Protocol/XMPP/JID.hs +21/−16
• network-protocol-xmpp.cabal +2/−2

@@ -48,7 +48,8 @@              -> Text -- ^ Password              -> M.XMPP () authenticate xmppMechanisms userJID serverJID username password = xmpp where-	mechanisms = map SASL.Mechanism xmppMechanisms+	-- Filter out PLUS mechanisms because we haven't implemented channel binding+	mechanisms = map SASL.Mechanism $ filter (not . ((Data.ByteString.Char8.pack "PLUS") `Data.ByteString.Char8.isSuffixOf`)) xmppMechanisms 	authz = formatJID (userJID { jidResource = Nothing }) 	hostname = formatJID serverJID 

@@ -30,6 +30,7 @@ import qualified Data.Text import           Data.Text (Text) import qualified Data.Text.IDN.StringPrep as SP+import qualified Data.Text.IDN.IDNA as IDNA import           Data.String (IsString, fromString)  newtype Node = Node { strNode :: Text }@@ -73,28 +74,32 @@  parseJID :: Text -> Maybe JID parseJID str = maybeJID where-	(node, postNode) = case textSpanBy (/= '@') str of+	(bare, resource) = case textSpanBy (/= '/') str of 		(x, y) -> if Data.Text.null y-			then (Data.Text.empty, x)-			else (x, Data.Text.drop 1 y)-	(domain, resource) = case textSpanBy (/= '/') postNode of+			then (x, Nothing)+			else (x, Just $ Data.Text.drop 1 y)+	(node, domain) = case textSpanBy (/= '@') bare of 		(x, y) -> if Data.Text.null y-			then (x, Data.Text.empty)-			else (x, Data.Text.drop 1 y)-	nullable x f = if Data.Text.null x-		then Just Nothing+			then (Nothing, x)+			else (Just x, Data.Text.drop 1 y)+	nullable Nothing _ = Just Nothing+	nullable (Just x) f = if Data.Text.null x+		then Nothing 		else fmap Just (f x) 	maybeJID = do 		preppedNode <- nullable node (stringprepM SP.xmppNode)-		preppedDomain <- stringprepM SP.nameprep domain+		preppedDomain <- fmap (IDNA.toUnicode IDNA.defaultFlags)+			(rightToJust $ IDNA.toASCII IDNA.defaultFlags domain) 		preppedResource <- nullable resource (stringprepM SP.xmppResource)-		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+		if Data.Text.null preppedDomain+			then Nothing+			else return $ JID+				(fmap Node preppedNode)+				(Domain preppedDomain)+				(fmap Resource preppedResource)+	rightToJust (Left _) = Nothing+	rightToJust (Right y) = Just y+	stringprepM p x = rightToJust $ SP.stringprep p SP.defaultFlags x  parseJID_ :: Text -> JID parseJID_ = fromMaybe (error "Malformed JID") . parseJID

@@ -1,5 +1,5 @@ name: network-protocol-xmpp-version: 0.5.1+version: 0.5.2 license: GPL-3 license-file: COPYING author: John Millikin <jmillikin@gmail.com>, Stephan Maka <stephan@spaceboyz.net>@@ -21,7 +21,7 @@ source-repository this   type: git   location: https://git.sr.ht/~singpolyma/network-protocol-xmpp-  tag: 0.5.1+  tag: 0.5.2  library   default-language: Haskell2010