-- GENERATED by C->Haskell Compiler, version 0.16.0 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Data/Text/IDN/StringPrep.chs" #-}{-# 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


newtype Profile = Profile (Ptr (Profile))
{-# LINE 49 "./Data/Text/IDN/StringPrep.chs" #-}

data Stringprep_rc = OK
                   | CONTAINS_UNASSIGNED
                   | CONTAINS_PROHIBITED
                   | BIDI_BOTH_L_AND_RAL
                   | BIDI_LEADTRAIL_NOT_RAL
                   | BIDI_CONTAINS_PROHIBITED
                   | TOO_SMALL_BUFFER
                   | PROFILE_ERROR
                   | FLAG_ERROR
                   | UNKNOWN_PROFILE
                   | NFKC_FAILED
                   | MALLOC_ERROR
                   
instance Enum Stringprep_rc where
  fromEnum OK = 0
  fromEnum CONTAINS_UNASSIGNED = 1
  fromEnum CONTAINS_PROHIBITED = 2
  fromEnum BIDI_BOTH_L_AND_RAL = 3
  fromEnum BIDI_LEADTRAIL_NOT_RAL = 4
  fromEnum BIDI_CONTAINS_PROHIBITED = 5
  fromEnum TOO_SMALL_BUFFER = 100
  fromEnum PROFILE_ERROR = 101
  fromEnum FLAG_ERROR = 102
  fromEnum UNKNOWN_PROFILE = 103
  fromEnum NFKC_FAILED = 200
  fromEnum MALLOC_ERROR = 201

  toEnum 0 = OK
  toEnum 1 = CONTAINS_UNASSIGNED
  toEnum 2 = CONTAINS_PROHIBITED
  toEnum 3 = BIDI_BOTH_L_AND_RAL
  toEnum 4 = BIDI_LEADTRAIL_NOT_RAL
  toEnum 5 = BIDI_CONTAINS_PROHIBITED
  toEnum 100 = TOO_SMALL_BUFFER
  toEnum 101 = PROFILE_ERROR
  toEnum 102 = FLAG_ERROR
  toEnum 103 = UNKNOWN_PROFILE
  toEnum 200 = NFKC_FAILED
  toEnum 201 = MALLOC_ERROR
  toEnum unmatched = error ("Stringprep_rc.toEnum: Cannot match " ++ show unmatched)

{-# LINE 51 "./Data/Text/IDN/StringPrep.chs" #-}

data Stringprep_profile_flags = NO_NFKC
                              | NO_BIDI
                              | NO_UNASSIGNED
                              
instance Enum Stringprep_profile_flags where
  fromEnum NO_NFKC = 1
  fromEnum NO_BIDI = 2
  fromEnum NO_UNASSIGNED = 4

  toEnum 1 = NO_NFKC
  toEnum 2 = NO_BIDI
  toEnum 4 = NO_UNASSIGNED
  toEnum unmatched = error ("Stringprep_profile_flags.toEnum: Cannot match " ++ show unmatched)

{-# LINE 53 "./Data/Text/IDN/StringPrep.chs" #-}

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 <- c_stringprep
{-# LINE 95 "./Data/Text/IDN/StringPrep.chs" #-}
			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 = stringprep_strerror
{-# LINE 115 "./Data/Text/IDN/StringPrep.chs" #-}
	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

foreign import ccall safe "Data/Text/IDN/StringPrep.chs.h stringprep"
  c_stringprep :: ((Ptr CChar) -> (CUInt -> (CInt -> ((Profile) -> (IO CInt)))))

foreign import ccall safe "Data/Text/IDN/StringPrep.chs.h stringprep_strerror"
  stringprep_strerror :: (CInt -> (IO (Ptr CChar)))