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
data Idna_rc = SUCCESS
| STRINGPREP_ERROR
| PUNYCODE_ERROR
| CONTAINS_NON_LDH
| CONTAINS_LDH
| CONTAINS_MINUS
| INVALID_LENGTH
| NO_ACE_PREFIX
| ROUNDTRIP_VERIFY_ERROR
| CONTAINS_ACE_PREFIX
| ICONV_ERROR
| MALLOC_ERROR
| DLOPEN_ERROR
instance Enum Idna_rc where
fromEnum SUCCESS = 0
fromEnum STRINGPREP_ERROR = 1
fromEnum PUNYCODE_ERROR = 2
fromEnum CONTAINS_NON_LDH = 3
fromEnum CONTAINS_LDH = 3
fromEnum CONTAINS_MINUS = 4
fromEnum INVALID_LENGTH = 5
fromEnum NO_ACE_PREFIX = 6
fromEnum ROUNDTRIP_VERIFY_ERROR = 7
fromEnum CONTAINS_ACE_PREFIX = 8
fromEnum ICONV_ERROR = 9
fromEnum MALLOC_ERROR = 201
fromEnum DLOPEN_ERROR = 202
toEnum 0 = SUCCESS
toEnum 1 = STRINGPREP_ERROR
toEnum 2 = PUNYCODE_ERROR
toEnum 3 = CONTAINS_NON_LDH
toEnum 3 = CONTAINS_LDH
toEnum 4 = CONTAINS_MINUS
toEnum 5 = INVALID_LENGTH
toEnum 6 = NO_ACE_PREFIX
toEnum 7 = ROUNDTRIP_VERIFY_ERROR
toEnum 8 = CONTAINS_ACE_PREFIX
toEnum 9 = ICONV_ERROR
toEnum 201 = MALLOC_ERROR
toEnum 202 = DLOPEN_ERROR
toEnum unmatched = error ("Idna_rc.toEnum: Cannot match " ++ show unmatched)
data Idna_flags = ALLOW_UNASSIGNED
| USE_STD3_ASCII_RULES
instance Enum Idna_flags where
fromEnum ALLOW_UNASSIGNED = 1
fromEnum USE_STD3_ASCII_RULES = 2
toEnum 1 = ALLOW_UNASSIGNED
toEnum 2 = USE_STD3_ASCII_RULES
toEnum unmatched = error ("Idna_flags.toEnum: Cannot match " ++ show unmatched)
data Flags = Flags
{ verifySTD3 :: Bool
, allowUnassigned :: Bool
}
deriving (Show, Eq)
defaultFlags :: Flags
defaultFlags = Flags True False
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 <- 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
idn_free (castPtr outBuf)
return (Right bytes)
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 <- 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)
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 = idna_strerror
str = Unsafe.unsafePerformIO (c_strerror rc >>= peekCString)
throwError :: CInt -> IO a
throwError rc = do
str <- peekCString =<< idna_strerror rc
throwIO (ErrorCall str)
foreign import ccall safe "Data/Text/IDN/IDNA.chs.h idna_to_ascii_4z"
idna_to_ascii_4z :: ((Ptr CUInt) -> ((Ptr (Ptr CChar)) -> (CInt -> (IO CInt))))
foreign import ccall safe "Data/Text/IDN/IDNA.chs.h idn_free"
idn_free :: ((Ptr ()) -> (IO ()))
foreign import ccall safe "Data/Text/IDN/IDNA.chs.h idna_to_unicode_8z4z"
idna_to_unicode_8z4z :: ((Ptr CChar) -> ((Ptr (Ptr CUInt)) -> (CInt -> (IO CInt))))
foreign import ccall safe "Data/Text/IDN/IDNA.chs.h idna_strerror"
idna_strerror :: (CInt -> (IO (Ptr CChar)))