-- GENERATED by C->Haskell Compiler, version 0.20.1 The shapeless maps, 31 Oct 2014 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "lib/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 qualified System.IO.Unsafe as Unsafe

import Foreign
import Foreign.C

import Data.Text.IDN.Internal



newtype Profile = Profile (Ptr (Profile))
{-# LINE 50 "lib/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
  succ OK = CONTAINS_UNASSIGNED
  succ CONTAINS_UNASSIGNED = CONTAINS_PROHIBITED
  succ CONTAINS_PROHIBITED = BIDI_BOTH_L_AND_RAL
  succ BIDI_BOTH_L_AND_RAL = BIDI_LEADTRAIL_NOT_RAL
  succ BIDI_LEADTRAIL_NOT_RAL = BIDI_CONTAINS_PROHIBITED
  succ BIDI_CONTAINS_PROHIBITED = TOO_SMALL_BUFFER
  succ TOO_SMALL_BUFFER = PROFILE_ERROR
  succ PROFILE_ERROR = FLAG_ERROR
  succ FLAG_ERROR = UNKNOWN_PROFILE
  succ UNKNOWN_PROFILE = NFKC_FAILED
  succ NFKC_FAILED = MALLOC_ERROR
  succ MALLOC_ERROR = error "Stringprep_rc.succ: MALLOC_ERROR has no successor"

  pred CONTAINS_UNASSIGNED = OK
  pred CONTAINS_PROHIBITED = CONTAINS_UNASSIGNED
  pred BIDI_BOTH_L_AND_RAL = CONTAINS_PROHIBITED
  pred BIDI_LEADTRAIL_NOT_RAL = BIDI_BOTH_L_AND_RAL
  pred BIDI_CONTAINS_PROHIBITED = BIDI_LEADTRAIL_NOT_RAL
  pred TOO_SMALL_BUFFER = BIDI_CONTAINS_PROHIBITED
  pred PROFILE_ERROR = TOO_SMALL_BUFFER
  pred FLAG_ERROR = PROFILE_ERROR
  pred UNKNOWN_PROFILE = FLAG_ERROR
  pred NFKC_FAILED = UNKNOWN_PROFILE
  pred MALLOC_ERROR = NFKC_FAILED
  pred OK = error "Stringprep_rc.pred: OK has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from MALLOC_ERROR

  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 52 "lib/Data/Text/IDN/StringPrep.chs" #-}


data Stringprep_profile_flags = NO_NFKC
                              | NO_BIDI
                              | NO_UNASSIGNED
instance Enum Stringprep_profile_flags where
  succ NO_NFKC = NO_BIDI
  succ NO_BIDI = NO_UNASSIGNED
  succ NO_UNASSIGNED = error "Stringprep_profile_flags.succ: NO_UNASSIGNED has no successor"

  pred NO_BIDI = NO_NFKC
  pred NO_UNASSIGNED = NO_BIDI
  pred NO_NFKC = error "Stringprep_profile_flags.pred: NO_NFKC has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from NO_UNASSIGNED

  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 54 "lib/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 = 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 <- c_stringprep
{-# LINE 96 "lib/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 116 "lib/Data/Text/IDN/StringPrep.chs" #-}

	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

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

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