packages feed

gsasl 0.2 → 0.3

raw patch · 4 files changed

+1003/−378 lines, 4 filesdep +bytestringdep +transformersPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, transformers

API changes (from Hackage documentation)

- Network.Protocol.SASL.GSASL: GSASL_ANONYMOUS_TOKEN :: Property
- Network.Protocol.SASL.GSASL: GSASL_AUTHENTICATION_ERROR :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_AUTHID :: Property
- Network.Protocol.SASL.GSASL: GSASL_AUTHZID :: Property
- Network.Protocol.SASL.GSASL: GSASL_BASE64_ERROR :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_CRYPTO_ERROR :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_DIGEST_MD5_HASHED_PASSWORD :: Property
- Network.Protocol.SASL.GSASL: GSASL_GSSAPI_ACCEPT_SEC_CONTEXT_ERROR :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_GSSAPI_ACQUIRE_CRED_ERROR :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_GSSAPI_DISPLAY_NAME :: Property
- Network.Protocol.SASL.GSASL: GSASL_GSSAPI_DISPLAY_NAME_ERROR :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_GSSAPI_IMPORT_NAME_ERROR :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_GSSAPI_INIT_SEC_CONTEXT_ERROR :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_GSSAPI_RELEASE_BUFFER_ERROR :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_GSSAPI_UNSUPPORTED_PROTECTION_ERROR :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_GSSAPI_UNWRAP_ERROR :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_GSSAPI_WRAP_ERROR :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_HOSTNAME :: Property
- Network.Protocol.SASL.GSASL: GSASL_INTEGRITY_ERROR :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_KERBEROS_V5_INIT_ERROR :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_KERBEROS_V5_INTERNAL_ERROR :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_MALLOC_ERROR :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_MECHANISM_CALLED_TOO_MANY_TIMES :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_MECHANISM_PARSE_ERROR :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_NEEDS_MORE :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_NO_ANONYMOUS_TOKEN :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_NO_AUTHID :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_NO_AUTHZID :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_NO_CALLBACK :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_NO_CLIENT_CODE :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_NO_HOSTNAME :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_NO_PASSCODE :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_NO_PASSWORD :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_NO_PIN :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_NO_SERVER_CODE :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_NO_SERVICE :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_OK :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_PASSCODE :: Property
- Network.Protocol.SASL.GSASL: GSASL_PASSWORD :: Property
- Network.Protocol.SASL.GSASL: GSASL_PIN :: Property
- Network.Protocol.SASL.GSASL: GSASL_QOP :: Property
- Network.Protocol.SASL.GSASL: GSASL_QOPS :: Property
- Network.Protocol.SASL.GSASL: GSASL_REALM :: Property
- Network.Protocol.SASL.GSASL: GSASL_SASLPREP_ERROR :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_SCRAM_ITER :: Property
- Network.Protocol.SASL.GSASL: GSASL_SCRAM_SALT :: Property
- Network.Protocol.SASL.GSASL: GSASL_SCRAM_SALTED_PASSWORD :: Property
- Network.Protocol.SASL.GSASL: GSASL_SECURID_SERVER_NEED_ADDITIONAL_PASSCODE :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_SECURID_SERVER_NEED_NEW_PIN :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_SERVICE :: Property
- Network.Protocol.SASL.GSASL: GSASL_SHISHI_ERROR :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_SUGGESTED_PIN :: Property
- Network.Protocol.SASL.GSASL: GSASL_UNKNOWN_MECHANISM :: ReturnCode
- Network.Protocol.SASL.GSASL: GSASL_VALIDATE_ANONYMOUS :: Property
- Network.Protocol.SASL.GSASL: GSASL_VALIDATE_EXTERNAL :: Property
- Network.Protocol.SASL.GSASL: GSASL_VALIDATE_GSSAPI :: Property
- Network.Protocol.SASL.GSASL: GSASL_VALIDATE_SECURID :: Property
- Network.Protocol.SASL.GSASL: GSASL_VALIDATE_SIMPLE :: Property
- Network.Protocol.SASL.GSASL: callback :: Maybe Context -> Session -> Property -> IO (())
- Network.Protocol.SASL.GSASL: clientMechanisms :: Context -> IO [String]
- Network.Protocol.SASL.GSASL: clientStart :: Context -> String -> IO Session
- Network.Protocol.SASL.GSASL: clientSuggestMechanism :: Context -> [String] -> IO (Maybe String)
- Network.Protocol.SASL.GSASL: clientSupportP :: Context -> String -> IO (Bool)
- Network.Protocol.SASL.GSASL: data Context
- Network.Protocol.SASL.GSASL: data Property
- Network.Protocol.SASL.GSASL: data ReturnCode
- Network.Protocol.SASL.GSASL: data Session
- Network.Protocol.SASL.GSASL: decode :: Session -> String -> IO String
- Network.Protocol.SASL.GSASL: encode :: Session -> String -> IO String
- Network.Protocol.SASL.GSASL: freeContext :: Context -> IO ()
- Network.Protocol.SASL.GSASL: freeSession :: Session -> IO ()
- Network.Protocol.SASL.GSASL: instance Enum Property
- Network.Protocol.SASL.GSASL: instance Enum ReturnCode
- Network.Protocol.SASL.GSASL: instance Enum SaslPrepFlags
- Network.Protocol.SASL.GSASL: instance Show Property
- Network.Protocol.SASL.GSASL: instance Show ReturnCode
- Network.Protocol.SASL.GSASL: instance Show SaslPrepFlags
- Network.Protocol.SASL.GSASL: mkContext :: IO Context
- Network.Protocol.SASL.GSASL: propertyFast :: Session -> Property -> IO (Maybe String)
- Network.Protocol.SASL.GSASL: propertyGet :: Session -> Property -> IO (Maybe String)
- Network.Protocol.SASL.GSASL: propertySet :: Session -> Property -> String -> IO ()
- Network.Protocol.SASL.GSASL: serverMechanisms :: Context -> IO [String]
- Network.Protocol.SASL.GSASL: serverStart :: Context -> String -> IO Session
- Network.Protocol.SASL.GSASL: serverSupportP :: Context -> String -> IO (Bool)
- Network.Protocol.SASL.GSASL: step :: Session -> String -> IO (String, ReturnCode)
- Network.Protocol.SASL.GSASL: step64 :: Session -> String -> IO (String, ReturnCode)
- Network.Protocol.SASL.GSASL: type CallbackComputation = Context -> Session -> Property -> IO ReturnCode
- Network.Protocol.SASL.GSASL: withCallbackSet :: Context -> CallbackComputation -> IO a -> IO a
- Network.Protocol.SASL.GSASL: withContext :: (Context -> IO a) -> IO a
- Network.Protocol.SASL.GSASL: withSession :: IO Session -> (Session -> IO a) -> IO a
+ Network.Protocol.SASL.GNU: AuthenticationError :: Error
+ Network.Protocol.SASL.GNU: Base64Error :: Error
+ Network.Protocol.SASL.GNU: Complete :: Progress
+ Network.Protocol.SASL.GNU: CryptoError :: Error
+ Network.Protocol.SASL.GNU: GSSAPI_AcceptSecContextError :: Error
+ Network.Protocol.SASL.GNU: GSSAPI_AquireCredError :: Error
+ Network.Protocol.SASL.GNU: GSSAPI_DecapsulateTokenError :: Error
+ Network.Protocol.SASL.GNU: GSSAPI_DisplayNameError :: Error
+ Network.Protocol.SASL.GNU: GSSAPI_EncapsulateTokenError :: Error
+ Network.Protocol.SASL.GNU: GSSAPI_ImportNameError :: Error
+ Network.Protocol.SASL.GNU: GSSAPI_InitSecContextError :: Error
+ Network.Protocol.SASL.GNU: GSSAPI_InquireMechForSASLNameError :: Error
+ Network.Protocol.SASL.GNU: GSSAPI_ReleaseBufferError :: Error
+ Network.Protocol.SASL.GNU: GSSAPI_ReleaseOIDSetError :: Error
+ Network.Protocol.SASL.GNU: GSSAPI_TestOIDSetMemberError :: Error
+ Network.Protocol.SASL.GNU: GSSAPI_UnsupportedProtectionError :: Error
+ Network.Protocol.SASL.GNU: GSSAPI_UnwrapError :: Error
+ Network.Protocol.SASL.GNU: GSSAPI_WrapError :: Error
+ Network.Protocol.SASL.GNU: IntegrityError :: Error
+ Network.Protocol.SASL.GNU: KerberosV5_InitError :: Error
+ Network.Protocol.SASL.GNU: KerberosV5_InternalError :: Error
+ Network.Protocol.SASL.GNU: MallocError :: Error
+ Network.Protocol.SASL.GNU: Mechanism :: ByteString -> Mechanism
+ Network.Protocol.SASL.GNU: MechanismCalledTooManyTimes :: Error
+ Network.Protocol.SASL.GNU: MechanismParseError :: Error
+ Network.Protocol.SASL.GNU: NeedsMore :: Progress
+ Network.Protocol.SASL.GNU: NoAnonymousToken :: Error
+ Network.Protocol.SASL.GNU: NoAuthID :: Error
+ Network.Protocol.SASL.GNU: NoAuthzID :: Error
+ Network.Protocol.SASL.GNU: NoCallback :: Error
+ Network.Protocol.SASL.GNU: NoClientCode :: Error
+ Network.Protocol.SASL.GNU: NoHostname :: Error
+ Network.Protocol.SASL.GNU: NoPIN :: Error
+ Network.Protocol.SASL.GNU: NoPasscode :: Error
+ Network.Protocol.SASL.GNU: NoPassword :: Error
+ Network.Protocol.SASL.GNU: NoServerCode :: Error
+ Network.Protocol.SASL.GNU: NoService :: Error
+ Network.Protocol.SASL.GNU: PropertyAnonymousToken :: Property
+ Network.Protocol.SASL.GNU: PropertyAuthID :: Property
+ Network.Protocol.SASL.GNU: PropertyAuthzID :: Property
+ Network.Protocol.SASL.GNU: PropertyDigestMD5HashedPassword :: Property
+ Network.Protocol.SASL.GNU: PropertyGSSAPIDisplayName :: Property
+ Network.Protocol.SASL.GNU: PropertyHostname :: Property
+ Network.Protocol.SASL.GNU: PropertyPIN :: Property
+ Network.Protocol.SASL.GNU: PropertyPasscode :: Property
+ Network.Protocol.SASL.GNU: PropertyPassword :: Property
+ Network.Protocol.SASL.GNU: PropertyQOP :: Property
+ Network.Protocol.SASL.GNU: PropertyQOPS :: Property
+ Network.Protocol.SASL.GNU: PropertyRealm :: Property
+ Network.Protocol.SASL.GNU: PropertyScramIter :: Property
+ Network.Protocol.SASL.GNU: PropertyScramSalt :: Property
+ Network.Protocol.SASL.GNU: PropertyScramSaltedPassword :: Property
+ Network.Protocol.SASL.GNU: PropertyService :: Property
+ Network.Protocol.SASL.GNU: PropertySuggestedPIN :: Property
+ Network.Protocol.SASL.GNU: SASLPrepError :: Error
+ Network.Protocol.SASL.GNU: SecurID_ServerNeedAdditionalPasscode :: Error
+ Network.Protocol.SASL.GNU: SecurID_ServerNeedNewPIN :: Error
+ Network.Protocol.SASL.GNU: UnknownMechanism :: Error
+ Network.Protocol.SASL.GNU: ValidateAnonymous :: Property
+ Network.Protocol.SASL.GNU: ValidateExternal :: Property
+ Network.Protocol.SASL.GNU: ValidateGSSAPI :: Property
+ Network.Protocol.SASL.GNU: ValidateSecurID :: Property
+ Network.Protocol.SASL.GNU: ValidateSimple :: Property
+ Network.Protocol.SASL.GNU: catch :: Session a -> (Error -> Session a) -> Session a
+ Network.Protocol.SASL.GNU: checkVersion :: IO Bool
+ Network.Protocol.SASL.GNU: clientMechanisms :: SASL [Mechanism]
+ Network.Protocol.SASL.GNU: clientSuggestMechanism :: [Mechanism] -> SASL (Maybe Mechanism)
+ Network.Protocol.SASL.GNU: clientSupports :: Mechanism -> SASL Bool
+ Network.Protocol.SASL.GNU: data Error
+ Network.Protocol.SASL.GNU: data Progress
+ Network.Protocol.SASL.GNU: data Property
+ Network.Protocol.SASL.GNU: data SASL a
+ Network.Protocol.SASL.GNU: data Session a
+ Network.Protocol.SASL.GNU: decode :: ByteString -> Session ByteString
+ Network.Protocol.SASL.GNU: encode :: ByteString -> Session ByteString
+ Network.Protocol.SASL.GNU: fromBase64 :: ByteString -> ByteString
+ Network.Protocol.SASL.GNU: getProperty :: Property -> Session (Maybe ByteString)
+ Network.Protocol.SASL.GNU: getPropertyFast :: Property -> Session (Maybe ByteString)
+ Network.Protocol.SASL.GNU: handle :: (Error -> Session a) -> Session a -> Session a
+ Network.Protocol.SASL.GNU: headerVersion :: (Integer, Integer, Integer)
+ Network.Protocol.SASL.GNU: hmacMD5 :: ByteString -> ByteString -> ByteString
+ Network.Protocol.SASL.GNU: hmacSHA1 :: ByteString -> ByteString -> ByteString
+ Network.Protocol.SASL.GNU: instance Eq Mechanism
+ Network.Protocol.SASL.GNU: instance Eq Progress
+ Network.Protocol.SASL.GNU: instance Eq Property
+ Network.Protocol.SASL.GNU: instance Exception SASLException
+ Network.Protocol.SASL.GNU: instance Functor SASL
+ Network.Protocol.SASL.GNU: instance Functor Session
+ Network.Protocol.SASL.GNU: instance IsString Mechanism
+ Network.Protocol.SASL.GNU: instance Monad SASL
+ Network.Protocol.SASL.GNU: instance Monad Session
+ Network.Protocol.SASL.GNU: instance MonadIO SASL
+ Network.Protocol.SASL.GNU: instance MonadIO Session
+ Network.Protocol.SASL.GNU: instance Show Error
+ Network.Protocol.SASL.GNU: instance Show Mechanism
+ Network.Protocol.SASL.GNU: instance Show Progress
+ Network.Protocol.SASL.GNU: instance Show Property
+ Network.Protocol.SASL.GNU: instance Show SASLException
+ Network.Protocol.SASL.GNU: instance Typeable SASLException
+ Network.Protocol.SASL.GNU: libraryVersion :: IO (Integer, Integer, Integer)
+ Network.Protocol.SASL.GNU: md5 :: ByteString -> ByteString
+ Network.Protocol.SASL.GNU: mechanismName :: Session Mechanism
+ Network.Protocol.SASL.GNU: newtype Mechanism
+ Network.Protocol.SASL.GNU: nonce :: Integer -> IO ByteString
+ Network.Protocol.SASL.GNU: random :: Integer -> IO ByteString
+ Network.Protocol.SASL.GNU: runCallback :: Property -> Session Progress
+ Network.Protocol.SASL.GNU: runClient :: Mechanism -> Session a -> SASL (Either Error a)
+ Network.Protocol.SASL.GNU: runSASL :: SASL a -> IO a
+ Network.Protocol.SASL.GNU: runServer :: Mechanism -> Session a -> SASL (Either Error a)
+ Network.Protocol.SASL.GNU: serverMechanisms :: SASL [Mechanism]
+ Network.Protocol.SASL.GNU: serverSupports :: Mechanism -> SASL Bool
+ Network.Protocol.SASL.GNU: setCallback :: (Property -> Session Progress) -> SASL ()
+ Network.Protocol.SASL.GNU: setProperty :: Property -> ByteString -> Session ()
+ Network.Protocol.SASL.GNU: sha1 :: ByteString -> ByteString
+ Network.Protocol.SASL.GNU: step :: ByteString -> Session (ByteString, Progress)
+ Network.Protocol.SASL.GNU: step64 :: ByteString -> Session (ByteString, Progress)
+ Network.Protocol.SASL.GNU: throw :: Error -> Session a
+ Network.Protocol.SASL.GNU: toBase64 :: ByteString -> ByteString
+ Network.Protocol.SASL.GNU: try :: Session a -> Session (Either Error a)

Files

+ Network/Protocol/SASL/GNU.hs view
@@ -0,0 +1,971 @@+-- 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 #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-}+module Network.Protocol.SASL.GNU+	(+	-- * Library Information+	  headerVersion+	, libraryVersion+	, checkVersion+	+	-- * SASL Contexts+	, SASL+	, runSASL+	, setCallback+	, runCallback+	+	-- * Mechanisms+	, Mechanism (..)+	, clientMechanisms+	, clientSupports+	, clientSuggestMechanism+	, serverMechanisms+	, serverSupports+	+	-- * SASL Sessions+	, Session+	, runClient+	, runServer+	, mechanismName+	+	-- ** Session Properties+	, Property (..)+	, setProperty+	, getProperty+	, getPropertyFast+	+	-- ** Session IO+	, Progress (..)+	, step+	, step64+	, encode+	, decode+	+	-- ** Error handling+	, Error (..)+	, catch+	, handle+	, try+	, throw+	+	-- * Bundled codecs+	, toBase64+	, fromBase64+	, md5+	, sha1+	, hmacMD5+	, hmacSHA1+	, nonce+	, random+	) where++-- Imports {{{++import Prelude hiding (catch)+import qualified Control.Exception as E+import qualified Data.ByteString as B+import qualified Data.ByteString.Unsafe as B+import Data.ByteString.Char8 ()+import Data.Char (isDigit)+import Data.Typeable (Typeable)+import Data.String (IsString, fromString)+import qualified Foreign as F+import qualified Foreign.C as F+import System.IO.Unsafe (unsafePerformIO)+import Control.Monad (when, unless)+import Control.Monad.IO.Class (MonadIO, liftIO)+import qualified Control.Monad.Trans.Reader as R+import qualified Text.ParserCombinators.ReadP as P++-- }}}++-- Library Information {{{++-- | Which version of @gsasl.h@ this module was compiled against+headerVersion :: (Integer, Integer, Integer)+headerVersion = (major, minor, patch) where+	major = toInteger hsgsasl_VERSION_MAJOR+	minor = toInteger hsgsasl_VERSION_MINOR+	patch = toInteger hsgsasl_VERSION_PATCH++-- | Which version of @libgsasl.so@ is loaded+libraryVersion :: IO (Integer, Integer, Integer)+libraryVersion = io where+	parseVersion str = case P.readP_to_S parser str of+		[] -> Nothing+		((parsed, _):_) -> Just parsed+	parser = do+		majorS <- P.munch1 isDigit+		P.char '.'+		minorS <- P.munch1 isDigit+		P.char '.'+		patchS <- P.munch1 isDigit+		P.eof+		return (read majorS, read minorS, read patchS)+	io = do+		cstr <- gsasl_check_version F.nullPtr+		maybeStr <- F.maybePeek F.peekCString cstr+		return $ case maybeStr >>= parseVersion of+			Just version -> version+			Nothing -> error $ "Invalid version string: " ++ show maybeStr++-- | Whether the header and library versions are compatible+checkVersion :: IO Bool+checkVersion = fmap (== 1) hsgsasl_check_version++-- }}}++-- SASL Contexts {{{++newtype Context = Context (F.Ptr Context)+newtype SASL a = SASL { unSASL :: R.ReaderT Context IO a }++instance Functor SASL where+	fmap f = SASL . fmap f . unSASL++instance Monad SASL where+	return = SASL . return+	(>>=) sasl f = SASL $ unSASL sasl >>= unSASL . f++instance MonadIO SASL where+	liftIO = SASL . liftIO++-- TODO: more instances++runSASL :: SASL a -> IO a+runSASL = withContext . R.runReaderT . unSASL++withContext :: (Context -> IO a) -> IO a+withContext = E.bracket newContext freeContext where+	newContext = F.alloca $ \pCtxt -> do+		gsasl_init pCtxt >>= checkRC+		Context `fmap` F.peek pCtxt+	freeContext (Context ctx) = do+		hook <- gsasl_callback_hook_get ctx+		gsasl_done ctx+		freeCallbackHook hook++getContext :: SASL (F.Ptr Context)+getContext = SASL $ do+	Context ptr <- R.ask+	return ptr++bracketSASL :: (F.Ptr Context -> IO a) -> (a -> IO b) -> (a -> IO c) -> SASL c+bracketSASL before after thing = do+	ctx <- getContext+	liftIO $ E.bracket (before ctx) after thing++-- }}}++-- Mechanisms {{{++newtype Mechanism = Mechanism B.ByteString+	deriving (Show, Eq)++instance IsString Mechanism where+	fromString = Mechanism . fromString++-- | A list of 'Mechanism's supported by the @libgsasl@ client.+clientMechanisms :: SASL [Mechanism]+clientMechanisms = bracketSASL io gsasl_free splitMechListPtr where+	io ctx = F.alloca $ \pStr -> do+		gsasl_client_mechlist ctx pStr >>= checkRC+		F.peek pStr++-- | Whether there is client-side support for a specified 'Mechanism'.+clientSupports :: Mechanism -> SASL Bool+clientSupports (Mechanism name) = do+	ctx <- getContext+	liftIO $ B.useAsCString name $ \pName -> do+		cres <- gsasl_client_support_p ctx pName+		return $ cres == 1++-- | Given a list of 'Mechanism's, suggest which to use (or 'Nothing' if+-- no supported 'Mechanism' is found).+clientSuggestMechanism :: [Mechanism] -> SASL (Maybe Mechanism)+clientSuggestMechanism mechs = do+	let bytes = B.intercalate " " [x | Mechanism x <- mechs]+	ctx <- getContext+	liftIO $ B.useAsCString bytes $ \pMechlist ->+		gsasl_client_suggest_mechanism ctx pMechlist >>=+		F.maybePeek (fmap Mechanism . B.packCString)++-- | A list of 'Mechanism's supported by the @libgsasl@ server.+serverMechanisms :: SASL [Mechanism]+serverMechanisms = bracketSASL io gsasl_free splitMechListPtr where+	io ctx = F.alloca $ \pStr -> do+		gsasl_server_mechlist ctx pStr >>= checkRC+		F.peek pStr++-- | Whether there is server-side support for a specified 'Mechanism'.+serverSupports :: Mechanism -> SASL Bool+serverSupports (Mechanism name) = do+	ctx <- getContext+	liftIO $ B.useAsCString name $ \pName -> do+		cres <- gsasl_server_support_p ctx pName+		return $ cres == 1++splitMechListPtr :: F.CString -> IO [Mechanism]+splitMechListPtr ptr = unfoldrM step' (ptr, ptr, 0, True) where+	step' (_, _, _, False) = return Nothing+	step' (p_0, p_i, i, _) = F.peek p_i >>= \chr -> let+		p_i' = F.plusPtr p_i 1+		peek continue = if i == 0+			then step' (p_i', p_i', 0, continue)+			else do+				bytes <- B.packCStringLen (p_0, i)+				return $ Just (Mechanism bytes, (p_i', p_i', 0, continue))+		in case chr of+			0x00 -> peek False+			0x20 -> peek True+			_    -> step' (p_0, p_i', i + 1, True)++-- }}}++-- SASL Sessions {{{++newtype SessionCtx = SessionCtx (F.Ptr SessionCtx)+newtype Session a = Session { unSession :: R.ReaderT SessionCtx IO a }++instance Functor Session where+	fmap f = Session . fmap f . unSession++instance Monad Session where+	return = Session . return+	(>>=) m f = Session $ unSession m >>= unSession . f++instance MonadIO Session where+	liftIO = Session . liftIO++type SessionProc = F.Ptr Context -> F.CString -> F.Ptr (F.Ptr SessionCtx) -> IO F.CInt++runSession :: SessionProc -> Mechanism -> Session a -> SASL (Either Error a)+runSession start (Mechanism mech) session = bracketSASL newSession freeSession io where+	newSession ctx =+		B.useAsCString mech $ \pMech ->+		F.alloca $ \pSessionCtx -> E.handle noSession $ do+		start ctx pMech pSessionCtx >>= checkRC+		fmap (Right . SessionCtx) $ F.peek pSessionCtx+	noSession (SASLException err) = return $ Left err+	+	freeSession (Left _) = return ()+	freeSession (Right (SessionCtx ptr)) = gsasl_finish ptr+	+	io (Left err) = return $ Left err+	io (Right sctx) = E.catch+		(fmap Right $ R.runReaderT (unSession session) sctx)+		(\(SASLException err) -> return $ Left err)++-- | Run a session using the @libgsasl@ client.+runClient :: Mechanism -> Session a -> SASL (Either Error a)+runClient = runSession gsasl_client_start++-- | Run a session using the @libgsasl@ server.+runServer :: Mechanism -> Session a -> SASL (Either Error a)+runServer = runSession gsasl_server_start++getSessionContext :: Session (F.Ptr SessionCtx)+getSessionContext = Session $ do+	SessionCtx sctx <- R.ask+	return sctx++-- | The name of the session's SASL mechanism.+mechanismName :: Session Mechanism+mechanismName = do+	sctx <- getSessionContext+	liftIO $ do+		cstr <- gsasl_mechanism_name sctx+		Mechanism `fmap` B.packCString cstr++bracketSession :: (F.Ptr SessionCtx -> IO a) -> (a -> IO b) -> (a -> IO c) -> Session c+bracketSession before after thing = do+	sctx <- getSessionContext+	liftIO $ E.bracket (before sctx) after thing++-- }}}++-- Error handling {{{++data Error+	= UnknownMechanism+	| MechanismCalledTooManyTimes+	| MallocError+	| Base64Error+	| CryptoError+	| SASLPrepError+	| MechanismParseError+	| AuthenticationError+	| IntegrityError+	| NoClientCode+	| NoServerCode+	| NoCallback+	| NoAnonymousToken+	| NoAuthID+	| NoAuthzID+	| NoPassword+	| NoPasscode+	| NoPIN+	| NoService+	| NoHostname+	+	| GSSAPI_ReleaseBufferError+	| GSSAPI_ImportNameError+	| GSSAPI_InitSecContextError+	| GSSAPI_AcceptSecContextError+	| GSSAPI_UnwrapError+	| GSSAPI_WrapError+	| GSSAPI_AquireCredError+	| GSSAPI_DisplayNameError+	| GSSAPI_UnsupportedProtectionError+	| GSSAPI_EncapsulateTokenError+	| GSSAPI_DecapsulateTokenError+	| GSSAPI_InquireMechForSASLNameError+	| GSSAPI_TestOIDSetMemberError+	| GSSAPI_ReleaseOIDSetError+	+	| KerberosV5_InitError+	| KerberosV5_InternalError+	+	| SecurID_ServerNeedAdditionalPasscode+	| SecurID_ServerNeedNewPIN++instance Show Error where+	show = strError++-- | Convert an error code to a human-readable string explanation for the+-- particular error code.+--+-- This string can be used to output a diagnostic message to the user.+strError :: Error -> String+strError err = unsafePerformIO $ gsasl_strerror (cFromError err) >>= F.peekCString++data SASLException = SASLException Error+	deriving (Show, Typeable)++instance E.Exception SASLException++cFromError :: Error -> F.CInt+cFromError e = case e of+	UnknownMechanism -> 2+	MechanismCalledTooManyTimes -> 3+	MallocError -> 7+	Base64Error -> 8+	CryptoError -> 9+	SASLPrepError -> 29+	MechanismParseError -> 30+	AuthenticationError -> 31+	IntegrityError -> 33+	NoClientCode -> 35+	NoServerCode -> 36+	NoCallback -> 51+	NoAnonymousToken -> 52+	NoAuthID -> 53+	NoAuthzID -> 54+	NoPassword -> 55+	NoPasscode -> 56+	NoPIN -> 57+	NoService -> 58+	NoHostname -> 59+	GSSAPI_ReleaseBufferError -> 37+	GSSAPI_ImportNameError -> 38+	GSSAPI_InitSecContextError -> 39+	GSSAPI_AcceptSecContextError -> 40+	GSSAPI_UnwrapError -> 41+	GSSAPI_WrapError -> 42+	GSSAPI_AquireCredError -> 43+	GSSAPI_DisplayNameError -> 44+	GSSAPI_UnsupportedProtectionError -> 45+	GSSAPI_EncapsulateTokenError -> 60+	GSSAPI_DecapsulateTokenError -> 61+	GSSAPI_InquireMechForSASLNameError -> 62+	GSSAPI_TestOIDSetMemberError -> 63+	GSSAPI_ReleaseOIDSetError -> 64+	KerberosV5_InitError -> 46+	KerberosV5_InternalError -> 47+	SecurID_ServerNeedAdditionalPasscode -> 48+	SecurID_ServerNeedNewPIN -> 49++cToError :: F.CInt -> Error+cToError x = case x of+	2 -> UnknownMechanism+	3 -> MechanismCalledTooManyTimes+	7 -> MallocError+	8 -> Base64Error+	9 -> CryptoError+	29 -> SASLPrepError+	30 -> MechanismParseError+	31 -> AuthenticationError+	33 -> IntegrityError+	35 -> NoClientCode+	36 -> NoServerCode+	51 -> NoCallback+	52 -> NoAnonymousToken +	53 -> NoAuthID+	54 -> NoAuthzID+	55 -> NoPassword+	56 -> NoPasscode+	57 -> NoPIN+	58 -> NoService+	59 -> NoHostname+	37 -> GSSAPI_ReleaseBufferError+	38 -> GSSAPI_ImportNameError+	39 -> GSSAPI_InitSecContextError+	40 -> GSSAPI_AcceptSecContextError+	41 -> GSSAPI_UnwrapError+	42 -> GSSAPI_WrapError+	43 -> GSSAPI_AquireCredError+	44 -> GSSAPI_DisplayNameError+	45 -> GSSAPI_UnsupportedProtectionError+	60 -> GSSAPI_EncapsulateTokenError+	61 -> GSSAPI_DecapsulateTokenError+	62 -> GSSAPI_InquireMechForSASLNameError+	63 -> GSSAPI_TestOIDSetMemberError+	64 -> GSSAPI_ReleaseOIDSetError+	46 -> KerberosV5_InitError+	47 -> KerberosV5_InternalError+	48 -> SecurID_ServerNeedAdditionalPasscode+	49 -> SecurID_ServerNeedNewPIN+	_ -> error $ "Unknown GNU SASL return code: " ++ show x++throw :: Error -> Session a+throw = liftIO . E.throwIO . SASLException++catch :: Session a -> (Error -> Session a) -> Session a+catch m f = do+	sctx <- SessionCtx `fmap` getSessionContext+	Session . liftIO $ E.catch+		(R.runReaderT (unSession m) sctx)+		(\(SASLException err) -> R.runReaderT (unSession (f err)) sctx)++handle :: (Error -> Session a) -> Session a -> Session a+handle = flip catch++try :: Session a -> Session (Either Error a)+try m = catch (fmap Right m) (return . Left)++-- }}}++-- Session Properties {{{++data Property+	= PropertyAuthID+	| PropertyAuthzID+	| PropertyPassword+	| PropertyAnonymousToken+	| PropertyService+	| PropertyHostname+	| PropertyGSSAPIDisplayName+	| PropertyPasscode+	| PropertySuggestedPIN+	| PropertyPIN+	| PropertyRealm+	| PropertyDigestMD5HashedPassword+	| PropertyQOPS+	| PropertyQOP+	| PropertyScramIter+	| PropertyScramSalt+	| PropertyScramSaltedPassword+	+	| ValidateSimple+	| ValidateExternal+	| ValidateAnonymous+	| ValidateGSSAPI+	| ValidateSecurID+	deriving (Show, Eq)++cFromProperty :: Property -> F.CInt+cFromProperty x = case x of+	PropertyAuthID -> 1+	PropertyAuthzID -> 2+	PropertyPassword -> 3+	PropertyAnonymousToken -> 4+	PropertyService -> 5+	PropertyHostname -> 6+	PropertyGSSAPIDisplayName -> 7+	PropertyPasscode -> 8+	PropertySuggestedPIN -> 9+	PropertyPIN -> 10+	PropertyRealm -> 11+	PropertyDigestMD5HashedPassword -> 12+	PropertyQOPS -> 13+	PropertyQOP -> 14+	PropertyScramIter -> 15+	PropertyScramSalt -> 16+	PropertyScramSaltedPassword -> 17+	ValidateSimple -> 500+	ValidateExternal -> 501+	ValidateAnonymous -> 502+	ValidateGSSAPI -> 503+	ValidateSecurID -> 504++cToProperty :: F.CInt -> Property+cToProperty x = case x of+	1 -> PropertyAuthID+	2 -> PropertyAuthzID+	3 -> PropertyPassword+	4 -> PropertyAnonymousToken+	5 -> PropertyService+	6 -> PropertyHostname+	7 -> PropertyGSSAPIDisplayName+	8 -> PropertyPasscode+	9 -> PropertySuggestedPIN+	10 -> PropertyPIN+	11 -> PropertyRealm+	12 -> PropertyDigestMD5HashedPassword+	13 -> PropertyQOPS+	14 -> PropertyQOP+	15 -> PropertyScramIter+	16 -> PropertyScramSalt+	17 -> PropertyScramSaltedPassword+	500 -> ValidateSimple+	501 -> ValidateExternal+	502 -> ValidateAnonymous+	503 -> ValidateGSSAPI+	504 -> ValidateSecurID+	_   -> error $ "Unknown GNU SASL property code: " ++ show x++-- | Store some data in the session for the given property. The data must+-- be @NULL@-terminated.+setProperty :: Property -> B.ByteString -> Session ()+setProperty prop bytes = do+	sctx <- getSessionContext+	liftIO $+		B.useAsCString bytes $+		gsasl_property_set sctx (cFromProperty prop)++-- | Retrieve the data stored in the session for the given property,+-- possibly invoking the current callback to get the value.+getProperty :: Property -> Session (Maybe B.ByteString)+getProperty prop = do+	sctx <- getSessionContext+	liftIO $ do+		cstr <- gsasl_property_get sctx (cFromProperty prop)+		if cstr /= F.nullPtr+			then fmap Just $ B.packCString cstr+			else do+				liftIO $ checkCallbackException sctx+				return Nothing++-- | Retrieve the data stored in the session for the given property,+-- without invoking the current callback.+getPropertyFast :: Property -> Session (Maybe B.ByteString)+getPropertyFast prop = do+	sctx <- getSessionContext+	liftIO $+		gsasl_property_fast sctx (cFromProperty prop) >>=+		F.maybePeek B.packCString++-- }}}++-- Callbacks {{{++type CallbackFn = F.Ptr Context -> F.Ptr SessionCtx -> F.CInt -> IO F.CInt+data CallbackHook = CallbackHook (F.FunPtr CallbackFn) (Property -> Session Progress)++newCallbackHook :: (Property -> Session Progress) -> IO (F.Ptr CallbackHook, F.FunPtr CallbackFn)+newCallbackHook cb = E.bracketOnError+	(wrapCallbackImpl (callbackImpl cb))+	F.freeHaskellFunPtr+	(\funPtr -> let hook = CallbackHook funPtr cb in E.bracketOnError+		(F.newStablePtr hook)+		F.freeStablePtr+		(\stablePtr -> let+			hookPtr = F.castPtr (F.castStablePtrToPtr stablePtr)+			in return (hookPtr, funPtr)))++freeCallbackHook :: F.Ptr CallbackHook -> IO ()+freeCallbackHook ptr = unless (ptr == F.nullPtr) $ do+	let stablePtr = F.castPtrToStablePtr $ F.castPtr ptr+	hook <- F.deRefStablePtr stablePtr+	F.freeStablePtr stablePtr+	let (CallbackHook funPtr _) = hook+	F.freeHaskellFunPtr funPtr++callbackImpl :: (Property -> Session Progress) -> CallbackFn+callbackImpl cb _ sctx cProp = let+	globalIO = error "globalIO is not implemented"+	+	sessionIO = do+		let session = cb $ cToProperty cProp+		fmap cFromProgress $ R.runReaderT (unSession session) (SessionCtx sctx)+	+	onError :: SASLException -> IO F.CInt+	onError (SASLException err) = return $ cFromError err+	+	onException :: E.SomeException -> IO F.CInt+	onException exc = do+		-- A bit ugly; session hooks aren't used anywhere else in+		-- the binding, so the exception is stashed here.+		stablePtr <- F.newStablePtr exc+		gsasl_session_hook_set sctx $ F.castStablePtrToPtr stablePtr+		+		-- standard libgsasl return codes are all >= 0, so using -1+		-- provides an easy way to determine later whether the+		-- exception came from Haskell code.+		return (-1)+	+	catchErrors io = E.catches io [E.Handler onError, E.Handler onException]+	+	in catchErrors $ if sctx == F.nullPtr then globalIO else sessionIO++foreign import ccall "wrapper"+	wrapCallbackImpl :: CallbackFn -> IO (F.FunPtr CallbackFn)++-- Used to check whether a callback threw an exception+checkCallbackException :: F.Ptr SessionCtx -> IO ()+checkCallbackException sctx = do+	hook <- gsasl_session_hook_get sctx+	when (hook /= F.nullPtr) $ do+		let stable = F.castPtrToStablePtr hook+		exc <- F.deRefStablePtr stable+		F.freeStablePtr stable+		E.throwIO (exc :: E.SomeException)++-- | Set the current SASL callback. The callback will be used by mechanisms+-- to discover various parameters, such as usernames and passwords.+setCallback :: (Property -> Session Progress) -> SASL ()+setCallback cb = do+	ctx <- getContext+	liftIO $ do+		freeCallbackHook =<< gsasl_callback_hook_get ctx+		(hook, cbPtr) <- newCallbackHook cb+		gsasl_callback_hook_set ctx hook+		gsasl_callback_set ctx cbPtr++-- | Run the current callback; the property indicates what action the+-- callback is expected to perform.+runCallback :: Property -> Session Progress+runCallback prop = do+	-- This is a bit evil; the first field in Gsasl_session is a Gsasl context,+	-- so it's safe to cast here (assuming they never change the layout).+	ctx <- fmap F.castPtr getSessionContext+	hookPtr <- liftIO $ gsasl_callback_hook_get ctx+	when (hookPtr == F.nullPtr) $ throw NoCallback+	hook <- liftIO $ F.deRefStablePtr $ F.castPtrToStablePtr hookPtr+	let (CallbackHook _ cb) = hook+	cb prop++-- }}}++-- Session IO {{{++data Progress = Complete | NeedsMore+	deriving (Show, Eq)++cFromProgress :: Progress -> F.CInt+cFromProgress x = case x of+	Complete -> 0+	NeedsMore -> 1++-- | Perform one step of SASL authentication. This reads data from the other+-- end, processes it (potentially running the callback), and returns data+-- to be sent back.+--+-- Also returns 'NeedsMore' if authentication is not yet complete.+step :: B.ByteString -> Session (B.ByteString, Progress)+step input = bracketSession get free peek where+	get sctx =+		B.unsafeUseAsCStringLen input $ \(pInput, inputLen) ->+		F.alloca $ \pOutput ->+		F.alloca $ \pOutputLen -> do+		rc <- gsasl_step sctx pInput (fromIntegral inputLen) pOutput pOutputLen+		when (rc /= 0) $ checkCallbackException sctx+		progress <- checkStepRC rc+		cstr <- F.peek pOutput+		cstrLen <- F.peek pOutputLen+		return (cstr, cstrLen, progress)+	+	free (cstr, _, _) = gsasl_free cstr+	peek (cstr, cstrLen, progress) = do+		output <- B.packCStringLen (cstr, fromIntegral cstrLen)+		return (output, progress)++-- | A simple wrapper around 'step' which uses base64 to decode the input+-- and encode the output.+step64 :: B.ByteString -> Session (B.ByteString, Progress)+step64 input = bracketSession get free peek where+	get sctx =+		B.useAsCString input $ \pInput ->+		F.alloca $ \pOutput -> do+		rc <- gsasl_step64 sctx pInput pOutput+		when (rc /= 0) $ checkCallbackException sctx+		progress <- checkStepRC rc+		cstr <- F.peek pOutput+		return (cstr, progress)+	+	free (cstr, _) = gsasl_free cstr+	peek (cstr, progress) = do+		output <- B.packCString cstr+		return (output, progress)++checkStepRC :: F.CInt -> IO Progress+checkStepRC x = case x of+	0 -> return Complete+	1 -> return NeedsMore+	_ -> E.throwIO (SASLException (cToError x))++-- | Encode data according to the negotiated SASL mechanism. This might mean+-- the data is integrity or privacy protected.+encode :: B.ByteString -> Session B.ByteString+encode input = do+	sctx <- getSessionContext+	liftIO $+		B.unsafeUseAsCStringLen input $ \(cstr, cstrLen) ->+		F.alloca $ \pOutput ->+		F.alloca $ \pOutputLen -> do+			rc <- gsasl_encode sctx cstr (fromIntegral cstrLen) pOutput pOutputLen+			when (rc /= 0) $ checkCallbackException sctx+			checkRC rc+			output <- F.peek pOutput+			outputLen <- fromIntegral `fmap` F.peek pOutputLen+			outBytes <- B.packCStringLen (output, outputLen)+			gsasl_free output+			return outBytes++-- | Decode data according to the negotiated SASL mechanism. This might mean+-- the data is integrity or privacy protected.+decode :: B.ByteString -> Session B.ByteString+decode input = do+	sctx <- getSessionContext+	liftIO $+		B.unsafeUseAsCStringLen input $ \(cstr, cstrLen) ->+		F.alloca $ \pOutput ->+		F.alloca $ \pOutputLen -> do+			rc <- gsasl_decode sctx cstr (fromIntegral cstrLen) pOutput pOutputLen+			when (rc /= 0) $ checkCallbackException sctx+			checkRC rc+			output <- F.peek pOutput+			outputLen <- fromIntegral `fmap` F.peek pOutputLen+			outputBytes <- B.packCStringLen (output, outputLen)+			gsasl_free output+			return outputBytes++-- }}}++-- Bundled codecs {{{++toBase64 :: B.ByteString -> B.ByteString+toBase64 input = unsafePerformIO $+	B.unsafeUseAsCStringLen input $ \(pIn, inLen) ->+	F.alloca $ \pOut ->+	F.alloca $ \pOutLen -> do+	gsasl_base64_to pIn (fromIntegral inLen) pOut pOutLen >>= checkRC+	outLen <- F.peek pOutLen+	outPtr <- F.peek pOut+	B.packCStringLen (outPtr, fromIntegral outLen)++fromBase64 :: B.ByteString -> B.ByteString+fromBase64 input = unsafePerformIO $+	B.unsafeUseAsCStringLen input $ \(pIn, inLen) ->+	F.alloca $ \pOut ->+	F.alloca $ \pOutLen -> do+	gsasl_base64_from pIn (fromIntegral inLen) pOut pOutLen >>= checkRC+	outLen <- F.peek pOutLen+	outPtr <- F.peek pOut+	B.packCStringLen (outPtr, fromIntegral outLen)++md5 :: B.ByteString -> B.ByteString+md5 input = unsafePerformIO $+	B.unsafeUseAsCStringLen input $ \(pIn, inLen) ->+	F.alloca $ \pOut ->+	F.allocaBytes 16 $ \outBuf -> do+	F.poke pOut outBuf+	gsasl_md5 pIn (fromIntegral inLen) pOut >>= checkRC+	B.packCStringLen (outBuf, 16)++sha1 :: B.ByteString -> B.ByteString+sha1 input = unsafePerformIO $+	B.unsafeUseAsCStringLen input $ \(pIn, inLen) ->+	F.alloca $ \pOut ->+	F.allocaBytes 20 $ \outBuf -> do+	F.poke pOut outBuf+	gsasl_sha1 pIn (fromIntegral inLen) pOut >>= checkRC+	B.packCStringLen (outBuf, 20)++hmacMD5 :: B.ByteString -- ^ Key+        -> B.ByteString -- ^ Input data+        -> B.ByteString+hmacMD5 key input = unsafePerformIO $+	B.unsafeUseAsCStringLen key $ \(pKey, keyLen) ->+	B.unsafeUseAsCStringLen input $ \(pIn, inLen) ->+	F.alloca $ \pOut ->+	F.allocaBytes 16 $ \outBuf -> do+	F.poke pOut outBuf+	gsasl_hmac_md5 pKey (fromIntegral keyLen) pIn (fromIntegral inLen) pOut >>= checkRC+	B.packCStringLen (outBuf, 16)++hmacSHA1 :: B.ByteString -- ^ Key+         -> B.ByteString -- ^ Input data+         -> B.ByteString+hmacSHA1 key input = unsafePerformIO $+	B.unsafeUseAsCStringLen key $ \(pKey, keyLen) ->+	B.unsafeUseAsCStringLen input $ \(pIn, inLen) ->+	F.alloca $ \pOut ->+	F.allocaBytes 20 $ \outBuf -> do+	F.poke pOut outBuf+	gsasl_hmac_sha1 pKey (fromIntegral keyLen) pIn (fromIntegral inLen) pOut >>= checkRC+	B.packCStringLen (outBuf, 20)++-- | Returns unpredictable data of a given size+nonce :: Integer -> IO B.ByteString+nonce size = F.allocaBytes (fromInteger size) $ \buf -> do+	gsasl_nonce buf (fromIntegral size) >>= checkRC+	B.packCStringLen (buf, fromIntegral size)++-- | Returns cryptographically strong random data of a given size+random :: Integer -> IO B.ByteString+random size = F.allocaBytes (fromInteger size) $ \buf -> do+	gsasl_random buf (fromIntegral size) >>= checkRC+	B.packCStringLen (buf, fromIntegral size)+++-- }}}++-- Miscellaneous {{{++checkRC :: F.CInt -> IO ()+checkRC x = case x of+	0 -> return ()+	_ -> E.throwIO (SASLException (cToError x))++unfoldrM :: Monad m => (b -> m (Maybe (a, b))) -> b -> m [a]+unfoldrM m b = m b >>= \x -> case x of+	Just (a, new_b) -> do+		as <- unfoldrM m new_b+		return $ a : as+	Nothing -> return []++-- }}}++-- FFI imports {{{++foreign import ccall unsafe "hsgsasl_VERSION_MAJOR"+	hsgsasl_VERSION_MAJOR :: F.CInt++foreign import ccall unsafe "hsgsasl_VERSION_MINOR"+	hsgsasl_VERSION_MINOR :: F.CInt++foreign import ccall unsafe "hsgsasl_VERSION_PATCH"+	hsgsasl_VERSION_PATCH :: F.CInt++foreign import ccall unsafe "hsgsasl_check_version"+	hsgsasl_check_version :: IO F.CInt++foreign import ccall unsafe "gsasl.h gsasl_init"+	gsasl_init :: F.Ptr (F.Ptr Context) -> IO F.CInt++foreign import ccall unsafe "gsasl.h gsasl_done"+	gsasl_done :: F.Ptr Context -> IO ()++foreign import ccall unsafe "gsasl.h gsasl_check_version"+	gsasl_check_version :: F.CString -> IO F.CString++foreign import ccall unsafe "gsasl.h gsasl_callback_set"+	gsasl_callback_set :: F.Ptr Context -> F.FunPtr CallbackFn -> IO ()++foreign import ccall unsafe "gsasl.h gsasl_callback_hook_get"+	gsasl_callback_hook_get :: F.Ptr Context -> IO (F.Ptr a)++foreign import ccall unsafe "gsasl.h gsasl_callback_hook_set"+	gsasl_callback_hook_set :: F.Ptr Context -> F.Ptr a -> IO ()++foreign import ccall unsafe "gsasl.h gsasl_session_hook_get"+	gsasl_session_hook_get :: F.Ptr SessionCtx -> IO (F.Ptr a)++foreign import ccall unsafe "gsasl.h gsasl_session_hook_set"+	gsasl_session_hook_set :: F.Ptr SessionCtx -> F.Ptr a -> IO ()++foreign import ccall unsafe "gsasl.h gsasl_property_set"+	gsasl_property_set :: F.Ptr SessionCtx -> F.CInt -> F.CString -> IO ()++foreign import ccall safe "gsasl.h gsasl_property_get"+	gsasl_property_get :: F.Ptr SessionCtx -> F.CInt -> IO F.CString++foreign import ccall unsafe "gsasl.h gsasl_property_fast"+	gsasl_property_fast :: F.Ptr SessionCtx -> F.CInt -> IO F.CString++foreign import ccall unsafe "gsasl.h gsasl_client_mechlist"+	gsasl_client_mechlist :: F.Ptr Context -> F.Ptr F.CString -> IO F.CInt++foreign import ccall unsafe "gsasl.h gsasl_client_support_p"+	gsasl_client_support_p :: F.Ptr Context -> F.CString -> IO F.CInt++foreign import ccall unsafe "gsasl.h gsasl_client_suggest_mechanism"+	gsasl_client_suggest_mechanism :: F.Ptr Context -> F.CString -> IO F.CString++foreign import ccall unsafe "gsasl.h gsasl_server_mechlist"+	gsasl_server_mechlist :: F.Ptr Context -> F.Ptr F.CString -> IO F.CInt++foreign import ccall unsafe "gsasl.h gsasl_server_support_p"+	gsasl_server_support_p :: F.Ptr Context -> F.CString -> IO F.CInt++foreign import ccall safe "gsasl.h gsasl_client_start"+	gsasl_client_start :: SessionProc++foreign import ccall safe "gsasl.h gsasl_server_start"+	gsasl_server_start :: SessionProc++foreign import ccall safe "gsasl.h gsasl_step"+	gsasl_step :: F.Ptr SessionCtx -> F.CString -> F.CSize -> F.Ptr F.CString -> F.Ptr F.CSize -> IO F.CInt++foreign import ccall safe "gsasl.h gsasl_step64"+	gsasl_step64 :: F.Ptr SessionCtx -> F.CString -> F.Ptr F.CString -> IO F.CInt++foreign import ccall safe "gsasl.h gsasl_finish"+	gsasl_finish :: F.Ptr SessionCtx -> IO ()++foreign import ccall safe "gsasl.h gsasl_encode"+	gsasl_encode :: F.Ptr SessionCtx -> F.CString -> F.CSize -> F.Ptr F.CString -> F.Ptr F.CSize -> IO F.CInt++foreign import ccall safe "gsasl.h gsasl_decode"+	gsasl_decode :: F.Ptr SessionCtx -> F.CString -> F.CSize -> F.Ptr F.CString -> F.Ptr F.CSize -> IO F.CInt++foreign import ccall unsafe "gsasl.h gsasl_mechanism_name"+	gsasl_mechanism_name :: F.Ptr SessionCtx -> IO F.CString++foreign import ccall unsafe "gsasl.h gsasl_strerror"+	gsasl_strerror :: F.CInt -> IO F.CString++foreign import ccall unsafe "gsasl.h gsasl_base64_to"+	gsasl_base64_to :: F.CString -> F.CSize -> F.Ptr F.CString -> F.Ptr F.CSize -> IO F.CInt++foreign import ccall unsafe "gsasl.h gsasl_base64_from"+	gsasl_base64_from :: F.CString -> F.CSize -> F.Ptr F.CString -> F.Ptr F.CSize -> IO F.CInt++foreign import ccall unsafe "gsasl.h gsasl_md5"+	gsasl_md5 :: F.CString -> F.CSize -> F.Ptr F.CString -> IO F.CInt++foreign import ccall unsafe "gsasl.h gsasl_sha1"+	gsasl_sha1 :: F.CString -> F.CSize -> F.Ptr F.CString -> IO F.CInt++foreign import ccall unsafe "gsasl.h gsasl_hmac_md5"+	gsasl_hmac_md5 :: F.CString -> F.CSize -> F.CString -> F.CSize -> F.Ptr F.CString -> IO F.CInt++foreign import ccall unsafe "gsasl.h gsasl_hmac_sha1"+	gsasl_hmac_sha1 :: F.CString -> F.CSize -> F.CString -> F.CSize -> F.Ptr F.CString -> IO F.CInt++foreign import ccall unsafe "gsasl.h gsasl_nonce"+	gsasl_nonce :: F.CString -> F.CSize -> IO F.CInt++foreign import ccall unsafe "gsasl.h gsasl_random"+	gsasl_random :: F.CString -> F.CSize -> IO F.CInt++foreign import ccall unsafe "gsasl.h gsasl_free"+	gsasl_free :: F.Ptr a -> IO ()++-- }}}
− Network/Protocol/SASL/GSASL.chs
@@ -1,369 +0,0 @@-{- 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 #-}--#include <gsasl.h>--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)--{#enum Gsasl_rc as ReturnCode {} deriving (Show) #}-{#enum Gsasl_property as Property {} deriving (Show) #}-{#enum Gsasl_saslprep_flags as SaslPrepFlags {} deriving (Show) #}--{#pointer *Gsasl as ContextPtr -> Context #}-{#pointer *Gsasl_session as SessionPtr -> Session #}--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--{#fun gsasl_init {-	id `Ptr ContextPtr'-	} -> `()' checkRC* #}--freeContext :: Context -> IO ()-freeContext ctxt = do-	hook <- callbackHookGet (rawContext ctxt)-	freeStablePtr . castPtrToStablePtr $ hook-	gsasl_done ctxt--{#fun gsasl_done  {-	rawContext `Context'-	} -> `()' #}--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--{#fun gsasl_client_mechlist {-	 rawContext `Context'-	,id `Ptr CString'-	} -> `CInt' id #}--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--{#fun gsasl_server_mechlist {-	 rawContext `Context'-	,id `Ptr CString'-	} -> `CInt' id #}--{#fun gsasl_client_support_p as clientSupportP {-	 rawContext `Context'-	,`String'-	} -> `Bool' toBool #}--{#fun gsasl_server_support_p as serverSupportP {-	 rawContext `Context'-	,`String'-	} -> `Bool' toBool #}--{#fun gsasl_client_suggest_mechanism as clientSuggestMechanism {-	 rawContext `Context'-	,cSpacedStringFromList* `[String]'-	} -> `Maybe String' cToMaybeString* #}---- Callback management-{#fun gsasl_callback_set as callbackSet {-	 rawContext `Context'-	,id `FunPtr RawCallbackComputation'-	} -> `()' #}--{#fun gsasl_callback  as callback {-	 cFromMaybeContext `Maybe Context'-	,rawSession `Session'-	,cFromEnum `Property'-	} -> `()' checkRC* #}--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)--{#fun gsasl_callback_hook_set as callbackHookSet {-	 id `ContextPtr'-	,id `Ptr ()'-	} -> `()' #}--{#fun gsasl_callback_hook_get as callbackHookGet {-	 id `ContextPtr'-	} -> `Ptr ()' id #}--{#fun gsasl_session_hook_set as sessionHookSet {-	 id `SessionPtr'-	,id `Ptr ()'-	} -> `()' #}--{#fun gsasl_session_hook_get as sessionHookGet {-	 id `SessionPtr'-	} -> `Ptr ()' id #}---- Property set/get-{#fun gsasl_property_set as propertySet {-	 rawSession `Session'-	,cFromEnum `Property'-	, `String'-	} -> `()' #}--{#fun gsasl_property_fast as propertyFast {-	 rawSession `Session'-	,cFromEnum `Property'-	} -> `Maybe String' cToMaybeString* #}--{#fun gsasl_property_get as propertyGet {-	 rawSession `Session'-	,cFromEnum `Property'-	} -> `Maybe String' cToMaybeString* #}---- 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--{#fun gsasl_client_start {-	 rawContext `Context'-	,`String'-	,id `Ptr SessionPtr'-	} -> `()' checkRC* #}--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--{#fun gsasl_server_start {-	 rawContext `Context'-	,`String'-	,id `Ptr SessionPtr'-	} -> `()' checkRC* #}--freeSession :: Session -> IO ()-freeSession session = do-	hook <- sessionHookGet (rawSession session)-	freeStablePtr . castPtrToStablePtr $ hook-	gsasl_finish session--{#fun gsasl_finish {-	 rawSession `Session'-	} -> `()' #}--withSession :: IO Session -> (Session -> IO a) -> IO a-withSession getSession = bracket getSession freeSession--step :: Session -> String -> IO (String, ReturnCode)-step s input = let step' = {#call gsasl_step #} (rawSession s) in-	withCStringLen input $ \(cInput, cInputLen) -> do-	alloca $ \pOutChars -> do-	alloca $ \pOutLen -> do-	rc <- checkStepRC =<< step' cInput (fromIntegral cInputLen) pOutChars pOutLen-	outChars <- peek pOutChars-	outLen <- peek pOutLen-	output <- peekCStringLen (outChars, fromIntegral outLen)-	free outChars-	return (output, rc)--step64 :: Session -> String -> IO (String, ReturnCode)-step64 s input = let step64' = {#call gsasl_step64 #} (rawSession s) in-	withCString input $ \cInput -> do-	alloca $ \pOutChars -> do-	rc <- checkStepRC =<< step64' cInput pOutChars-	outChars <- peek pOutChars-	output <- peekCString outChars-	free outChars-	return (output, rc)--encode :: Session -> String -> IO String-encode = encodeDecodeImpl {#call gsasl_encode #}--decode :: Session -> String -> IO String-decode = encodeDecodeImpl {#call gsasl_decode #}--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-{#fun gsasl_strerror {-	 cFromEnum `ReturnCode'-	} -> `String' #}-----------------------------------------------------------------------------------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
gsasl.cabal view
@@ -1,21 +1,31 @@ name: gsasl-version: 0.2-stability: Alpha+version: 0.3 synopsis: Bindings for GNU SASL-license: GPL+license: GPL-3 license-file: License.txt author: John Millikin maintainer: jmillikin@gmail.com build-type: Simple-cabal-version: >=1.2+cabal-version: >=1.6 category: Network+stability: unstable+bug-reports: mailto:jmillikin@gmail.com+homepage: http://ianen.org/haskell/bindings/gsasl/+tested-with: GHC==6.12.1 +source-repository head+  type: darcs+  location: http://ianen.org/haskell/bindings/gsasl/+ library-  build-depends: base >=3 && < 5-  build-tools: c2hs-  exposed-modules: Network.Protocol.SASL.GSASL+  build-depends:+      base >=3 && < 5+    , transformers >= 0.2 && < 0.3+    , bytestring >= 0.9 && < 0.10 +  exposed-modules: Network.Protocol.SASL.GNU++  ghc-options: -Wall -fno-warn-unused-do-bind   extra-libraries: gsasl   pkgconfig-depends: libgsasl--  extensions: ForeignFunctionInterface+  c-sources: hsgsasl-shim.c
+ hsgsasl-shim.c view
@@ -0,0 +1,13 @@+#include <gsasl.h>++int hsgsasl_VERSION_MAJOR()+{ return GSASL_VERSION_MAJOR; }++int hsgsasl_VERSION_MINOR()+{ return GSASL_VERSION_MINOR; }++int hsgsasl_VERSION_PATCH()+{ return GSASL_VERSION_PATCH; }++int hsgsasl_check_version ()+{ return gsasl_check_version (GSASL_VERSION) != NULL; }