Use newer Mozilla Persona API (#453)

yesod-auth/Yesod/Auth/BrowserId.hs

@@ -13,7 +13,11 @@ import Text.Hamlet (hamlet)
 import qualified Data.Text as T
 import Data.Maybe (fromMaybe)
 import Control.Monad.IO.Class (liftIO)
+import Control.Monad (when)
 import Control.Exception (throwIO)
+import Text.Julius (julius, rawJS)
+import Data.Aeson (toJSON)
+import Network.URI (uriPath, parseURI)
 
 pid :: Text
 pid = "browserid"
@@ -61,12 +65,41 @@ helper maudience = AuthPlugin
             _ -> notFound
     , apLogin = \toMaster -> do
         addScriptRemote browserIdJs
+        onclick <- lift newIdent
+        render <- lift getUrlRender
+        let login = toJSON $ getPath $ render (toMaster LoginR)
+        toWidget [julius|
+function #{rawJS onclick}() {
+    navigator.id.watch({
+        onlogin: function (assertion) {
+            if (assertion) {
+                alert("@{toMaster complete}/" + assertion);
+                document.location = "@{toMaster complete}/" + assertion;
+            }
+        },
+        onlogout: function () {}
+    });
+    navigator.id.request({
+        returnTo: #{login} + "?autologin=true"
+    });
+}
+|]
+
+        autologin <- fmap (== Just "true") $ lift $ lookupGetParam "autologin"
+        when autologin $ toWidget [julius|
+#{rawJS onclick}();
+|]
+
         toWidget [hamlet|
 $newline never
 <p>
-    <a href="javascript:navigator.id.getVerifiedEmail(function(a){if(a)document.location='@{toMaster complete}/'+a});">
+    <a href="javascript:#{onclick}()">
         <img src="https://browserid.org/i/sign_in_green.png">
 |]
     }
   where
     stripScheme t = fromMaybe t $ T.stripPrefix "//" $ snd $ T.breakOn "//" t
+
+    getPath t = fromMaybe t $ do
+        uri <- parseURI $ T.unpack t
+        return $ T.pack $ uriPath uri

yesod-auth/browserid.hs

@@ -13,6 +13,7 @@ import Yesod.Form
 import Network.Wai.Handler.Warp (run)
 import Network.HTTP.Conduit
 import Network.TLS
+import Network.Wai.Middleware.RequestLogger
 
 data BID = BID { httpManager :: Manager }
 
@@ -49,6 +50,4 @@ instance RenderMessage BID FormMessage where
 main :: IO ()
 main = do
     m <- newManager def
-        { managerCheckCerts = \_ _ -> return CertificateUsageAccept
+    toWaiApp (BID m) >>= run 3000 . logStdoutDev
-        }
-    toWaiApp (BID m) >>= run 3000

yesod-auth/yesod-auth.cabal

@@ -26,6 +26,7 @@ library
                    , yesod-persistent        >= 1.1       && < 1.2
                    , hamlet                  >= 1.1       && < 1.2
                    , shakespeare-css         >= 1.0       && < 1.1
+                   , shakespeare-js          >= 1.0.2     && < 1.2
                    , yesod-json              >= 1.1       && < 1.2
                    , containers
                    , unordered-containers
@@ -40,6 +41,7 @@ library
                    , lifted-base             >= 0.1
                    , blaze-html              >= 0.5       && < 0.6
                    , blaze-markup            >= 0.5.1     && < 0.6
+                   , network
 
     exposed-modules: Yesod.Auth
                      Yesod.Auth.BrowserId