{-# LANGUAGE FlexibleContexts #-}moduleWeb.Authenticate.OpenId(getForwardUrl,authenticate,AuthenticateException(..),Identifier(..))whereimportControl.Monad.IO.ClassimportOpenId2.Normalization(normalize)importOpenId2.Discovery(discover,Discovery(..))importControl.Failure(Failure(failure))importOpenId2.TypesimportWeb.Authenticate.Internal(qsUrl)importControl.Monad(unless)importqualifiedData.ByteString.UTF8asBSUimportqualifiedData.ByteString.Lazy.UTF8asBSLUimportNetwork.HTTP.Enumerator(parseUrl,urlEncodedBody,responseBody,httpLbsRedirect,HttpException)importControl.Arrow((***))importData.List(unfoldr)importData.Maybe(fromMaybe)getForwardUrl::(MonadIOm,FailureAuthenticateExceptionm,FailureHttpExceptionm)=>String-- ^ The openid the user provided.->String-- ^ The URL for this application\'s complete page.->mString-- ^ URL to send the user to.getForwardUrlopenid'complete=dodisc<-normalizeopenid'>>=discovercasediscofDiscovery1servermdelegate->return$qsUrlserver[("openid.mode","checkid_setup"),("openid.identity",fromMaybeopenid'mdelegate),("openid.return_to",complete),("openid.trust_root",complete)]Discovery2(Providerp)(Identifieri)->return$qsUrlp[("openid.ns","http://specs.openid.net/auth/2.0"),("openid.mode","checkid_setup"),("openid.claimed_id",i),("openid.identity",i),("openid.return_to",complete)]authenticate::(MonadIOm,FailureAuthenticateExceptionm,FailureHttpExceptionm)=>[(String,String)]->mIdentifierauthenticateparams=dounless(lookup"openid.mode"params==Just"id_res")$failure$AuthenticationException"mode is not id_res"ident<-caselookup"openid.identity"paramsofJusti->returniNothing->failure$AuthenticationException"Missing identity"disc<-normalizeident>>=discoverletendpoint=casediscofDiscovery1p_->pDiscovery2(Providerp)_->pletparams'=map(BSU.fromString***BSU.fromString)$("openid.mode","check_authentication"):filter(\(k,_)->k/="openid.mode")paramsreq'<-parseUrlendpointletreq=urlEncodedBodyparams'req'rsp<-httpLbsRedirectreqletrps=parseDirectResponse$BSLU.toString$responseBodyrspcaselookup"is_valid"rpsofJust"true"->return$Identifierident_->failure$AuthenticationException"OpenID provider did not validate"-- | Turn a response body into a list of parameters.parseDirectResponse::String->[(String,String)]parseDirectResponse=unfoldrstepwherestep[]=Nothingstepstr=casesplit(=='\n')strof(ps,rest)->Just(split(==':')ps,rest)split::(a->Bool)->[a]->([a],[a])splitpas=casebreakpasof(xs,_:ys)->(xs,ys)pair->pair