gnuidn 0.1.1.2 → 0.2

raw patch · 6 files changed

+453/−135 lines, 6 filesdep ~basedep ~bytestringdep ~textPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, bytestring, text

API changes (from Hackage documentation)

Files

• Data/Text/IDN/IDNA.chs +117/−0
• Data/Text/IDN/Internal.hs +35/−0
• Data/Text/IDN/Punycode.chs +143/−0
• Data/Text/IDN/StringPrep.chs +147/−0
• Data/Text/IDN/StringPrep.hs +0/−132
• gnuidn.cabal +11/−3

@@ -0,0 +1,117 @@+{-# 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)

@@ -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)

@@ -0,0 +1,143 @@+{-# 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)

@@ -0,0 +1,147 @@+{-# 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

@@ -1,132 +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/>.--{-# LANGUAGE ForeignFunctionInterface #-}-module Data.Text.IDN.StringPrep-	(-	-- * Stringprep-	  Flags (..)-	, Error (..)-	, defaultFlags-	, stringprep-	-	-- * Profiles-	, Profile-	, profileNameprep-	, profileSaslPrep-	, profilePlain-	, profileTrace-	, profileKerberos5-	, profileNodeprep-	, profileResourceprep-	, profileISCSI-	) where-import Data.Bits ((.|.))-import qualified Data.ByteString as B-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Encoding as TE-import qualified Foreign as F-import qualified Foreign.C as F-import System.IO.Unsafe (unsafePerformIO)--data Error-	= ErrorContainsUnassigned-	| ErrorContainsProhibited-	| ErrorBidiBothLAndRAL-	| ErrorBidiLeadTrailNotRAL-	| ErrorBidiContainsProhibited-	| ErrorInconsistentProfile-	| ErrorInvalidFlag-	| ErrorNormalisationFailed-	| ErrorUnknown Integer-	deriving (Show, Eq)--data Flags = Flags-	{ enableNFKC :: Bool-	, enableBidi :: Bool-	, allowUnassigned :: Bool-	}--newtype Profile = Profile (F.Ptr Profile)--defaultFlags :: Flags-defaultFlags = Flags True True False--stringprep :: Profile -> Flags -> TL.Text -> Either Error TL.Text-stringprep profile flags input = unsafePerformIO io where-	utf8 = TE.encodeUtf8 $ T.concat $ TL.toChunks input-	cflags = encodeFlags flags-	len = B.length utf8 + 1 -- + 1 for NUL-	io = B.useAsCString utf8 (loop len)-	loop bufsize pIn = F.allocaBytes bufsize $ \buf -> do-		F.copyArray buf pIn len-		let csize = fromIntegral bufsize-		rc <- c_stringprep buf csize cflags profile-		case rc of-			-- TOO_SMALL_BUFFER-			100 -> loop (bufsize + 50) pIn-			-			0 -> do-				bytes <- B.packCString buf-				return $ Right $ TL.fromChunks [TE.decodeUtf8 bytes]-			_ -> return $ Left $ cToError rc--encodeFlags :: Flags -> F.CInt-encodeFlags flags = foldr (.|.) 0 bits where-	bit f x y = if f flags then x else y-	bits = [ bit enableNFKC 0 1-	       , bit enableBidi 0 2-	       , bit allowUnassigned 0 4-	       ]--cToError :: F.CInt -> Error-cToError x = case x of-	1 -> ErrorContainsUnassigned-	2 -> ErrorContainsProhibited-	3 -> ErrorBidiBothLAndRAL-	4 -> ErrorBidiLeadTrailNotRAL-	5 -> ErrorBidiContainsProhibited-	101 -> ErrorInconsistentProfile-	102 -> ErrorInvalidFlag-	200 -> ErrorNormalisationFailed-	_ -> ErrorUnknown $ toInteger x--foreign import ccall "stringprep"-	c_stringprep :: F.CString -> F.CSize -> F.CInt -> Profile -> IO F.CInt--foreign import ccall "&stringprep_nameprep"-	profileNameprep :: Profile--foreign import ccall "&stringprep_saslprep"-	profileSaslPrep :: Profile--foreign import ccall "&stringprep_plain"-	profilePlain :: Profile--foreign import ccall "&stringprep_trace"-	profileTrace :: Profile--foreign import ccall "&stringprep_kerberos5"-	profileKerberos5 :: Profile--foreign import ccall "&stringprep_xmpp_nodeprep"-	profileNodeprep :: Profile--foreign import ccall "&stringprep_xmpp_resourceprep"-	profileResourceprep :: Profile--foreign import ccall "&stringprep_iscsi"-	profileISCSI :: Profile

@@ -1,5 +1,5 @@ name: gnuidn-version: 0.1.1.2+version: 0.2 stability: experimental synopsis: Bindings for GNU IDN license: GPL-3@@ -22,11 +22,19 @@    build-depends:       base >= 3 && < 5-    , text >= 0.2 && < 0.11-    , bytestring >= 0.9 && < 0.10+    , text+    , bytestring    extra-libraries: idn   pkgconfig-depends: libidn +  build-tools:+    c2hs+   exposed-modules:+    Data.Text.IDN.IDNA+    Data.Text.IDN.Punycode     Data.Text.IDN.StringPrep++  other-modules:+    Data.Text.IDN.Internal