BrowserID lazy load
This commit is contained in:
parent
ba9e40c177
commit
4cde171285
@ -1,10 +1,14 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module Yesod.Auth.BrowserId
|
||||
( authBrowserId
|
||||
, authBrowserIdAudience
|
||||
, createOnClick
|
||||
, def
|
||||
, BrowserIdSettings
|
||||
, bisAudience
|
||||
, bisLazyLoad
|
||||
) where
|
||||
|
||||
import Yesod.Auth
|
||||
@ -14,12 +18,13 @@ import Yesod.Core
|
||||
import Text.Hamlet (hamlet)
|
||||
import qualified Data.Text as T
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Control.Monad (when)
|
||||
import Control.Monad (when, unless)
|
||||
import Control.Exception (throwIO)
|
||||
import Text.Julius (julius, rawJS)
|
||||
import Network.URI (uriPath, parseURI)
|
||||
import Data.FileEmbed (embedFile)
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.Default
|
||||
|
||||
pid :: Text
|
||||
pid = "browserid"
|
||||
@ -27,29 +32,42 @@ pid = "browserid"
|
||||
complete :: Route Auth
|
||||
complete = PluginR pid []
|
||||
|
||||
-- | Log into browser ID with an audience value determined from the 'approot'.
|
||||
authBrowserId :: YesodAuth m => AuthPlugin m
|
||||
authBrowserId = helper Nothing
|
||||
-- | A settings type for various configuration options relevant to BrowserID.
|
||||
--
|
||||
-- See: <http://www.yesodweb.com/book/settings-types>
|
||||
--
|
||||
-- Since 1.2.0
|
||||
data BrowserIdSettings = BrowserIdSettings
|
||||
{ bisAudience :: Maybe Text
|
||||
-- ^ BrowserID audience value. If @Nothing@, will be extracted based on the
|
||||
-- approot.
|
||||
--
|
||||
-- Default: @Nothing@
|
||||
--
|
||||
-- Since 1.2.0
|
||||
, bisLazyLoad :: Bool
|
||||
-- ^ Use asynchronous Javascript loading for the BrowserID JS file.
|
||||
--
|
||||
-- Default: @True@.
|
||||
--
|
||||
-- Since 1.2.0
|
||||
}
|
||||
|
||||
-- | Log into browser ID with the given audience value. Note that this must be
|
||||
-- your actual hostname, or login will fail.
|
||||
authBrowserIdAudience
|
||||
:: YesodAuth m
|
||||
=> Text -- ^ audience
|
||||
-> AuthPlugin m
|
||||
authBrowserIdAudience = helper . Just
|
||||
instance Default BrowserIdSettings where
|
||||
def = BrowserIdSettings
|
||||
{ bisAudience = Nothing
|
||||
, bisLazyLoad = True
|
||||
}
|
||||
|
||||
helper :: YesodAuth m
|
||||
=> Maybe Text -- ^ audience
|
||||
-> AuthPlugin m
|
||||
helper maudience = AuthPlugin
|
||||
authBrowserId :: YesodAuth m => BrowserIdSettings -> AuthPlugin m
|
||||
authBrowserId bis@BrowserIdSettings {..} = AuthPlugin
|
||||
{ apName = pid
|
||||
, apDispatch = \m ps ->
|
||||
case (m, ps) of
|
||||
("GET", [assertion]) -> do
|
||||
master <- lift getYesod
|
||||
audience <-
|
||||
case maudience of
|
||||
case bisAudience of
|
||||
Just a -> return a
|
||||
Nothing -> do
|
||||
r <- getUrlRender
|
||||
@ -69,12 +87,10 @@ helper maudience = AuthPlugin
|
||||
(_, []) -> badMethod
|
||||
_ -> notFound
|
||||
, apLogin = \toMaster -> do
|
||||
onclick <- createOnClick toMaster
|
||||
onclick <- createOnClick bis toMaster
|
||||
|
||||
autologin <- fmap (== Just "true") $ lookupGetParam "autologin"
|
||||
when autologin $ toWidget [julius|
|
||||
#{rawJS onclick}();
|
||||
|]
|
||||
when autologin $ toWidget [julius|#{rawJS onclick}();|]
|
||||
|
||||
toWidget [hamlet|
|
||||
$newline never
|
||||
@ -89,27 +105,43 @@ $newline never
|
||||
|
||||
-- | Generates a function to handle on-click events, and returns that function
|
||||
-- name.
|
||||
createOnClick :: (Route Auth -> Route master) -> WidgetT master IO Text
|
||||
createOnClick toMaster = do
|
||||
addScriptRemote browserIdJs
|
||||
createOnClick :: BrowserIdSettings
|
||||
-> (Route Auth -> Route master)
|
||||
-> WidgetT master IO Text
|
||||
createOnClick BrowserIdSettings {..} toMaster = do
|
||||
unless bisLazyLoad $ addScriptRemote browserIdJs
|
||||
onclick <- newIdent
|
||||
render <- getUrlRender
|
||||
let login = toJSON $ getPath $ render $ toMaster LoginR
|
||||
let login = toJSON $ getPath $ render (toMaster LoginR)
|
||||
toWidget [julius|
|
||||
function #{rawJS onclick}() {
|
||||
navigator.id.watch({
|
||||
onlogin: function (assertion) {
|
||||
if (assertion) {
|
||||
document.location = "@{toMaster complete}" + "/" + assertion;
|
||||
}
|
||||
},
|
||||
onlogout: function () {}
|
||||
});
|
||||
navigator.id.request({
|
||||
returnTo: #{login} + "?autologin=true"
|
||||
});
|
||||
if (navigator.id) {
|
||||
navigator.id.watch({
|
||||
onlogin: function (assertion) {
|
||||
if (assertion) {
|
||||
document.location = "@{toMaster complete}/" + assertion;
|
||||
}
|
||||
},
|
||||
onlogout: function () {}
|
||||
});
|
||||
navigator.id.request({
|
||||
returnTo: #{login} + "?autologin=true"
|
||||
});
|
||||
}
|
||||
else {
|
||||
alert("Loading, please try again");
|
||||
}
|
||||
}
|
||||
|]
|
||||
when bisLazyLoad $ toWidget [julius|
|
||||
(function(){
|
||||
var bid = document.createElement("script");
|
||||
bid.async = true;
|
||||
bid.src = #{toJSON browserIdJs};
|
||||
var s = document.getElementsByTagName('script')[0];
|
||||
s.parentNode.insertBefore(bid, s);
|
||||
})();
|
||||
|]
|
||||
|
||||
autologin <- fmap (== Just "true") $ lookupGetParam "autologin"
|
||||
when autologin $ toWidget [julius|#{rawJS onclick}();|]
|
||||
|
||||
@ -45,6 +45,7 @@ library
|
||||
, http-types
|
||||
, file-embed
|
||||
, email-validate >= 1.0
|
||||
, data-default
|
||||
|
||||
exposed-modules: Yesod.Auth
|
||||
Yesod.Auth.BrowserId
|
||||
|
||||
Loading…
Reference in New Issue
Block a user