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


{-# LINE 1 "./Network/Protocol/SASL/GSASL.chs" #-}{- Copyright (C) 2009 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/>.
-}

{- |

Full documentation available for these functions at
<http://www.gnu.org/software/gsasl/>.

-}

{-# LANGUAGE ForeignFunctionInterface #-}


module Network.Protocol.SASL.GSASL (
	-- * Data types
	 Context
	,Session
	,CallbackComputation
	
	-- * Context procedures
	,mkContext
	,freeContext
	,withContext
	,clientMechanisms
	,serverMechanisms
	,clientSupportP
	,serverSupportP
	,clientSuggestMechanism
	
	-- * Callback management
	,callback
	,withCallbackSet
	
	-- * Property set/get
	,propertySet
	,propertyFast
	,propertyGet
	
	-- * Session procedures
	,clientStart
	,serverStart
	,freeSession
	,withSession
	,step
	,step64
	,encode
	,decode
	
	-- * Enumerations
	,ReturnCode(..)
	,Property(..)
	) where

import Foreign
import Foreign.C
import Data.List (intercalate)
import Control.Exception (bracket)

data ReturnCode = GSASL_OK
                | GSASL_NEEDS_MORE
                | GSASL_UNKNOWN_MECHANISM
                | GSASL_MECHANISM_CALLED_TOO_MANY_TIMES
                | GSASL_MALLOC_ERROR
                | GSASL_BASE64_ERROR
                | GSASL_CRYPTO_ERROR
                | GSASL_SASLPREP_ERROR
                | GSASL_MECHANISM_PARSE_ERROR
                | GSASL_AUTHENTICATION_ERROR
                | GSASL_INTEGRITY_ERROR
                | GSASL_NO_CLIENT_CODE
                | GSASL_NO_SERVER_CODE
                | GSASL_NO_CALLBACK
                | GSASL_NO_ANONYMOUS_TOKEN
                | GSASL_NO_AUTHID
                | GSASL_NO_AUTHZID
                | GSASL_NO_PASSWORD
                | GSASL_NO_PASSCODE
                | GSASL_NO_PIN
                | GSASL_NO_SERVICE
                | GSASL_NO_HOSTNAME
                | GSASL_GSSAPI_RELEASE_BUFFER_ERROR
                | GSASL_GSSAPI_IMPORT_NAME_ERROR
                | GSASL_GSSAPI_INIT_SEC_CONTEXT_ERROR
                | GSASL_GSSAPI_ACCEPT_SEC_CONTEXT_ERROR
                | GSASL_GSSAPI_UNWRAP_ERROR
                | GSASL_GSSAPI_WRAP_ERROR
                | GSASL_GSSAPI_ACQUIRE_CRED_ERROR
                | GSASL_GSSAPI_DISPLAY_NAME_ERROR
                | GSASL_GSSAPI_UNSUPPORTED_PROTECTION_ERROR
                | GSASL_KERBEROS_V5_INIT_ERROR
                | GSASL_KERBEROS_V5_INTERNAL_ERROR
                | GSASL_SHISHI_ERROR
                | GSASL_SECURID_SERVER_NEED_ADDITIONAL_PASSCODE
                | GSASL_SECURID_SERVER_NEED_NEW_PIN
                deriving (Show)
instance Enum ReturnCode where
  fromEnum GSASL_OK = 0
  fromEnum GSASL_NEEDS_MORE = 1
  fromEnum GSASL_UNKNOWN_MECHANISM = 2
  fromEnum GSASL_MECHANISM_CALLED_TOO_MANY_TIMES = 3
  fromEnum GSASL_MALLOC_ERROR = 7
  fromEnum GSASL_BASE64_ERROR = 8
  fromEnum GSASL_CRYPTO_ERROR = 9
  fromEnum GSASL_SASLPREP_ERROR = 29
  fromEnum GSASL_MECHANISM_PARSE_ERROR = 30
  fromEnum GSASL_AUTHENTICATION_ERROR = 31
  fromEnum GSASL_INTEGRITY_ERROR = 33
  fromEnum GSASL_NO_CLIENT_CODE = 35
  fromEnum GSASL_NO_SERVER_CODE = 36
  fromEnum GSASL_NO_CALLBACK = 51
  fromEnum GSASL_NO_ANONYMOUS_TOKEN = 52
  fromEnum GSASL_NO_AUTHID = 53
  fromEnum GSASL_NO_AUTHZID = 54
  fromEnum GSASL_NO_PASSWORD = 55
  fromEnum GSASL_NO_PASSCODE = 56
  fromEnum GSASL_NO_PIN = 57
  fromEnum GSASL_NO_SERVICE = 58
  fromEnum GSASL_NO_HOSTNAME = 59
  fromEnum GSASL_GSSAPI_RELEASE_BUFFER_ERROR = 37
  fromEnum GSASL_GSSAPI_IMPORT_NAME_ERROR = 38
  fromEnum GSASL_GSSAPI_INIT_SEC_CONTEXT_ERROR = 39
  fromEnum GSASL_GSSAPI_ACCEPT_SEC_CONTEXT_ERROR = 40
  fromEnum GSASL_GSSAPI_UNWRAP_ERROR = 41
  fromEnum GSASL_GSSAPI_WRAP_ERROR = 42
  fromEnum GSASL_GSSAPI_ACQUIRE_CRED_ERROR = 43
  fromEnum GSASL_GSSAPI_DISPLAY_NAME_ERROR = 44
  fromEnum GSASL_GSSAPI_UNSUPPORTED_PROTECTION_ERROR = 45
  fromEnum GSASL_KERBEROS_V5_INIT_ERROR = 46
  fromEnum GSASL_KERBEROS_V5_INTERNAL_ERROR = 47
  fromEnum GSASL_SHISHI_ERROR = 47
  fromEnum GSASL_SECURID_SERVER_NEED_ADDITIONAL_PASSCODE = 48
  fromEnum GSASL_SECURID_SERVER_NEED_NEW_PIN = 49

  toEnum 0 = GSASL_OK
  toEnum 1 = GSASL_NEEDS_MORE
  toEnum 2 = GSASL_UNKNOWN_MECHANISM
  toEnum 3 = GSASL_MECHANISM_CALLED_TOO_MANY_TIMES
  toEnum 7 = GSASL_MALLOC_ERROR
  toEnum 8 = GSASL_BASE64_ERROR
  toEnum 9 = GSASL_CRYPTO_ERROR
  toEnum 29 = GSASL_SASLPREP_ERROR
  toEnum 30 = GSASL_MECHANISM_PARSE_ERROR
  toEnum 31 = GSASL_AUTHENTICATION_ERROR
  toEnum 33 = GSASL_INTEGRITY_ERROR
  toEnum 35 = GSASL_NO_CLIENT_CODE
  toEnum 36 = GSASL_NO_SERVER_CODE
  toEnum 51 = GSASL_NO_CALLBACK
  toEnum 52 = GSASL_NO_ANONYMOUS_TOKEN
  toEnum 53 = GSASL_NO_AUTHID
  toEnum 54 = GSASL_NO_AUTHZID
  toEnum 55 = GSASL_NO_PASSWORD
  toEnum 56 = GSASL_NO_PASSCODE
  toEnum 57 = GSASL_NO_PIN
  toEnum 58 = GSASL_NO_SERVICE
  toEnum 59 = GSASL_NO_HOSTNAME
  toEnum 37 = GSASL_GSSAPI_RELEASE_BUFFER_ERROR
  toEnum 38 = GSASL_GSSAPI_IMPORT_NAME_ERROR
  toEnum 39 = GSASL_GSSAPI_INIT_SEC_CONTEXT_ERROR
  toEnum 40 = GSASL_GSSAPI_ACCEPT_SEC_CONTEXT_ERROR
  toEnum 41 = GSASL_GSSAPI_UNWRAP_ERROR
  toEnum 42 = GSASL_GSSAPI_WRAP_ERROR
  toEnum 43 = GSASL_GSSAPI_ACQUIRE_CRED_ERROR
  toEnum 44 = GSASL_GSSAPI_DISPLAY_NAME_ERROR
  toEnum 45 = GSASL_GSSAPI_UNSUPPORTED_PROTECTION_ERROR
  toEnum 46 = GSASL_KERBEROS_V5_INIT_ERROR
  toEnum 47 = GSASL_KERBEROS_V5_INTERNAL_ERROR
  toEnum 47 = GSASL_SHISHI_ERROR
  toEnum 48 = GSASL_SECURID_SERVER_NEED_ADDITIONAL_PASSCODE
  toEnum 49 = GSASL_SECURID_SERVER_NEED_NEW_PIN
  toEnum unmatched = error ("ReturnCode.toEnum: Cannot match " ++ show unmatched)

{-# LINE 73 "./Network/Protocol/SASL/GSASL.chs" #-}
data Property = GSASL_AUTHID
              | GSASL_AUTHZID
              | GSASL_PASSWORD
              | GSASL_ANONYMOUS_TOKEN
              | GSASL_SERVICE
              | GSASL_HOSTNAME
              | GSASL_GSSAPI_DISPLAY_NAME
              | GSASL_PASSCODE
              | GSASL_SUGGESTED_PIN
              | GSASL_PIN
              | GSASL_REALM
              | GSASL_DIGEST_MD5_HASHED_PASSWORD
              | GSASL_QOPS
              | GSASL_QOP
              | GSASL_SCRAM_ITER
              | GSASL_SCRAM_SALT
              | GSASL_SCRAM_SALTED_PASSWORD
              | GSASL_VALIDATE_SIMPLE
              | GSASL_VALIDATE_EXTERNAL
              | GSASL_VALIDATE_ANONYMOUS
              | GSASL_VALIDATE_GSSAPI
              | GSASL_VALIDATE_SECURID
              deriving (Show)
instance Enum Property where
  fromEnum GSASL_AUTHID = 1
  fromEnum GSASL_AUTHZID = 2
  fromEnum GSASL_PASSWORD = 3
  fromEnum GSASL_ANONYMOUS_TOKEN = 4
  fromEnum GSASL_SERVICE = 5
  fromEnum GSASL_HOSTNAME = 6
  fromEnum GSASL_GSSAPI_DISPLAY_NAME = 7
  fromEnum GSASL_PASSCODE = 8
  fromEnum GSASL_SUGGESTED_PIN = 9
  fromEnum GSASL_PIN = 10
  fromEnum GSASL_REALM = 11
  fromEnum GSASL_DIGEST_MD5_HASHED_PASSWORD = 12
  fromEnum GSASL_QOPS = 13
  fromEnum GSASL_QOP = 14
  fromEnum GSASL_SCRAM_ITER = 15
  fromEnum GSASL_SCRAM_SALT = 16
  fromEnum GSASL_SCRAM_SALTED_PASSWORD = 17
  fromEnum GSASL_VALIDATE_SIMPLE = 500
  fromEnum GSASL_VALIDATE_EXTERNAL = 501
  fromEnum GSASL_VALIDATE_ANONYMOUS = 502
  fromEnum GSASL_VALIDATE_GSSAPI = 503
  fromEnum GSASL_VALIDATE_SECURID = 504

  toEnum 1 = GSASL_AUTHID
  toEnum 2 = GSASL_AUTHZID
  toEnum 3 = GSASL_PASSWORD
  toEnum 4 = GSASL_ANONYMOUS_TOKEN
  toEnum 5 = GSASL_SERVICE
  toEnum 6 = GSASL_HOSTNAME
  toEnum 7 = GSASL_GSSAPI_DISPLAY_NAME
  toEnum 8 = GSASL_PASSCODE
  toEnum 9 = GSASL_SUGGESTED_PIN
  toEnum 10 = GSASL_PIN
  toEnum 11 = GSASL_REALM
  toEnum 12 = GSASL_DIGEST_MD5_HASHED_PASSWORD
  toEnum 13 = GSASL_QOPS
  toEnum 14 = GSASL_QOP
  toEnum 15 = GSASL_SCRAM_ITER
  toEnum 16 = GSASL_SCRAM_SALT
  toEnum 17 = GSASL_SCRAM_SALTED_PASSWORD
  toEnum 500 = GSASL_VALIDATE_SIMPLE
  toEnum 501 = GSASL_VALIDATE_EXTERNAL
  toEnum 502 = GSASL_VALIDATE_ANONYMOUS
  toEnum 503 = GSASL_VALIDATE_GSSAPI
  toEnum 504 = GSASL_VALIDATE_SECURID
  toEnum unmatched = error ("Property.toEnum: Cannot match " ++ show unmatched)

{-# LINE 74 "./Network/Protocol/SASL/GSASL.chs" #-}
data SaslPrepFlags = GSASL_ALLOW_UNASSIGNED
                   deriving (Show)
instance Enum SaslPrepFlags where
  fromEnum GSASL_ALLOW_UNASSIGNED = 1

  toEnum 1 = GSASL_ALLOW_UNASSIGNED
  toEnum unmatched = error ("SaslPrepFlags.toEnum: Cannot match " ++ show unmatched)

{-# LINE 75 "./Network/Protocol/SASL/GSASL.chs" #-}

type ContextPtr = Ptr (Context)
{-# LINE 77 "./Network/Protocol/SASL/GSASL.chs" #-}
type SessionPtr = Ptr (Session)
{-# LINE 78 "./Network/Protocol/SASL/GSASL.chs" #-}

data Context = Context { rawContext :: ContextPtr }
data Session = Session { rawSession :: SessionPtr }

type CallbackComputation = (Context -> Session -> Property -> IO ReturnCode)
type RawCallbackComputation = (ContextPtr -> SessionPtr -> CInt -> IO CInt)

-------------------------------------------------------------------------------

cToEnum :: (Enum a) => CInt -> a
cToEnum = toEnum . fromIntegral

cFromEnum :: (Enum a) => a -> CInt
cFromEnum = fromIntegral . fromEnum

cSpacedStringFromList :: [String] -> (CString -> IO a) -> IO a
cSpacedStringFromList xs f = let spaced = intercalate " " xs in
	withCString spaced f

cToMaybeString :: CString -> IO (Maybe String)
cToMaybeString s
	| s == nullPtr = return Nothing
	| otherwise    = peekCString s >>= return . Just

cFromMaybe :: (a -> Ptr b) -> Maybe a -> Ptr b
cFromMaybe _ Nothing  = nullPtr
cFromMaybe f (Just x) = f x

cFromMaybeContext = cFromMaybe rawContext

checkRC :: CInt -> IO ()
checkRC x = let rc = cToEnum x in do
	message <- gsasl_strerror rc
	case rc of
		GSASL_OK -> return ()
		_ -> error message

checkStepRC :: CInt -> IO ReturnCode
checkStepRC x = let rc = cToEnum x in do
	message <- gsasl_strerror rc
	case rc of
		GSASL_OK -> return rc
		GSASL_NEEDS_MORE -> return rc
		_ -> error message

-------------------------------------------------------------------------------

-- Context procedures
mkContext :: IO Context
mkContext =
	alloca $ \pctxt -> do
	gsasl_init pctxt
	rawCtxt <- peek pctxt
	let ctxt = Context rawCtxt
	ctxtPtr <- newStablePtr ctxt
	callbackHookSet rawCtxt (castStablePtrToPtr ctxtPtr)
	return ctxt

gsasl_init :: Ptr ContextPtr -> IO (())
gsasl_init a1 =
  let {a1' = id a1} in 
  gsasl_init'_ a1' >>= \res ->
  checkRC res >>= \res' ->
  return (res')
{-# LINE 139 "./Network/Protocol/SASL/GSASL.chs" #-}

freeContext :: Context -> IO ()
freeContext ctxt = do
	hook <- callbackHookGet (rawContext ctxt)
	freeStablePtr . castPtrToStablePtr $ hook
	gsasl_done ctxt

gsasl_done :: Context -> IO ()
gsasl_done a1 =
  let {a1' = rawContext a1} in 
  gsasl_done'_ a1' >>= \res ->
  return ()
{-# LINE 149 "./Network/Protocol/SASL/GSASL.chs" #-}

withContext :: (Context -> IO a) -> IO a
withContext = bracket mkContext freeContext

clientMechanisms :: Context -> IO [String]
clientMechanisms ctxt =
	alloca $ \pstrs -> do
	gsasl_client_mechlist ctxt pstrs >>= checkRC
	cstrs <- peek pstrs
	strs <- peekCString cstrs
	free cstrs
	return $ split ' ' strs

gsasl_client_mechlist :: Context -> Ptr CString -> IO (CInt)
gsasl_client_mechlist a1 a2 =
  let {a1' = rawContext a1} in 
  let {a2' = id a2} in 
  gsasl_client_mechlist'_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 166 "./Network/Protocol/SASL/GSASL.chs" #-}

serverMechanisms :: Context -> IO [String]
serverMechanisms ctxt =
	alloca $ \pstrs -> do
	gsasl_server_mechlist ctxt pstrs >>= checkRC
	cstrs <- peek pstrs
	strs <- peekCString cstrs
	free cstrs
	return $ split ' ' strs

gsasl_server_mechlist :: Context -> Ptr CString -> IO (CInt)
gsasl_server_mechlist a1 a2 =
  let {a1' = rawContext a1} in 
  let {a2' = id a2} in 
  gsasl_server_mechlist'_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 180 "./Network/Protocol/SASL/GSASL.chs" #-}

clientSupportP :: Context -> String -> IO (Bool)
clientSupportP a1 a2 =
  let {a1' = rawContext a1} in 
  withCString a2 $ \a2' -> 
  clientSupportP'_ a1' a2' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 185 "./Network/Protocol/SASL/GSASL.chs" #-}

serverSupportP :: Context -> String -> IO (Bool)
serverSupportP a1 a2 =
  let {a1' = rawContext a1} in 
  withCString a2 $ \a2' -> 
  serverSupportP'_ a1' a2' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 190 "./Network/Protocol/SASL/GSASL.chs" #-}

clientSuggestMechanism :: Context -> [String] -> IO (Maybe String)
clientSuggestMechanism a1 a2 =
  let {a1' = rawContext a1} in 
  cSpacedStringFromList a2 $ \a2' -> 
  clientSuggestMechanism'_ a1' a2' >>= \res ->
  cToMaybeString res >>= \res' ->
  return (res')
{-# LINE 195 "./Network/Protocol/SASL/GSASL.chs" #-}

-- Callback management
callbackSet :: Context -> FunPtr RawCallbackComputation -> IO ()
callbackSet a1 a2 =
  let {a1' = rawContext a1} in 
  let {a2' = id a2} in 
  callbackSet'_ a1' a2' >>= \res ->
  return ()
{-# LINE 201 "./Network/Protocol/SASL/GSASL.chs" #-}

callback :: Maybe Context -> Session -> Property -> IO (())
callback a1 a2 a3 =
  let {a1' = cFromMaybeContext a1} in 
  let {a2' = rawSession a2} in 
  let {a3' = cFromEnum a3} in 
  callback'_ a1' a2' a3' >>= \res ->
  checkRC res >>= \res' ->
  return (res')
{-# LINE 207 "./Network/Protocol/SASL/GSASL.chs" #-}

withCallbackSet :: Context -> CallbackComputation -> IO a -> IO a
withCallbackSet ctxt comp block = bracket
	(callbackWrapper $ mkCallbackWrapper comp)
	(\funptr -> do
		freeHaskellFunPtr funptr
		callbackSet ctxt nullFunPtr)
	(\funptr -> do
		callbackSet ctxt funptr
		block)

mkCallbackWrapper :: CallbackComputation -> RawCallbackComputation
mkCallbackWrapper comp pCtxt pSession cProp = do
	callbackHook <- callbackHookGet pCtxt
	let ctxtStablePtr = castPtrToStablePtr callbackHook
	ctxt <- (deRefStablePtr ctxtStablePtr :: IO Context)
	
	sessionHook <- sessionHookGet pSession
	let sessStablePtr = castPtrToStablePtr sessionHook
	session <- (deRefStablePtr sessStablePtr :: IO Session)
	
	let prop = (cToEnum cProp :: Property)
	return . cFromEnum =<< comp ctxt session prop

foreign import ccall "wrapper"
	callbackWrapper :: RawCallbackComputation -> IO (FunPtr RawCallbackComputation)

callbackHookSet :: ContextPtr -> Ptr () -> IO ()
callbackHookSet a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  callbackHookSet'_ a1' a2' >>= \res ->
  return ()
{-# LINE 238 "./Network/Protocol/SASL/GSASL.chs" #-}

callbackHookGet :: ContextPtr -> IO (Ptr ())
callbackHookGet a1 =
  let {a1' = id a1} in 
  callbackHookGet'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 242 "./Network/Protocol/SASL/GSASL.chs" #-}

sessionHookSet :: SessionPtr -> Ptr () -> IO ()
sessionHookSet a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  sessionHookSet'_ a1' a2' >>= \res ->
  return ()
{-# LINE 247 "./Network/Protocol/SASL/GSASL.chs" #-}

sessionHookGet :: SessionPtr -> IO (Ptr ())
sessionHookGet a1 =
  let {a1' = id a1} in 
  sessionHookGet'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 251 "./Network/Protocol/SASL/GSASL.chs" #-}

-- Property set/get
propertySet :: Session -> Property -> String -> IO ()
propertySet a1 a2 a3 =
  let {a1' = rawSession a1} in 
  let {a2' = cFromEnum a2} in 
  withCString a3 $ \a3' -> 
  propertySet'_ a1' a2' a3' >>= \res ->
  return ()
{-# LINE 258 "./Network/Protocol/SASL/GSASL.chs" #-}

propertyFast :: Session -> Property -> IO (Maybe String)
propertyFast a1 a2 =
  let {a1' = rawSession a1} in 
  let {a2' = cFromEnum a2} in 
  propertyFast'_ a1' a2' >>= \res ->
  cToMaybeString res >>= \res' ->
  return (res')
{-# LINE 263 "./Network/Protocol/SASL/GSASL.chs" #-}

propertyGet :: Session -> Property -> IO (Maybe String)
propertyGet a1 a2 =
  let {a1' = rawSession a1} in 
  let {a2' = cFromEnum a2} in 
  propertyGet'_ a1' a2' >>= \res ->
  cToMaybeString res >>= \res' ->
  return (res')
{-# LINE 268 "./Network/Protocol/SASL/GSASL.chs" #-}

-- Session procedures
clientStart :: Context -> String -> IO Session
clientStart ctxt s =
	alloca $ \psess -> do
	gsasl_client_start ctxt s psess
	rawSession <- peek psess
	let session = Session rawSession
	sessionPtr <- newStablePtr session
	sessionHookSet rawSession (castStablePtrToPtr sessionPtr)
	return session

gsasl_client_start :: Context -> String -> Ptr SessionPtr -> IO (())
gsasl_client_start a1 a2 a3 =
  let {a1' = rawContext a1} in 
  withCString a2 $ \a2' -> 
  let {a3' = id a3} in 
  gsasl_client_start'_ a1' a2' a3' >>= \res ->
  checkRC res >>= \res' ->
  return (res')
{-# LINE 285 "./Network/Protocol/SASL/GSASL.chs" #-}

serverStart :: Context -> String -> IO Session
serverStart ctxt s =
	alloca $ \psess -> do
	gsasl_server_start ctxt s psess
	rawSession <- peek psess
	let session = Session rawSession
	sessionPtr <- newStablePtr session
	sessionHookSet rawSession (castStablePtrToPtr sessionPtr)
	return session

gsasl_server_start :: Context -> String -> Ptr SessionPtr -> IO (())
gsasl_server_start a1 a2 a3 =
  let {a1' = rawContext a1} in 
  withCString a2 $ \a2' -> 
  let {a3' = id a3} in 
  gsasl_server_start'_ a1' a2' a3' >>= \res ->
  checkRC res >>= \res' ->
  return (res')
{-# LINE 301 "./Network/Protocol/SASL/GSASL.chs" #-}

freeSession :: Session -> IO ()
freeSession session = do
	hook <- sessionHookGet (rawSession session)
	freeStablePtr . castPtrToStablePtr $ hook
	gsasl_finish session

gsasl_finish :: Session -> IO ()
gsasl_finish a1 =
  let {a1' = rawSession a1} in 
  gsasl_finish'_ a1' >>= \res ->
  return ()
{-# LINE 311 "./Network/Protocol/SASL/GSASL.chs" #-}

withSession :: IO Session -> (Session -> IO a) -> IO a
withSession getSession = bracket getSession freeSession

step :: Session -> String -> IO (String, ReturnCode)
step s input =
	withCStringLen input $ \(cInput, cInputLen) -> do
	alloca $ \pOutChars -> do
	alloca $ \pOutLen -> do
	rc <- checkStepRC =<< gsasl_step (rawSession s) cInput (fromIntegral cInputLen) pOutChars pOutLen
	outChars <- peek pOutChars
	outLen <- peek pOutLen
	output <- peekCStringLen (outChars, fromIntegral outLen)
	free outChars
	return (output, rc)

gsasl_step :: SessionPtr -> CString -> CUInt -> Ptr CString -> Ptr CUInt -> IO CInt
gsasl_step = gsasl_step'
{-# LINE 329 "./Network/Protocol/SASL/GSASL.chs" #-}

step64 :: Session -> String -> IO (String, ReturnCode)
step64 s input =
	withCString input $ \cInput -> do
	alloca $ \pOutChars -> do
	rc <- checkStepRC =<< gsasl_step64 (rawSession s) cInput pOutChars
	outChars <- peek pOutChars
	output <- peekCString outChars
	free outChars
	return (output, rc)

gsasl_step64 :: SessionPtr -> CString -> Ptr CString -> IO CInt
gsasl_step64 = gsasl_step64'
{-# LINE 342 "./Network/Protocol/SASL/GSASL.chs" #-}

encode :: Session -> String -> IO String
encode = encodeDecodeImpl gsasl_encode
{-# LINE 345 "./Network/Protocol/SASL/GSASL.chs" #-}

decode :: Session -> String -> IO String
decode = encodeDecodeImpl gsasl_decode
{-# LINE 348 "./Network/Protocol/SASL/GSASL.chs" #-}

encodeDecodeImpl cfunc s input =
	withCStringLen input $ \(cInput, cInputLen) -> do
	alloca $ \pOutChars -> do
	alloca $ \pOutLen -> do
	checkRC =<< cfunc (rawSession s) cInput (fromIntegral cInputLen) pOutChars pOutLen
	outChars <- peek pOutChars
	outLen <- peek pOutLen
	output <- peekCStringLen (outChars, fromIntegral outLen)
	free outChars
	return output

-- Error information
gsasl_strerror :: ReturnCode -> IO (String)
gsasl_strerror a1 =
  let {a1' = cFromEnum a1} in 
  gsasl_strerror'_ a1' >>= \res ->
  peekCString res >>= \res' ->
  return (res')
{-# LINE 364 "./Network/Protocol/SASL/GSASL.chs" #-}

-------------------------------------------------------------------------------

split :: (Eq a) => a -> [a] -> [[a]]
split x ys = filter (not . null) $ split' [] [] x ys

split' :: (Eq a) => [a] -> [[a]] -> a -> [a] -> [[a]]
split' prev acc _     [] = acc ++ [prev]
split' prev acc x (y:ys)
 | x == y = split' [] (acc ++ [prev]) x ys
 | otherwise = split' (prev ++ [y]) acc x ys

foreign import ccall safe "Network/Protocol/SASL/GSASL.chs.h gsasl_init"
  gsasl_init'_ :: ((Ptr (ContextPtr)) -> (IO CInt))

foreign import ccall safe "Network/Protocol/SASL/GSASL.chs.h gsasl_done"
  gsasl_done'_ :: ((ContextPtr) -> (IO ()))

foreign import ccall safe "Network/Protocol/SASL/GSASL.chs.h gsasl_client_mechlist"
  gsasl_client_mechlist'_ :: ((ContextPtr) -> ((Ptr (Ptr CChar)) -> (IO CInt)))

foreign import ccall safe "Network/Protocol/SASL/GSASL.chs.h gsasl_server_mechlist"
  gsasl_server_mechlist'_ :: ((ContextPtr) -> ((Ptr (Ptr CChar)) -> (IO CInt)))

foreign import ccall safe "Network/Protocol/SASL/GSASL.chs.h gsasl_client_support_p"
  clientSupportP'_ :: ((ContextPtr) -> ((Ptr CChar) -> (IO CInt)))

foreign import ccall safe "Network/Protocol/SASL/GSASL.chs.h gsasl_server_support_p"
  serverSupportP'_ :: ((ContextPtr) -> ((Ptr CChar) -> (IO CInt)))

foreign import ccall safe "Network/Protocol/SASL/GSASL.chs.h gsasl_client_suggest_mechanism"
  clientSuggestMechanism'_ :: ((ContextPtr) -> ((Ptr CChar) -> (IO (Ptr CChar))))

foreign import ccall safe "Network/Protocol/SASL/GSASL.chs.h gsasl_callback_set"
  callbackSet'_ :: ((ContextPtr) -> ((FunPtr ((ContextPtr) -> ((SessionPtr) -> (CInt -> (IO CInt))))) -> (IO ())))

foreign import ccall safe "Network/Protocol/SASL/GSASL.chs.h gsasl_callback"
  callback'_ :: ((ContextPtr) -> ((SessionPtr) -> (CInt -> (IO CInt))))

foreign import ccall safe "Network/Protocol/SASL/GSASL.chs.h gsasl_callback_hook_set"
  callbackHookSet'_ :: ((ContextPtr) -> ((Ptr ()) -> (IO ())))

foreign import ccall safe "Network/Protocol/SASL/GSASL.chs.h gsasl_callback_hook_get"
  callbackHookGet'_ :: ((ContextPtr) -> (IO (Ptr ())))

foreign import ccall safe "Network/Protocol/SASL/GSASL.chs.h gsasl_session_hook_set"
  sessionHookSet'_ :: ((SessionPtr) -> ((Ptr ()) -> (IO ())))

foreign import ccall safe "Network/Protocol/SASL/GSASL.chs.h gsasl_session_hook_get"
  sessionHookGet'_ :: ((SessionPtr) -> (IO (Ptr ())))

foreign import ccall safe "Network/Protocol/SASL/GSASL.chs.h gsasl_property_set"
  propertySet'_ :: ((SessionPtr) -> (CInt -> ((Ptr CChar) -> (IO ()))))

foreign import ccall safe "Network/Protocol/SASL/GSASL.chs.h gsasl_property_fast"
  propertyFast'_ :: ((SessionPtr) -> (CInt -> (IO (Ptr CChar))))

foreign import ccall safe "Network/Protocol/SASL/GSASL.chs.h gsasl_property_get"
  propertyGet'_ :: ((SessionPtr) -> (CInt -> (IO (Ptr CChar))))

foreign import ccall safe "Network/Protocol/SASL/GSASL.chs.h gsasl_client_start"
  gsasl_client_start'_ :: ((ContextPtr) -> ((Ptr CChar) -> ((Ptr (SessionPtr)) -> (IO CInt))))

foreign import ccall safe "Network/Protocol/SASL/GSASL.chs.h gsasl_server_start"
  gsasl_server_start'_ :: ((ContextPtr) -> ((Ptr CChar) -> ((Ptr (SessionPtr)) -> (IO CInt))))

foreign import ccall safe "Network/Protocol/SASL/GSASL.chs.h gsasl_finish"
  gsasl_finish'_ :: ((SessionPtr) -> (IO ()))

foreign import ccall safe "Network/Protocol/SASL/GSASL.chs.h gsasl_step"
  gsasl_step' :: ((SessionPtr) -> ((Ptr CChar) -> (CUInt -> ((Ptr (Ptr CChar)) -> ((Ptr CUInt) -> (IO CInt))))))

foreign import ccall safe "Network/Protocol/SASL/GSASL.chs.h gsasl_step64"
  gsasl_step64' :: ((SessionPtr) -> ((Ptr CChar) -> ((Ptr (Ptr CChar)) -> (IO CInt))))

foreign import ccall safe "Network/Protocol/SASL/GSASL.chs.h gsasl_encode"
  gsasl_encode :: ((SessionPtr) -> ((Ptr CChar) -> (CUInt -> ((Ptr (Ptr CChar)) -> ((Ptr CUInt) -> (IO CInt))))))

foreign import ccall safe "Network/Protocol/SASL/GSASL.chs.h gsasl_decode"
  gsasl_decode :: ((SessionPtr) -> ((Ptr CChar) -> (CUInt -> ((Ptr (Ptr CChar)) -> ((Ptr CUInt) -> (IO CInt))))))

foreign import ccall safe "Network/Protocol/SASL/GSASL.chs.h gsasl_strerror"
  gsasl_strerror'_ :: (CInt -> (IO (Ptr CChar)))