-- 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 #-}moduleNetwork.Protocol.SASL.GNU(-- * Library InformationheaderVersion,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 {{{importPreludehiding(catch)importqualifiedControl.ExceptionasEimportqualifiedData.ByteStringasBimportqualifiedData.ByteString.UnsafeasBimportData.ByteString.Char8()importData.Char(isDigit)importData.Typeable(Typeable)importData.String(IsString,fromString)importqualifiedForeignasFimportqualifiedForeign.CasFimportSystem.IO.Unsafe(unsafePerformIO)importControl.Monad(when,unless)importControl.Monad.IO.Class(MonadIO,liftIO)importqualifiedControl.Monad.Trans.ReaderasRimportqualifiedText.ParserCombinators.ReadPasP-- }}}-- Library Information {{{-- | Which version of @gsasl.h@ this module was compiled againstheaderVersion::(Integer,Integer,Integer)headerVersion=(major,minor,patch)wheremajor=toIntegerhsgsasl_VERSION_MAJORminor=toIntegerhsgsasl_VERSION_MINORpatch=toIntegerhsgsasl_VERSION_PATCH-- | Which version of @libgsasl.so@ is loadedlibraryVersion::IO(Integer,Integer,Integer)libraryVersion=iowhereparseVersionstr=caseP.readP_to_Sparserstrof[]->Nothing((parsed,_):_)->Justparsedparser=domajorS<-P.munch1isDigitP.char'.'minorS<-P.munch1isDigitP.char'.'patchS<-P.munch1isDigitP.eofreturn(readmajorS,readminorS,readpatchS)io=docstr<-gsasl_check_versionF.nullPtrmaybeStr<-F.maybePeekF.peekCStringcstrreturn$casemaybeStr>>=parseVersionofJustversion->versionNothing->error$"Invalid version string: "++showmaybeStr-- | Whether the header and library versions are compatiblecheckVersion::IOBoolcheckVersion=fmap(==1)hsgsasl_check_version-- }}}-- SASL Contexts {{{newtypeContext=Context(F.PtrContext)newtypeSASLa=SASL{unSASL::R.ReaderTContextIOa}instanceFunctorSASLwherefmapf=SASL.fmapf.unSASLinstanceMonadSASLwherereturn=SASL.return(>>=)saslf=SASL$unSASLsasl>>=unSASL.finstanceMonadIOSASLwhereliftIO=SASL.liftIO-- TODO: more instancesrunSASL::SASLa->IOarunSASL=withContext.R.runReaderT.unSASLwithContext::(Context->IOa)->IOawithContext=E.bracketnewContextfreeContextwherenewContext=F.alloca$\pCtxt->dogsasl_initpCtxt>>=checkRCContext`fmap`F.peekpCtxtfreeContext(Contextctx)=dohook<-gsasl_callback_hook_getctxgsasl_donectxfreeCallbackHookhookgetContext::SASL(F.PtrContext)getContext=SASL$doContextptr<-R.askreturnptrbracketSASL::(F.PtrContext->IOa)->(a->IOb)->(a->IOc)->SASLcbracketSASLbeforeafterthing=doctx<-getContextliftIO$E.bracket(beforectx)afterthing-- }}}-- Mechanisms {{{newtypeMechanism=MechanismB.ByteStringderiving(Show,Eq)instanceIsStringMechanismwherefromString=Mechanism.fromString-- | A list of 'Mechanism's supported by the @libgsasl@ client.clientMechanisms::SASL[Mechanism]clientMechanisms=bracketSASLiogsasl_freesplitMechListPtrwhereioctx=F.alloca$\pStr->dogsasl_client_mechlistctxpStr>>=checkRCF.peekpStr-- | Whether there is client-side support for a specified 'Mechanism'.clientSupports::Mechanism->SASLBoolclientSupports(Mechanismname)=doctx<-getContextliftIO$B.useAsCStringname$\pName->docres<-gsasl_client_support_pctxpNamereturn$cres==1-- | Given a list of 'Mechanism's, suggest which to use (or 'Nothing' if-- no supported 'Mechanism' is found).clientSuggestMechanism::[Mechanism]->SASL(MaybeMechanism)clientSuggestMechanismmechs=doletbytes=B.intercalate" "[x|Mechanismx<-mechs]ctx<-getContextliftIO$B.useAsCStringbytes$\pMechlist->gsasl_client_suggest_mechanismctxpMechlist>>=F.maybePeek(fmapMechanism.B.packCString)-- | A list of 'Mechanism's supported by the @libgsasl@ server.serverMechanisms::SASL[Mechanism]serverMechanisms=bracketSASLiogsasl_freesplitMechListPtrwhereioctx=F.alloca$\pStr->dogsasl_server_mechlistctxpStr>>=checkRCF.peekpStr-- | Whether there is server-side support for a specified 'Mechanism'.serverSupports::Mechanism->SASLBoolserverSupports(Mechanismname)=doctx<-getContextliftIO$B.useAsCStringname$\pName->docres<-gsasl_server_support_pctxpNamereturn$cres==1splitMechListPtr::F.CString->IO[Mechanism]splitMechListPtrptr=unfoldrMstep'(ptr,ptr,0,True)wherestep'(_,_,_,False)=returnNothingstep'(p_0,p_i,i,_)=F.peekp_i>>=\chr->letp_i'=F.plusPtrp_i1peekcontinue=ifi==0thenstep'(p_i',p_i',0,continue)elsedobytes<-B.packCStringLen(p_0,i)return$Just(Mechanismbytes,(p_i',p_i',0,continue))incasechrof0x00->peekFalse0x20->peekTrue_->step'(p_0,p_i',i+1,True)-- }}}-- SASL Sessions {{{newtypeSessionCtx=SessionCtx(F.PtrSessionCtx)newtypeSessiona=Session{unSession::R.ReaderTSessionCtxIOa}instanceFunctorSessionwherefmapf=Session.fmapf.unSessioninstanceMonadSessionwherereturn=Session.return(>>=)mf=Session$unSessionm>>=unSession.finstanceMonadIOSessionwhereliftIO=Session.liftIOtypeSessionProc=F.PtrContext->F.CString->F.Ptr(F.PtrSessionCtx)->IOF.CIntrunSession::SessionProc->Mechanism->Sessiona->SASL(EitherErrora)runSessionstart(Mechanismmech)session=bracketSASLnewSessionfreeSessioniowherenewSessionctx=B.useAsCStringmech$\pMech->F.alloca$\pSessionCtx->E.handlenoSession$dostartctxpMechpSessionCtx>>=checkRCfmap(Right.SessionCtx)$F.peekpSessionCtxnoSession(SASLExceptionerr)=return$LefterrfreeSession(Left_)=return()freeSession(Right(SessionCtxptr))=gsasl_finishptrio(Lefterr)=return$Lefterrio(Rightsctx)=E.catch(fmapRight$R.runReaderT(unSessionsession)sctx)(\(SASLExceptionerr)->return$Lefterr)-- | Run a session using the @libgsasl@ client.runClient::Mechanism->Sessiona->SASL(EitherErrora)runClient=runSessiongsasl_client_start-- | Run a session using the @libgsasl@ server.runServer::Mechanism->Sessiona->SASL(EitherErrora)runServer=runSessiongsasl_server_startgetSessionContext::Session(F.PtrSessionCtx)getSessionContext=Session$doSessionCtxsctx<-R.askreturnsctx-- | The name of the session's SASL mechanism.mechanismName::SessionMechanismmechanismName=dosctx<-getSessionContextliftIO$docstr<-gsasl_mechanism_namesctxMechanism`fmap`B.packCStringcstrbracketSession::(F.PtrSessionCtx->IOa)->(a->IOb)->(a->IOc)->SessioncbracketSessionbeforeafterthing=dosctx<-getSessionContextliftIO$E.bracket(beforesctx)afterthing-- }}}-- Error handling {{{dataError=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_ServerNeedNewPINinstanceShowErrorwhereshow=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->StringstrErrorerr=unsafePerformIO$gsasl_strerror(cFromErrorerr)>>=F.peekCStringdataSASLException=SASLExceptionErrorderiving(Show,Typeable)instanceE.ExceptionSASLExceptioncFromError::Error->F.CIntcFromErrore=caseeofUnknownMechanism->2MechanismCalledTooManyTimes->3MallocError->7Base64Error->8CryptoError->9SASLPrepError->29MechanismParseError->30AuthenticationError->31IntegrityError->33NoClientCode->35NoServerCode->36NoCallback->51NoAnonymousToken->52NoAuthID->53NoAuthzID->54NoPassword->55NoPasscode->56NoPIN->57NoService->58NoHostname->59GSSAPI_ReleaseBufferError->37GSSAPI_ImportNameError->38GSSAPI_InitSecContextError->39GSSAPI_AcceptSecContextError->40GSSAPI_UnwrapError->41GSSAPI_WrapError->42GSSAPI_AquireCredError->43GSSAPI_DisplayNameError->44GSSAPI_UnsupportedProtectionError->45GSSAPI_EncapsulateTokenError->60GSSAPI_DecapsulateTokenError->61GSSAPI_InquireMechForSASLNameError->62GSSAPI_TestOIDSetMemberError->63GSSAPI_ReleaseOIDSetError->64KerberosV5_InitError->46KerberosV5_InternalError->47SecurID_ServerNeedAdditionalPasscode->48SecurID_ServerNeedNewPIN->49cToError::F.CInt->ErrorcToErrorx=casexof2->UnknownMechanism3->MechanismCalledTooManyTimes7->MallocError8->Base64Error9->CryptoError29->SASLPrepError30->MechanismParseError31->AuthenticationError33->IntegrityError35->NoClientCode36->NoServerCode51->NoCallback52->NoAnonymousToken53->NoAuthID54->NoAuthzID55->NoPassword56->NoPasscode57->NoPIN58->NoService59->NoHostname37->GSSAPI_ReleaseBufferError38->GSSAPI_ImportNameError39->GSSAPI_InitSecContextError40->GSSAPI_AcceptSecContextError41->GSSAPI_UnwrapError42->GSSAPI_WrapError43->GSSAPI_AquireCredError44->GSSAPI_DisplayNameError45->GSSAPI_UnsupportedProtectionError60->GSSAPI_EncapsulateTokenError61->GSSAPI_DecapsulateTokenError62->GSSAPI_InquireMechForSASLNameError63->GSSAPI_TestOIDSetMemberError64->GSSAPI_ReleaseOIDSetError46->KerberosV5_InitError47->KerberosV5_InternalError48->SecurID_ServerNeedAdditionalPasscode49->SecurID_ServerNeedNewPIN_->error$"Unknown GNU SASL return code: "++showxthrow::Error->Sessionathrow=liftIO.E.throwIO.SASLExceptioncatch::Sessiona->(Error->Sessiona)->Sessionacatchmf=dosctx<-SessionCtx`fmap`getSessionContextSession.liftIO$E.catch(R.runReaderT(unSessionm)sctx)(\(SASLExceptionerr)->R.runReaderT(unSession(ferr))sctx)handle::(Error->Sessiona)->Sessiona->Sessionahandle=flipcatchtry::Sessiona->Session(EitherErrora)trym=catch(fmapRightm)(return.Left)-- }}}-- Session Properties {{{dataProperty=PropertyAuthID|PropertyAuthzID|PropertyPassword|PropertyAnonymousToken|PropertyService|PropertyHostname|PropertyGSSAPIDisplayName|PropertyPasscode|PropertySuggestedPIN|PropertyPIN|PropertyRealm|PropertyDigestMD5HashedPassword|PropertyQOPS|PropertyQOP|PropertyScramIter|PropertyScramSalt|PropertyScramSaltedPassword|ValidateSimple|ValidateExternal|ValidateAnonymous|ValidateGSSAPI|ValidateSecurIDderiving(Show,Eq)cFromProperty::Property->F.CIntcFromPropertyx=casexofPropertyAuthID->1PropertyAuthzID->2PropertyPassword->3PropertyAnonymousToken->4PropertyService->5PropertyHostname->6PropertyGSSAPIDisplayName->7PropertyPasscode->8PropertySuggestedPIN->9PropertyPIN->10PropertyRealm->11PropertyDigestMD5HashedPassword->12PropertyQOPS->13PropertyQOP->14PropertyScramIter->15PropertyScramSalt->16PropertyScramSaltedPassword->17ValidateSimple->500ValidateExternal->501ValidateAnonymous->502ValidateGSSAPI->503ValidateSecurID->504cToProperty::F.CInt->PropertycToPropertyx=casexof1->PropertyAuthID2->PropertyAuthzID3->PropertyPassword4->PropertyAnonymousToken5->PropertyService6->PropertyHostname7->PropertyGSSAPIDisplayName8->PropertyPasscode9->PropertySuggestedPIN10->PropertyPIN11->PropertyRealm12->PropertyDigestMD5HashedPassword13->PropertyQOPS14->PropertyQOP15->PropertyScramIter16->PropertyScramSalt17->PropertyScramSaltedPassword500->ValidateSimple501->ValidateExternal502->ValidateAnonymous503->ValidateGSSAPI504->ValidateSecurID_->error$"Unknown GNU SASL property code: "++showx-- | Store some data in the session for the given property. The data must-- be @NULL@-terminated.setProperty::Property->B.ByteString->Session()setPropertypropbytes=dosctx<-getSessionContextliftIO$B.useAsCStringbytes$gsasl_property_setsctx(cFromPropertyprop)-- | Retrieve the data stored in the session for the given property,-- possibly invoking the current callback to get the value.getProperty::Property->Session(MaybeB.ByteString)getPropertyprop=dosctx<-getSessionContextliftIO$docstr<-gsasl_property_getsctx(cFromPropertyprop)ifcstr/=F.nullPtrthenfmapJust$B.packCStringcstrelsedoliftIO$checkCallbackExceptionsctxreturnNothing-- | Retrieve the data stored in the session for the given property,-- without invoking the current callback.getPropertyFast::Property->Session(MaybeB.ByteString)getPropertyFastprop=dosctx<-getSessionContextliftIO$gsasl_property_fastsctx(cFromPropertyprop)>>=F.maybePeekB.packCString-- }}}-- Callbacks {{{typeCallbackFn=F.PtrContext->F.PtrSessionCtx->F.CInt->IOF.CIntdataCallbackHook=CallbackHook(F.FunPtrCallbackFn)(Property->SessionProgress)newCallbackHook::(Property->SessionProgress)->IO(F.PtrCallbackHook,F.FunPtrCallbackFn)newCallbackHookcb=E.bracketOnError(wrapCallbackImpl(callbackImplcb))F.freeHaskellFunPtr(\funPtr->lethook=CallbackHookfunPtrcbinE.bracketOnError(F.newStablePtrhook)F.freeStablePtr(\stablePtr->lethookPtr=F.castPtr(F.castStablePtrToPtrstablePtr)inreturn(hookPtr,funPtr)))freeCallbackHook::F.PtrCallbackHook->IO()freeCallbackHookptr=unless(ptr==F.nullPtr)$doletstablePtr=F.castPtrToStablePtr$F.castPtrptrhook<-F.deRefStablePtrstablePtrF.freeStablePtrstablePtrlet(CallbackHookfunPtr_)=hookF.freeHaskellFunPtrfunPtrcallbackImpl::(Property->SessionProgress)->CallbackFncallbackImplcb_sctxcProp=letglobalIO=error"globalIO is not implemented"sessionIO=doletsession=cb$cToPropertycPropfmapcFromProgress$R.runReaderT(unSessionsession)(SessionCtxsctx)onError::SASLException->IOF.CIntonError(SASLExceptionerr)=return$cFromErrorerronException::E.SomeException->IOF.CIntonExceptionexc=do-- A bit ugly; session hooks aren't used anywhere else in-- the binding, so the exception is stashed here.stablePtr<-F.newStablePtrexcgsasl_session_hook_setsctx$F.castStablePtrToPtrstablePtr-- 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)catchErrorsio=E.catchesio[E.HandleronError,E.HandleronException]incatchErrors$ifsctx==F.nullPtrthenglobalIOelsesessionIOforeignimportccall"wrapper"wrapCallbackImpl::CallbackFn->IO(F.FunPtrCallbackFn)-- Used to check whether a callback threw an exceptioncheckCallbackException::F.PtrSessionCtx->IO()checkCallbackExceptionsctx=dohook<-gsasl_session_hook_getsctxwhen(hook/=F.nullPtr)$doletstable=F.castPtrToStablePtrhookexc<-F.deRefStablePtrstableF.freeStablePtrstableE.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->SessionProgress)->SASL()setCallbackcb=doctx<-getContextliftIO$dofreeCallbackHook=<<gsasl_callback_hook_getctx(hook,cbPtr)<-newCallbackHookcbgsasl_callback_hook_setctxhookgsasl_callback_setctxcbPtr-- | Run the current callback; the property indicates what action the-- callback is expected to perform.runCallback::Property->SessionProgressrunCallbackprop=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<-fmapF.castPtrgetSessionContexthookPtr<-liftIO$gsasl_callback_hook_getctxwhen(hookPtr==F.nullPtr)$throwNoCallbackhook<-liftIO$F.deRefStablePtr$F.castPtrToStablePtrhookPtrlet(CallbackHook_cb)=hookcbprop-- }}}-- Session IO {{{dataProgress=Complete|NeedsMorederiving(Show,Eq)cFromProgress::Progress->F.CIntcFromProgressx=casexofComplete->0NeedsMore->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)stepinput=bracketSessiongetfreepeekwheregetsctx=B.unsafeUseAsCStringLeninput$\(pInput,inputLen)->F.alloca$\pOutput->F.alloca$\pOutputLen->dorc<-gsasl_stepsctxpInput(fromIntegralinputLen)pOutputpOutputLenwhen(rc/=0)$checkCallbackExceptionsctxprogress<-checkStepRCrccstr<-F.peekpOutputcstrLen<-F.peekpOutputLenreturn(cstr,cstrLen,progress)free(cstr,_,_)=gsasl_freecstrpeek(cstr,cstrLen,progress)=dooutput<-B.packCStringLen(cstr,fromIntegralcstrLen)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)step64input=bracketSessiongetfreepeekwheregetsctx=B.useAsCStringinput$\pInput->F.alloca$\pOutput->dorc<-gsasl_step64sctxpInputpOutputwhen(rc/=0)$checkCallbackExceptionsctxprogress<-checkStepRCrccstr<-F.peekpOutputreturn(cstr,progress)free(cstr,_)=gsasl_freecstrpeek(cstr,progress)=dooutput<-B.packCStringcstrreturn(output,progress)checkStepRC::F.CInt->IOProgresscheckStepRCx=casexof0->returnComplete1->returnNeedsMore_->E.throwIO(SASLException(cToErrorx))-- | Encode data according to the negotiated SASL mechanism. This might mean-- the data is integrity or privacy protected.encode::B.ByteString->SessionB.ByteStringencodeinput=dosctx<-getSessionContextliftIO$B.unsafeUseAsCStringLeninput$\(cstr,cstrLen)->F.alloca$\pOutput->F.alloca$\pOutputLen->dorc<-gsasl_encodesctxcstr(fromIntegralcstrLen)pOutputpOutputLenwhen(rc/=0)$checkCallbackExceptionsctxcheckRCrcoutput<-F.peekpOutputoutputLen<-fromIntegral`fmap`F.peekpOutputLenoutBytes<-B.packCStringLen(output,outputLen)gsasl_freeoutputreturnoutBytes-- | Decode data according to the negotiated SASL mechanism. This might mean-- the data is integrity or privacy protected.decode::B.ByteString->SessionB.ByteStringdecodeinput=dosctx<-getSessionContextliftIO$B.unsafeUseAsCStringLeninput$\(cstr,cstrLen)->F.alloca$\pOutput->F.alloca$\pOutputLen->dorc<-gsasl_decodesctxcstr(fromIntegralcstrLen)pOutputpOutputLenwhen(rc/=0)$checkCallbackExceptionsctxcheckRCrcoutput<-F.peekpOutputoutputLen<-fromIntegral`fmap`F.peekpOutputLenoutputBytes<-B.packCStringLen(output,outputLen)gsasl_freeoutputreturnoutputBytes-- }}}-- Bundled codecs {{{toBase64::B.ByteString->B.ByteStringtoBase64input=unsafePerformIO$B.unsafeUseAsCStringLeninput$\(pIn,inLen)->F.alloca$\pOut->F.alloca$\pOutLen->dogsasl_base64_topIn(fromIntegralinLen)pOutpOutLen>>=checkRCoutLen<-F.peekpOutLenoutPtr<-F.peekpOutB.packCStringLen(outPtr,fromIntegraloutLen)fromBase64::B.ByteString->B.ByteStringfromBase64input=unsafePerformIO$B.unsafeUseAsCStringLeninput$\(pIn,inLen)->F.alloca$\pOut->F.alloca$\pOutLen->dogsasl_base64_frompIn(fromIntegralinLen)pOutpOutLen>>=checkRCoutLen<-F.peekpOutLenoutPtr<-F.peekpOutB.packCStringLen(outPtr,fromIntegraloutLen)md5::B.ByteString->B.ByteStringmd5input=unsafePerformIO$B.unsafeUseAsCStringLeninput$\(pIn,inLen)->F.alloca$\pOut->F.allocaBytes16$\outBuf->doF.pokepOutoutBufgsasl_md5pIn(fromIntegralinLen)pOut>>=checkRCB.packCStringLen(outBuf,16)sha1::B.ByteString->B.ByteStringsha1input=unsafePerformIO$B.unsafeUseAsCStringLeninput$\(pIn,inLen)->F.alloca$\pOut->F.allocaBytes20$\outBuf->doF.pokepOutoutBufgsasl_sha1pIn(fromIntegralinLen)pOut>>=checkRCB.packCStringLen(outBuf,20)hmacMD5::B.ByteString-- ^ Key->B.ByteString-- ^ Input data->B.ByteStringhmacMD5keyinput=unsafePerformIO$B.unsafeUseAsCStringLenkey$\(pKey,keyLen)->B.unsafeUseAsCStringLeninput$\(pIn,inLen)->F.alloca$\pOut->F.allocaBytes16$\outBuf->doF.pokepOutoutBufgsasl_hmac_md5pKey(fromIntegralkeyLen)pIn(fromIntegralinLen)pOut>>=checkRCB.packCStringLen(outBuf,16)hmacSHA1::B.ByteString-- ^ Key->B.ByteString-- ^ Input data->B.ByteStringhmacSHA1keyinput=unsafePerformIO$B.unsafeUseAsCStringLenkey$\(pKey,keyLen)->B.unsafeUseAsCStringLeninput$\(pIn,inLen)->F.alloca$\pOut->F.allocaBytes20$\outBuf->doF.pokepOutoutBufgsasl_hmac_sha1pKey(fromIntegralkeyLen)pIn(fromIntegralinLen)pOut>>=checkRCB.packCStringLen(outBuf,20)-- | Returns unpredictable data of a given sizenonce::Integer->IOB.ByteStringnoncesize=F.allocaBytes(fromIntegersize)$\buf->dogsasl_noncebuf(fromIntegralsize)>>=checkRCB.packCStringLen(buf,fromIntegralsize)-- | Returns cryptographically strong random data of a given sizerandom::Integer->IOB.ByteStringrandomsize=F.allocaBytes(fromIntegersize)$\buf->dogsasl_randombuf(fromIntegralsize)>>=checkRCB.packCStringLen(buf,fromIntegralsize)-- }}}-- Miscellaneous {{{checkRC::F.CInt->IO()checkRCx=casexof0->return()_->E.throwIO(SASLException(cToErrorx))unfoldrM::Monadm=>(b->m(Maybe(a,b)))->b->m[a]unfoldrMmb=mb>>=\x->casexofJust(a,new_b)->doas<-unfoldrMmnew_breturn$a:asNothing->return[]-- }}}-- FFI imports {{{foreignimportccallunsafe"hsgsasl_VERSION_MAJOR"hsgsasl_VERSION_MAJOR::F.CIntforeignimportccallunsafe"hsgsasl_VERSION_MINOR"hsgsasl_VERSION_MINOR::F.CIntforeignimportccallunsafe"hsgsasl_VERSION_PATCH"hsgsasl_VERSION_PATCH::F.CIntforeignimportccallunsafe"hsgsasl_check_version"hsgsasl_check_version::IOF.CIntforeignimportccallunsafe"gsasl.h gsasl_init"gsasl_init::F.Ptr(F.PtrContext)->IOF.CIntforeignimportccallunsafe"gsasl.h gsasl_done"gsasl_done::F.PtrContext->IO()foreignimportccallunsafe"gsasl.h gsasl_check_version"gsasl_check_version::F.CString->IOF.CStringforeignimportccallunsafe"gsasl.h gsasl_callback_set"gsasl_callback_set::F.PtrContext->F.FunPtrCallbackFn->IO()foreignimportccallunsafe"gsasl.h gsasl_callback_hook_get"gsasl_callback_hook_get::F.PtrContext->IO(F.Ptra)foreignimportccallunsafe"gsasl.h gsasl_callback_hook_set"gsasl_callback_hook_set::F.PtrContext->F.Ptra->IO()foreignimportccallunsafe"gsasl.h gsasl_session_hook_get"gsasl_session_hook_get::F.PtrSessionCtx->IO(F.Ptra)foreignimportccallunsafe"gsasl.h gsasl_session_hook_set"gsasl_session_hook_set::F.PtrSessionCtx->F.Ptra->IO()foreignimportccallunsafe"gsasl.h gsasl_property_set"gsasl_property_set::F.PtrSessionCtx->F.CInt->F.CString->IO()foreignimportccallsafe"gsasl.h gsasl_property_get"gsasl_property_get::F.PtrSessionCtx->F.CInt->IOF.CStringforeignimportccallunsafe"gsasl.h gsasl_property_fast"gsasl_property_fast::F.PtrSessionCtx->F.CInt->IOF.CStringforeignimportccallunsafe"gsasl.h gsasl_client_mechlist"gsasl_client_mechlist::F.PtrContext->F.PtrF.CString->IOF.CIntforeignimportccallunsafe"gsasl.h gsasl_client_support_p"gsasl_client_support_p::F.PtrContext->F.CString->IOF.CIntforeignimportccallunsafe"gsasl.h gsasl_client_suggest_mechanism"gsasl_client_suggest_mechanism::F.PtrContext->F.CString->IOF.CStringforeignimportccallunsafe"gsasl.h gsasl_server_mechlist"gsasl_server_mechlist::F.PtrContext->F.PtrF.CString->IOF.CIntforeignimportccallunsafe"gsasl.h gsasl_server_support_p"gsasl_server_support_p::F.PtrContext->F.CString->IOF.CIntforeignimportccallsafe"gsasl.h gsasl_client_start"gsasl_client_start::SessionProcforeignimportccallsafe"gsasl.h gsasl_server_start"gsasl_server_start::SessionProcforeignimportccallsafe"gsasl.h gsasl_step"gsasl_step::F.PtrSessionCtx->F.CString->F.CSize->F.PtrF.CString->F.PtrF.CSize->IOF.CIntforeignimportccallsafe"gsasl.h gsasl_step64"gsasl_step64::F.PtrSessionCtx->F.CString->F.PtrF.CString->IOF.CIntforeignimportccallsafe"gsasl.h gsasl_finish"gsasl_finish::F.PtrSessionCtx->IO()foreignimportccallsafe"gsasl.h gsasl_encode"gsasl_encode::F.PtrSessionCtx->F.CString->F.CSize->F.PtrF.CString->F.PtrF.CSize->IOF.CIntforeignimportccallsafe"gsasl.h gsasl_decode"gsasl_decode::F.PtrSessionCtx->F.CString->F.CSize->F.PtrF.CString->F.PtrF.CSize->IOF.CIntforeignimportccallunsafe"gsasl.h gsasl_mechanism_name"gsasl_mechanism_name::F.PtrSessionCtx->IOF.CStringforeignimportccallunsafe"gsasl.h gsasl_strerror"gsasl_strerror::F.CInt->IOF.CStringforeignimportccallunsafe"gsasl.h gsasl_base64_to"gsasl_base64_to::F.CString->F.CSize->F.PtrF.CString->F.PtrF.CSize->IOF.CIntforeignimportccallunsafe"gsasl.h gsasl_base64_from"gsasl_base64_from::F.CString->F.CSize->F.PtrF.CString->F.PtrF.CSize->IOF.CIntforeignimportccallunsafe"gsasl.h gsasl_md5"gsasl_md5::F.CString->F.CSize->F.PtrF.CString->IOF.CIntforeignimportccallunsafe"gsasl.h gsasl_sha1"gsasl_sha1::F.CString->F.CSize->F.PtrF.CString->IOF.CIntforeignimportccallunsafe"gsasl.h gsasl_hmac_md5"gsasl_hmac_md5::F.CString->F.CSize->F.CString->F.CSize->F.PtrF.CString->IOF.CIntforeignimportccallunsafe"gsasl.h gsasl_hmac_sha1"gsasl_hmac_sha1::F.CString->F.CSize->F.CString->F.CSize->F.PtrF.CString->IOF.CIntforeignimportccallunsafe"gsasl.h gsasl_nonce"gsasl_nonce::F.CString->F.CSize->IOF.CIntforeignimportccallunsafe"gsasl.h gsasl_random"gsasl_random::F.CString->F.CSize->IOF.CIntforeignimportccallunsafe"gsasl.h gsasl_free"gsasl_free::F.Ptra->IO()-- }}}