apLogin has existential subsite

Yesod/Helpers/Auth2.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
 module Yesod.Helpers.Auth2
     ( Auth
     , AuthPlugin (..)
@@ -30,7 +31,7 @@ type Piece = String
 data AuthPlugin m = AuthPlugin
     { apName :: String
     , apDispatch :: Method -> [Piece] -> GHandler Auth m ()
-    , apLogin :: GWidget Auth m ()
+    , apLogin :: forall s. (Route Auth -> Route m) -> GWidget s m ()
     }
 
 getAuth :: a -> Auth
@@ -117,7 +118,8 @@ $nothing
 getLoginR :: YesodAuth m => GHandler Auth m RepHtml
 getLoginR = defaultLayout $ do
     setTitle $ string "Login"
-    mapM_ apLogin authPlugins
+    tm <- liftHandler getRouteToMaster
+    mapM_ (flip apLogin tm) authPlugins
 
 getLogoutR :: YesodAuth m => GHandler Auth m ()
 getLogoutR = postLogoutR -- FIXME redirect to post
@@ -189,11 +191,9 @@ authDummy =
         setCreds True $ Creds "dummy" ident []
     dispatch _ _ = notFound
     url = PluginR "dummy" []
-    authToMaster = liftHandler getRouteToMaster
-    login = do
-        tm <- authToMaster
+    login authToMaster = do
         addBody [$hamlet|
-%form!method=post!action=@tm.url@
+%form!method=post!action=@authToMaster.url@
     Your new identifier is: $
     %input!type=text!name=ident
     %input!type=submit!value="Dummy Login"

Yesod/Helpers/Auth2/Email.hs

@@ -76,8 +76,7 @@ authEmail =
     dispatch "POST" ["set-password"] = go postPasswordR
     dispatch _ _ = notFound
 
-    login' = do
-        tm <- liftHandler getRouteToMaster
+    login' tm = do
         addBody [$hamlet|
 %form!method=post!action=@tm.login@
     %table

Yesod/Helpers/Auth2/Facebook.hs

@@ -40,8 +40,7 @@ authFacebook cid secret perms =
                 ]
         setCreds True c
     dispatch _ _ = notFound
-    login = do
-        tm <- liftHandler getRouteToMaster
+    login tm = do
         render <- liftHandler getUrlRender
         let fb = Facebook.Facebook cid secret $ render $ tm url
         let furl = Facebook.getForwardUrl fb $ perms

Yesod/Helpers/Auth2/OpenId.hs

@@ -17,8 +17,7 @@ authOpenId =
     complete1 = PluginR "openid" ["complete1"]
     complete2 = PluginR "openid" ["complete2"]
     name = "openid_identifier"
-    login = do
-        tm <- liftHandler getRouteToMaster
+    login tm = do
         addStyle [$cassius|
 #openid
     background: #fff url(http://www.myopenid.com/static/openid-icon-small.gif) no-repeat scroll 0pt 50%;

Yesod/Helpers/Auth2/Rpxnow.hs

@@ -15,8 +15,7 @@ authRpxnow :: YesodAuth m
 authRpxnow app apiKey =
     AuthPlugin "rpxnow" dispatch login
   where
-    login = do
-        tm <- liftHandler getRouteToMaster
+    login tm = do
         let url = {- FIXME urlEncode $ -} tm $ PluginR "rpxnow" []
         addBody [$hamlet|
 %iframe!src="http://$app$.rpxnow.com/openid/embed?token_url=@url@"!scrolling=no!frameBorder=no!allowtransparency=true!style="width:400px;height:240px"

yesod-auth.cabal

@@ -1,5 +1,5 @@
 name:            yesod-auth
-version:         0.0.1
+version:         0.1.0
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>