packages feed

gnuidn 0.2 → 0.2.1

raw patch · 9 files changed

+461/−452 lines, 9 filesdep ~base

Dependency ranges changed: base

Files

− Data/Text/IDN/IDNA.chs 
@@ -1,117 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}---- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>--- --- This program is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- any later version.--- --- This program is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the--- GNU General Public License for more details.--- --- You should have received a copy of the GNU General Public License--- along with this program.  If not, see <http://www.gnu.org/licenses/>.--module Data.Text.IDN.IDNA-	( Flags (..)-	, Error-	, defaultFlags-	, toASCII-	, toUnicode-	) where--import Control.Exception (ErrorCall(..), throwIO)-import qualified Data.ByteString as B-import qualified Data.Text as T--import Foreign-import Foreign.C--import Data.Text.IDN.Internal--#include <idna.h>-#include <idn-free.h>--{# enum Idna_rc {} with prefix = "IDNA_" #}--{# enum Idna_flags {} with prefix = "IDNA_" #}--data Flags = Flags-	{ verifySTD3 :: Bool-	-- ^ Check output to make sure it is a STD3-conforming host name-	-	, allowUnassigned :: Bool-	-- ^ Allow unassigned Unicode code points-	}-	deriving (Show, Eq)---- | @defaultFlags = Flags True False@-defaultFlags :: Flags-defaultFlags = Flags True False---- | Convert a Unicode domain name to an ASCII 'B.ByteString'. The domain--- name may contain several labels, separated by periods.------ @toASCII@ never alters a sequence of code points that are all in the--- ASCII range to begin with (although it could fail). Applying @toASCII@--- multiple times gives the same result as applying it once.-toASCII :: Flags -> T.Text -> Either Error B.ByteString-toASCII flags input =-	unsafePerformIO $-	withArray0 0 (toUCS4 input) $ \buf ->-	let c_flags = encodeFlags flags in-	alloca $ \outBufPtr -> do-		c_rc <- {# call idna_to_ascii_4z #}-			(castPtr buf) outBufPtr c_flags-		-		let rc = fromIntegral c_rc-		if rc /= fromEnum SUCCESS-			then return (Left (cToError c_rc))-			else do-				outBuf <- peek outBufPtr-				bytes <- B.packCString outBuf-				{# call idn_free #} (castPtr outBuf)-				return (Right bytes)---- | Convert a possibly ACE-encoded domain name to Unicode. The domain--- name may contain several labels, separated by dots.------ Aside from memory allocation failure, @toUnicode@ always succeeds.--- If the input cannot be decoded, it is returned unchanged.-toUnicode :: Flags -> B.ByteString -> T.Text-toUnicode flags input =-	unsafePerformIO $-	B.useAsCString input $ \buf ->-	let c_flags = encodeFlags flags in-	alloca $ \outBufPtr -> do-		c_rc <- {# call idna_to_unicode_8z4z #}-			(castPtr buf) outBufPtr c_flags-		-		let rc = fromIntegral c_rc-		if rc == fromEnum MALLOC_ERROR-			then throwError c_rc-			else do-				outBuf <- peek outBufPtr-				ucs4 <- peekArray0 0 (castPtr outBuf)-				{# call idn_free #} (castPtr outBuf)-				return (fromUCS4 ucs4)--encodeFlags :: Flags -> CInt-encodeFlags flags = foldr (.|.) 0 bits where-	bitAt f e = if f flags then 0 else fromIntegral (fromEnum e)-	bits = [ bitAt verifySTD3 USE_STD3_ASCII_RULES-	       , bitAt allowUnassigned ALLOW_UNASSIGNED-	       ]--cToError :: CInt -> Error-cToError rc = IDNAError (T.pack str) where-	c_strerror = {# call idna_strerror #}-	str = unsafePerformIO (c_strerror rc >>= peekCString)--throwError :: CInt -> IO a-throwError rc = do-	str <- peekCString =<< {# call idna_strerror #} rc-	throwIO (ErrorCall str)
− Data/Text/IDN/Internal.hs 
@@ -1,35 +0,0 @@--- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>--- --- This program is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- any later version.--- --- This program is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the--- GNU General Public License for more details.--- --- You should have received a copy of the GNU General Public License--- along with this program.  If not, see <http://www.gnu.org/licenses/>.--module Data.Text.IDN.Internal-	( Error (..)-	, toUCS4-	, fromUCS4-	) where--import qualified Data.Text as T-import Data.Char (chr, ord)--import qualified Foreign as F--data Error = IDNAError T.Text-           | StringPrepError T.Text-	deriving (Show, Eq)--toUCS4 :: T.Text -> [F.Word32]-toUCS4 = map (fromIntegral . ord) . T.unpack--fromUCS4 :: [F.Word32] -> T.Text-fromUCS4 = T.pack . map (chr . fromIntegral)
− Data/Text/IDN/Punycode.chs 
@@ -1,143 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}---- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>--- --- This program is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- any later version.--- --- This program is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the--- GNU General Public License for more details.--- --- You should have received a copy of the GNU General Public License--- along with this program.  If not, see <http://www.gnu.org/licenses/>.---- | Punycode is a simple and efficient transfer encoding syntax designed--- for use with Internationalized Domain Names in Applications (IDNA). It--- uniquely and reversibly transforms a Unicode string into ASCII. ASCII--- characters in the Unicode string are represented literally, and non-ASCII--- characters are represented by ASCII characters that are allowed in host--- name labels (letters, digits, and hyphens).-module Data.Text.IDN.Punycode-	( encode-	, decode-	) where--import Control.Exception (ErrorCall(..), throwIO)-import Control.Monad (unless)-import Data.List (unfoldr)-import qualified Data.ByteString as B-import qualified Data.Text as T--import Foreign-import Foreign.C--import Data.Text.IDN.Internal (toUCS4, fromUCS4)--#include <punycode.h>---- | Encode unicode into an ASCII-only 'B.ByteString'. If provided, the--- case predicate indicates whether to uppercase the corresponding character--- after decoding.-encode :: T.Text-       -> Maybe (Integer -> Bool)-       -> B.ByteString-encode input maybeIsCase = unsafePerformIO io where-	inSize = T.length input-	-	flags = flip fmap maybeIsCase $ \isCase -> let-		step idx = Just (fromBool (isCase idx), idx + 1)-		in unfoldr step 0-	-	io = maybeWith (withArray . take inSize) flags impl-	-	impl caseBuf = withArray (toUCS4 input) (loop caseBuf inSize . castPtr)-	-	loop caseBuf outMax inBuf = do-		res <- tryEnc caseBuf outMax inBuf-		case res of-			Nothing -> loop caseBuf (outMax + 50) inBuf-			Just (Right bytes) -> return bytes-			Just (Left rc) -> cToError rc-	-	tryEnc caseBuf outMax inBuf =-		allocaBytes outMax $ \outBuf ->-		alloca $ \outSizeBuf -> do-			poke outSizeBuf (fromIntegral outMax)-			c_rc <- {# call punycode_encode #}-				(fromIntegral inSize)-				inBuf-				caseBuf-				outSizeBuf-				outBuf-			-			let rc = fromIntegral c_rc-			if rc == fromEnum OVERFLOW-				then return Nothing-				else if rc == fromEnum SUCCESS-					then do-						outSize <- peek outSizeBuf-						bytes <- peekOut outBuf outSize-						return (Just (Right bytes))-					else return (Just (Left c_rc))-	-	peekOut outBuf outSize = B.packCStringLen cstr where-		cstr = (outBuf, fromIntegral outSize)---- | Decode a 'B.ByteString' into unicode. The second component of the--- result is a case predicate; it indicates whether a particular character--- position of the result string should be upper-cased.------ Returns 'Nothing' if the input is invalid.-decode :: B.ByteString-       -> Maybe (T.Text, (Integer -> Bool))-decode input = unsafePerformIO $-	let outMax = B.length input in-	B.useAsCStringLen input $ \(inBuf, inSize) ->-	alloca $ \outSizeBuf ->-	allocaArray outMax $ \outBuf -> do-	-	flagForeign <- mallocForeignPtrArray outMax-	poke outSizeBuf (fromIntegral outMax)-	-	c_rc <- withForeignPtr flagForeign $ \flagBuf ->-		{# call punycode_decode #}-			(fromIntegral inSize)-			inBuf-			outSizeBuf-			outBuf-			flagBuf-	-	let rc = fromIntegral c_rc-	if rc == fromEnum BAD_INPUT-		then return Nothing-		else do-			unless (rc == fromEnum SUCCESS) (cToError c_rc)-			-			outSize <- peek outSizeBuf-			ucs4 <- peekArray (fromIntegral outSize) (castPtr outBuf)-			let text = fromUCS4 ucs4-			return (Just (text, checkCaseFlag flagForeign outSize))--type SizeT = {# type size_t #}--{# enum Punycode_status {} with prefix = "PUNYCODE_" #}--checkCaseFlag :: ForeignPtr CUChar -> SizeT -> Integer -> Bool-checkCaseFlag ptr csize = checkIdx where-	intsize = toInteger csize-	checkIdx idx | idx < 0        = False-	checkIdx idx | idx >= intsize = False-	checkIdx idx =-		unsafePerformIO $-		withForeignPtr ptr $ \buf -> do-			cuchar <- peekElemOff buf (fromInteger idx)-			return (toBool cuchar)--cToError :: CInt -> IO a-cToError rc = do-	str <- peekCString =<< {# call punycode_strerror #} rc-	throwIO (ErrorCall str)
− Data/Text/IDN/StringPrep.chs 
@@ -1,147 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}---- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>--- --- This program is free software: you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation, either version 3 of the License, or--- any later version.--- --- This program is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the--- GNU General Public License for more details.--- --- You should have received a copy of the GNU General Public License--- along with this program.  If not, see <http://www.gnu.org/licenses/>.--module Data.Text.IDN.StringPrep-	(-	-- * Stringprep-	  Flags (..)-	, Error-	, defaultFlags-	, stringprep-	-	-- * Profiles-	, Profile-	, iscsi-	, kerberos5-	, nameprep-	, sasl-	, saslAnonymous-	, trace-	, xmppNode-	, xmppResource-	) where--import qualified Data.ByteString as B-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE--import Foreign-import Foreign.C--import Data.Text.IDN.Internal--#include <stringprep.h>--{# pointer *Stringprep_profile as Profile newtype #}--{# enum Stringprep_rc {} with prefix = "STRINGPREP_" #}--{# enum Stringprep_profile_flags {} with prefix = "STRINGPREP_" #}--data Flags = Flags-	{ enableNFKC :: Bool-	-- ^ Enable the NFKC normalization, as well as selecting the NFKC-	-- case folding tables. Usually the profile specifies BIDI and NFKC-	-- settings, and applications should not override it unless in-	-- special situations.-	-	, enableBidi :: Bool-	-- ^ Enable the BIDI step. Usually the profile specifies BIDI and-	-- NFKC settings, and applications should not override it unless in-	-- special situations.-	-	, allowUnassigned :: Bool-	-- ^ If false, 'stringprep' will return an error if the input-	-- contains characters not assigned to the profile.-	}-	deriving (Show, Eq)---- | @defaultFlags = Flags True True False@-defaultFlags :: Flags-defaultFlags = Flags True True False--stringprep :: Profile -> Flags -> T.Text -> Either Error T.Text-stringprep profile flags input = unsafePerformIO io where-	io = B.useAsCString utf8 (loop inSize)-	-	utf8 = TE.encodeUtf8 input-	c_flags = encodeFlags flags-	inSize = B.length utf8 + 1 -- + 1 for NUL-	-	loop outSize inBuf = do-		res <- tryPrep outSize inBuf-		case res of-			Nothing -> loop (outSize + 50) inBuf-			Just (Right bytes) -> return (Right (TE.decodeUtf8 bytes))-			Just (Left rc) -> return (Left (cToError rc))-	-	tryPrep outSize inBuf = allocaBytes outSize $ \outBuf -> do-		copyArray outBuf inBuf inSize-		let csize = fromIntegral outSize-		c_rc <- {# call stringprep as c_stringprep #}-			outBuf csize c_flags profile-		-		let rc = fromIntegral c_rc-		if rc == fromEnum TOO_SMALL_BUFFER-			then return Nothing-			else if rc == fromEnum OK-				then fmap (Just . Right) (B.packCString outBuf)-				else return (Just (Left c_rc))--encodeFlags :: Flags -> CInt-encodeFlags flags = foldr (.|.) 0 bits where-	bitAt f e = if f flags then 0 else fromIntegral (fromEnum e)-	bits = [ bitAt enableNFKC NO_NFKC-	       , bitAt enableBidi NO_BIDI-	       , bitAt allowUnassigned NO_UNASSIGNED-	       ]--cToError :: CInt -> Error-cToError rc = StringPrepError (T.pack str) where-	c_strerror = {# call stringprep_strerror #}-	str = unsafePerformIO (c_strerror rc >>= peekCString)---- | iSCSI (RFC 3722)-foreign import ccall "&stringprep_iscsi"-	iscsi :: Profile---- | Kerberos 5-foreign import ccall "&stringprep_kerberos5"-	kerberos5 :: Profile---- | Nameprep (RFC 3491)-foreign import ccall "&stringprep_nameprep"-	nameprep :: Profile---- | SASLprep (RFC 4013)-foreign import ccall "&stringprep_saslprep"-	sasl :: Profile---- | Draft SASL ANONYMOUS-foreign import ccall "&stringprep_plain"-	saslAnonymous :: Profile--foreign import ccall "&stringprep_trace"-	trace :: Profile---- | XMPP node (RFC 3920)-foreign import ccall "&stringprep_xmpp_nodeprep"-	xmppNode :: Profile---- | XMPP resource (RFC 3920)-foreign import ccall "&stringprep_xmpp_resourceprep"-	xmppResource :: Profile
gnuidn.cabal view
@@ -1,27 +1,33 @@ name: gnuidn-version: 0.2-stability: experimental-synopsis: Bindings for GNU IDN+version: 0.2.1 license: GPL-3 license-file: license.txt author: John Millikin maintainer: jmillikin@gmail.com build-type: Simple-cabal-version: >=1.6+cabal-version: >= 1.6 category: Codec, Text+stability: experimental+homepage: https://john-millikin.com/software/haskell-gnuidn/ bug-reports: mailto:jmillikin@gmail.com-homepage: http://john-millikin.com/software/bindings/gnuidn/-tested-with: GHC==6.12.1 +synopsis: Bindings for GNU IDN+ source-repository head-  type: bazaar-  location: http://john-millikin.com/software/bindings/gnuidn/+  type: git+  location: https://john-millikin.com/code/haskell-gnuidn/ +source-repository this+  type: git+  location: https://john-millikin.com/code/haskell-gnuidn/+  tag: haskell-gnuidn_0.2.1+ library-  ghc-options: -Wall+  ghc-options: -Wall -O2+  hs-source-dirs: lib    build-depends:-      base >= 3 && < 5+      base >= 4.0 && < 5.0     , text     , bytestring
+ lib/Data/Text/IDN/IDNA.chs view
@@ -0,0 +1,118 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>+-- +-- This program is free software: you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation, either version 3 of the License, or+-- any later version.+-- +-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+-- GNU General Public License for more details.+-- +-- You should have received a copy of the GNU General Public License+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.++module Data.Text.IDN.IDNA+	( Flags (..)+	, Error+	, defaultFlags+	, toASCII+	, toUnicode+	) where++import Control.Exception (ErrorCall(..), throwIO)+import qualified Data.ByteString as B+import qualified Data.Text as T+import qualified System.IO.Unsafe as Unsafe++import Foreign+import Foreign.C++import Data.Text.IDN.Internal++#include <idna.h>+#include <idn-free.h>++{# enum Idna_rc {} with prefix = "IDNA_" #}++{# enum Idna_flags {} with prefix = "IDNA_" #}++data Flags = Flags+	{ verifySTD3 :: Bool+	-- ^ Check output to make sure it is a STD3-conforming host name+	+	, allowUnassigned :: Bool+	-- ^ Allow unassigned Unicode code points+	}+	deriving (Show, Eq)++-- | @defaultFlags = Flags True False@+defaultFlags :: Flags+defaultFlags = Flags True False++-- | Convert a Unicode domain name to an ASCII 'B.ByteString'. The domain+-- name may contain several labels, separated by periods.+--+-- @toASCII@ never alters a sequence of code points that are all in the+-- ASCII range to begin with (although it could fail). Applying @toASCII@+-- multiple times gives the same result as applying it once.+toASCII :: Flags -> T.Text -> Either Error B.ByteString+toASCII flags input =+	Unsafe.unsafePerformIO $+	withArray0 0 (toUCS4 input) $ \buf ->+	let c_flags = encodeFlags flags in+	alloca $ \outBufPtr -> do+		c_rc <- {# call idna_to_ascii_4z #}+			(castPtr buf) outBufPtr c_flags+		+		let rc = fromIntegral c_rc+		if rc /= fromEnum SUCCESS+			then return (Left (cToError c_rc))+			else do+				outBuf <- peek outBufPtr+				bytes <- B.packCString outBuf+				{# call idn_free #} (castPtr outBuf)+				return (Right bytes)++-- | Convert a possibly ACE-encoded domain name to Unicode. The domain+-- name may contain several labels, separated by dots.+--+-- Aside from memory allocation failure, @toUnicode@ always succeeds.+-- If the input cannot be decoded, it is returned unchanged.+toUnicode :: Flags -> B.ByteString -> T.Text+toUnicode flags input =+	Unsafe.unsafePerformIO $+	B.useAsCString input $ \buf ->+	let c_flags = encodeFlags flags in+	alloca $ \outBufPtr -> do+		c_rc <- {# call idna_to_unicode_8z4z #}+			(castPtr buf) outBufPtr c_flags+		+		let rc = fromIntegral c_rc+		if rc == fromEnum MALLOC_ERROR+			then throwError c_rc+			else do+				outBuf <- peek outBufPtr+				ucs4 <- peekArray0 0 (castPtr outBuf)+				{# call idn_free #} (castPtr outBuf)+				return (fromUCS4 ucs4)++encodeFlags :: Flags -> CInt+encodeFlags flags = foldr (.|.) 0 bits where+	bitAt f e = if f flags then 0 else fromIntegral (fromEnum e)+	bits = [ bitAt verifySTD3 USE_STD3_ASCII_RULES+	       , bitAt allowUnassigned ALLOW_UNASSIGNED+	       ]++cToError :: CInt -> Error+cToError rc = IDNAError (T.pack str) where+	c_strerror = {# call idna_strerror #}+	str = Unsafe.unsafePerformIO (c_strerror rc >>= peekCString)++throwError :: CInt -> IO a+throwError rc = do+	str <- peekCString =<< {# call idna_strerror #} rc+	throwIO (ErrorCall str)
+ lib/Data/Text/IDN/Internal.hs view
@@ -0,0 +1,35 @@+-- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>+-- +-- This program is free software: you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation, either version 3 of the License, or+-- any later version.+-- +-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+-- GNU General Public License for more details.+-- +-- You should have received a copy of the GNU General Public License+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.++module Data.Text.IDN.Internal+	( Error (..)+	, toUCS4+	, fromUCS4+	) where++import qualified Data.Text as T+import Data.Char (chr, ord)++import qualified Foreign as F++data Error = IDNAError T.Text+           | StringPrepError T.Text+	deriving (Show, Eq)++toUCS4 :: T.Text -> [F.Word32]+toUCS4 = map (fromIntegral . ord) . T.unpack++fromUCS4 :: [F.Word32] -> T.Text+fromUCS4 = T.pack . map (chr . fromIntegral)
+ lib/Data/Text/IDN/Punycode.chs view
@@ -0,0 +1,144 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>+-- +-- This program is free software: you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation, either version 3 of the License, or+-- any later version.+-- +-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+-- GNU General Public License for more details.+-- +-- You should have received a copy of the GNU General Public License+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.++-- | Punycode is a simple and efficient transfer encoding syntax designed+-- for use with Internationalized Domain Names in Applications (IDNA). It+-- uniquely and reversibly transforms a Unicode string into ASCII. ASCII+-- characters in the Unicode string are represented literally, and non-ASCII+-- characters are represented by ASCII characters that are allowed in host+-- name labels (letters, digits, and hyphens).+module Data.Text.IDN.Punycode+	( encode+	, decode+	) where++import Control.Exception (ErrorCall(..), throwIO)+import Control.Monad (unless)+import Data.List (unfoldr)+import qualified Data.ByteString as B+import qualified Data.Text as T+import qualified System.IO.Unsafe as Unsafe++import Foreign+import Foreign.C++import Data.Text.IDN.Internal (toUCS4, fromUCS4)++#include <punycode.h>++-- | Encode unicode into an ASCII-only 'B.ByteString'. If provided, the+-- case predicate indicates whether to uppercase the corresponding character+-- after decoding.+encode :: T.Text+       -> Maybe (Integer -> Bool)+       -> B.ByteString+encode input maybeIsCase = Unsafe.unsafePerformIO io where+	inSize = T.length input+	+	flags = flip fmap maybeIsCase $ \isCase -> let+		step idx = Just (fromBool (isCase idx), idx + 1)+		in unfoldr step 0+	+	io = maybeWith (withArray . take inSize) flags impl+	+	impl caseBuf = withArray (toUCS4 input) (loop caseBuf inSize . castPtr)+	+	loop caseBuf outMax inBuf = do+		res <- tryEnc caseBuf outMax inBuf+		case res of+			Nothing -> loop caseBuf (outMax + 50) inBuf+			Just (Right bytes) -> return bytes+			Just (Left rc) -> cToError rc+	+	tryEnc caseBuf outMax inBuf =+		allocaBytes outMax $ \outBuf ->+		alloca $ \outSizeBuf -> do+			poke outSizeBuf (fromIntegral outMax)+			c_rc <- {# call punycode_encode #}+				(fromIntegral inSize)+				inBuf+				caseBuf+				outSizeBuf+				outBuf+			+			let rc = fromIntegral c_rc+			if rc == fromEnum OVERFLOW+				then return Nothing+				else if rc == fromEnum SUCCESS+					then do+						outSize <- peek outSizeBuf+						bytes <- peekOut outBuf outSize+						return (Just (Right bytes))+					else return (Just (Left c_rc))+	+	peekOut outBuf outSize = B.packCStringLen cstr where+		cstr = (outBuf, fromIntegral outSize)++-- | Decode a 'B.ByteString' into unicode. The second component of the+-- result is a case predicate; it indicates whether a particular character+-- position of the result string should be upper-cased.+--+-- Returns 'Nothing' if the input is invalid.+decode :: B.ByteString+       -> Maybe (T.Text, (Integer -> Bool))+decode input = Unsafe.unsafePerformIO $+	let outMax = B.length input in+	B.useAsCStringLen input $ \(inBuf, inSize) ->+	alloca $ \outSizeBuf ->+	allocaArray outMax $ \outBuf -> do+	+	flagForeign <- mallocForeignPtrArray outMax+	poke outSizeBuf (fromIntegral outMax)+	+	c_rc <- withForeignPtr flagForeign $ \flagBuf ->+		{# call punycode_decode #}+			(fromIntegral inSize)+			inBuf+			outSizeBuf+			outBuf+			flagBuf+	+	let rc = fromIntegral c_rc+	if rc == fromEnum BAD_INPUT+		then return Nothing+		else do+			unless (rc == fromEnum SUCCESS) (cToError c_rc)+			+			outSize <- peek outSizeBuf+			ucs4 <- peekArray (fromIntegral outSize) (castPtr outBuf)+			let text = fromUCS4 ucs4+			return (Just (text, checkCaseFlag flagForeign outSize))++type SizeT = {# type size_t #}++{# enum Punycode_status {} with prefix = "PUNYCODE_" #}++checkCaseFlag :: ForeignPtr CUChar -> SizeT -> Integer -> Bool+checkCaseFlag ptr csize = checkIdx where+	intsize = toInteger csize+	checkIdx idx | idx < 0        = False+	checkIdx idx | idx >= intsize = False+	checkIdx idx =+		Unsafe.unsafePerformIO $+		withForeignPtr ptr $ \buf -> do+			cuchar <- peekElemOff buf (fromInteger idx)+			return (toBool cuchar)++cToError :: CInt -> IO a+cToError rc = do+	str <- peekCString =<< {# call punycode_strerror #} rc+	throwIO (ErrorCall str)
+ lib/Data/Text/IDN/StringPrep.chs view
@@ -0,0 +1,148 @@+{-# LANGUAGE ForeignFunctionInterface #-}++-- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>+-- +-- This program is free software: you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation, either version 3 of the License, or+-- any later version.+-- +-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+-- GNU General Public License for more details.+-- +-- You should have received a copy of the GNU General Public License+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.++module Data.Text.IDN.StringPrep+	(+	-- * Stringprep+	  Flags (..)+	, Error+	, defaultFlags+	, stringprep+	+	-- * Profiles+	, Profile+	, iscsi+	, kerberos5+	, nameprep+	, sasl+	, saslAnonymous+	, trace+	, xmppNode+	, xmppResource+	) where++import qualified Data.ByteString as B+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified System.IO.Unsafe as Unsafe++import Foreign+import Foreign.C++import Data.Text.IDN.Internal++#include <stringprep.h>++{# pointer *Stringprep_profile as Profile newtype #}++{# enum Stringprep_rc {} with prefix = "STRINGPREP_" #}++{# enum Stringprep_profile_flags {} with prefix = "STRINGPREP_" #}++data Flags = Flags+	{ enableNFKC :: Bool+	-- ^ Enable the NFKC normalization, as well as selecting the NFKC+	-- case folding tables. Usually the profile specifies BIDI and NFKC+	-- settings, and applications should not override it unless in+	-- special situations.+	+	, enableBidi :: Bool+	-- ^ Enable the BIDI step. Usually the profile specifies BIDI and+	-- NFKC settings, and applications should not override it unless in+	-- special situations.+	+	, allowUnassigned :: Bool+	-- ^ If false, 'stringprep' will return an error if the input+	-- contains characters not assigned to the profile.+	}+	deriving (Show, Eq)++-- | @defaultFlags = Flags True True False@+defaultFlags :: Flags+defaultFlags = Flags True True False++stringprep :: Profile -> Flags -> T.Text -> Either Error T.Text+stringprep profile flags input = Unsafe.unsafePerformIO io where+	io = B.useAsCString utf8 (loop inSize)+	+	utf8 = TE.encodeUtf8 input+	c_flags = encodeFlags flags+	inSize = B.length utf8 + 1 -- + 1 for NUL+	+	loop outSize inBuf = do+		res <- tryPrep outSize inBuf+		case res of+			Nothing -> loop (outSize + 50) inBuf+			Just (Right bytes) -> return (Right (TE.decodeUtf8 bytes))+			Just (Left rc) -> return (Left (cToError rc))+	+	tryPrep outSize inBuf = allocaBytes outSize $ \outBuf -> do+		copyArray outBuf inBuf inSize+		let csize = fromIntegral outSize+		c_rc <- {# call stringprep as c_stringprep #}+			outBuf csize c_flags profile+		+		let rc = fromIntegral c_rc+		if rc == fromEnum TOO_SMALL_BUFFER+			then return Nothing+			else if rc == fromEnum OK+				then fmap (Just . Right) (B.packCString outBuf)+				else return (Just (Left c_rc))++encodeFlags :: Flags -> CInt+encodeFlags flags = foldr (.|.) 0 bits where+	bitAt f e = if f flags then 0 else fromIntegral (fromEnum e)+	bits = [ bitAt enableNFKC NO_NFKC+	       , bitAt enableBidi NO_BIDI+	       , bitAt allowUnassigned NO_UNASSIGNED+	       ]++cToError :: CInt -> Error+cToError rc = StringPrepError (T.pack str) where+	c_strerror = {# call stringprep_strerror #}+	str = Unsafe.unsafePerformIO (c_strerror rc >>= peekCString)++-- | iSCSI (RFC 3722)+foreign import ccall "&stringprep_iscsi"+	iscsi :: Profile++-- | Kerberos 5+foreign import ccall "&stringprep_kerberos5"+	kerberos5 :: Profile++-- | Nameprep (RFC 3491)+foreign import ccall "&stringprep_nameprep"+	nameprep :: Profile++-- | SASLprep (RFC 4013)+foreign import ccall "&stringprep_saslprep"+	sasl :: Profile++-- | Draft SASL ANONYMOUS+foreign import ccall "&stringprep_plain"+	saslAnonymous :: Profile++foreign import ccall "&stringprep_trace"+	trace :: Profile++-- | XMPP node (RFC 3920)+foreign import ccall "&stringprep_xmpp_nodeprep"+	xmppNode :: Profile++-- | XMPP resource (RFC 3920)+foreign import ccall "&stringprep_xmpp_resourceprep"+	xmppResource :: Profile