From b00fd948bd7d8589f1343685de5e859810fc3aa2 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Sun, 11 Sep 2011 08:52:23 +0300
Subject: [PATCH] authBrowserId'

---
 yesod-auth/Yesod/Auth/BrowserId.hs | 33 ++++++++++++++++++++++++++++++
 yesod-auth/browserid.hs            |  3 +--
 yesod-auth/yesod-auth.cabal        |  2 +-
 3 files changed, 35 insertions(+), 3 deletions(-)

diff --git a/yesod-auth/Yesod/Auth/BrowserId.hs b/yesod-auth/Yesod/Auth/BrowserId.hs
index ddb975ef..9c6e22fe 100644
--- a/yesod-auth/Yesod/Auth/BrowserId.hs
+++ b/yesod-auth/Yesod/Auth/BrowserId.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Yesod.Auth.BrowserId
     ( authBrowserId
+    , authBrowserId'
     ) where
 
 import Yesod.Auth
@@ -11,6 +12,8 @@ import Data.Text (Text)
 import Yesod.Core
 import Text.Hamlet (hamlet)
 import Control.Monad.IO.Class (liftIO)
+import qualified Data.Text as T
+import Data.Maybe (fromMaybe)
 
 #include "qq.h"
 
@@ -46,3 +49,33 @@ authBrowserId audience = AuthPlugin
         <img src="https://browserid.org/i/sign_in_green.png">
 |]
     }
+
+authBrowserId' :: YesodAuth m => AuthPlugin m
+authBrowserId' = AuthPlugin
+    { apName = pid
+    , apDispatch = \m ps ->
+        case (m, ps) of
+            ("GET", [assertion]) -> do
+                tm <- getRouteToMaster
+                r <- getUrlRender
+                let audience = T.takeWhile (/= '/') $ stripScheme $ r $ tm LoginR
+                memail <- liftIO $ checkAssertion audience assertion
+                case memail of
+                    Nothing -> error "Invalid assertion"
+                    Just email -> setCreds True Creds
+                        { credsPlugin = pid
+                        , credsIdent = email
+                        , credsExtra = []
+                        }
+            (_, []) -> badMethod
+            _ -> notFound
+    , apLogin = \toMaster -> do
+        addScriptRemote browserIdJs
+        addHamlet [QQ(hamlet)|
+<p>
+    <a href="javascript:navigator.id.getVerifiedEmail(function(a){if(a)document.location='@{toMaster complete}/'+a});">
+        <img src="https://browserid.org/i/sign_in_green.png">
+|]
+    }
+  where
+    stripScheme t = fromMaybe t $ T.stripPrefix "//" $ snd $ T.breakOn "//" t
diff --git a/yesod-auth/browserid.hs b/yesod-auth/browserid.hs
index 12da848d..e771b6dc 100644
--- a/yesod-auth/browserid.hs
+++ b/yesod-auth/browserid.hs
@@ -13,7 +13,6 @@ import Yesod.Form
 import Network.Wai.Handler.Warp (run)
 
 data BID = BID
-type Handler = GHandler BID BID
 
 mkYesod "BID" [parseRoutes|
 / RootR GET
@@ -39,7 +38,7 @@ instance YesodAuth BID where
     loginDest _ = AfterLoginR
     logoutDest _ = AuthR LoginR
     getAuthId = return . Just . credsIdent
-    authPlugins = [authBrowserId "localhost:3000"]
+    authPlugins = [authBrowserId']
 
 instance RenderMessage BID FormMessage where
     renderMessage _ _ = defaultFormMessage
diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal
index 1bd76baf..331da47b 100644
--- a/yesod-auth/yesod-auth.cabal
+++ b/yesod-auth/yesod-auth.cabal
@@ -1,5 +1,5 @@
 name:            yesod-auth
-version:         0.7.2
+version:         0.7.3
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman, Patrick Brisbin