From 4cde17128582a744ae1ccc0a754be21b385674ae Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Sun, 21 Apr 2013 13:55:06 +0300
Subject: [PATCH] BrowserID lazy load

---
 yesod-auth/Yesod/Auth/BrowserId.hs | 104 +++++++++++++++++++----------
 yesod-auth/yesod-auth.cabal        |   1 +
 2 files changed, 69 insertions(+), 36 deletions(-)

diff --git a/yesod-auth/Yesod/Auth/BrowserId.hs b/yesod-auth/Yesod/Auth/BrowserId.hs
index 95d6c7fd..402453b4 100644
--- a/yesod-auth/Yesod/Auth/BrowserId.hs
+++ b/yesod-auth/Yesod/Auth/BrowserId.hs
@@ -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}();|]
diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal
index ba0d5f8f..59baf769 100644
--- a/yesod-auth/yesod-auth.cabal
+++ b/yesod-auth/yesod-auth.cabal
@@ -45,6 +45,7 @@ library
                    , http-types
                    , file-embed
                    , email-validate          >= 1.0
+                   , data-default
 
     exposed-modules: Yesod.Auth
                      Yesod.Auth.BrowserId