yesod-auth on authenticate 1.0.0

authenticate

@@ -1 +1 @@
-Subproject commit 262d06e045b658e83abfc7a34c5f9878254c7046
+Subproject commit 2a903feca1644fbef9c1c01bd5ae293f312f0b12

package-list.sh

@@ -7,6 +7,7 @@ pkgs=(      ./yesod-routes
             ./yesod-persistent
             ./yesod-newsfeed
             ./yesod-form
+            ./authenticate
             ./yesod-auth
             ./yesod-sitemap
             ./yesod-default

yesod-auth/Yesod/Auth.hs

@@ -34,11 +34,8 @@ import Data.Text.Encoding (decodeUtf8With)
 import Data.Text.Encoding.Error (lenientDecode)
 import           Data.Text (Text)
 import qualified Data.Text as T
-#if MIN_VERSION_aeson(0, 4, 0)
 import qualified Data.HashMap.Lazy as Map
-#else
+import Network.HTTP.Conduit (Manager)
-import qualified Data.Map as Map
-#endif
 
 import Language.Haskell.TH.Syntax hiding (lift)
 
@@ -86,8 +83,10 @@ class (Yesod m, PathPiece (AuthId m), RenderMessage m FormMessage) => YesodAuth
     -- destination exists.
     logoutDest :: m -> Route m
 
+    -- | Determine the ID associated with the set of credentials.
     getAuthId :: Creds m -> GHandler s m (Maybe (AuthId m))
 
+    -- | Which authentication backends to use.
     authPlugins :: [AuthPlugin m]
 
     -- | What to show on the login page.
@@ -97,6 +96,7 @@ class (Yesod m, PathPiece (AuthId m), RenderMessage m FormMessage) => YesodAuth
         tm <- lift getRouteToMaster
         mapM_ (flip apLogin tm) authPlugins
 
+    -- | Used for i18n of messages provided by this package.
     renderAuthMessage :: m
                       -> [Text] -- ^ languages
                       -> AuthMessage -> Text
@@ -107,6 +107,12 @@ class (Yesod m, PathPiece (AuthId m), RenderMessage m FormMessage) => YesodAuth
     redirectToReferer :: m -> Bool
     redirectToReferer _ = False
 
+    -- | Return an HTTP connection manager that is stored in the foundation
+    -- type. This allows backends to reuse persistent connections. If none of
+    -- the backends you're using use HTTP connections, you can safely return
+    -- @error \"authHttpManager"@ here.
+    authHttpManager :: m -> Manager
+
 mkYesodSub "Auth"
     [ ClassP ''YesodAuth [VarT $ mkName "master"]
     ]

yesod-auth/Yesod/Auth/BrowserId.hs

@@ -12,7 +12,6 @@ import Web.Authenticate.BrowserId
 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)
 
@@ -32,7 +31,8 @@ authBrowserIdAudience audience = AuthPlugin
     , apDispatch = \m ps ->
         case (m, ps) of
             ("GET", [assertion]) -> do
-                memail <- liftIO $ checkAssertion audience assertion
+                master <- getYesod
+                memail <- lift $ checkAssertion audience assertion (authHttpManager master)
                 case memail of
                     Nothing -> error "Invalid assertion"
                     Just email -> setCreds True Creds
@@ -60,7 +60,8 @@ authBrowserId = AuthPlugin
                 tm <- getRouteToMaster
                 r <- getUrlRender
                 let audience = T.takeWhile (/= '/') $ stripScheme $ r $ tm LoginR
-                memail <- liftIO $ checkAssertion audience assertion
+                master <- getYesod
+                memail <- lift $ checkAssertion audience assertion (authHttpManager master)
                 case memail of
                     Nothing -> error "Invalid assertion"
                     Just email -> setCreds True Creds

yesod-auth/Yesod/Auth/Facebook.hs

@@ -77,10 +77,11 @@ authFacebook cid secret perms =
         tm <- getRouteToMaster
         let fb = Facebook.Facebook cid secret $ render $ tm url
         code <- runInputGet $ ireq textField "code"
-        at <- liftIO $ Facebook.getAccessToken fb code
+        master <- getYesod
+        at <- lift $ Facebook.getAccessToken fb code (authHttpManager master)
         let Facebook.AccessToken at' = at
         setSession facebookAccessTokenKey at'
-        so <- liftIO $ Facebook.getGraphData at "me"
+        so <- lift $ Facebook.getGraphData at "me" (authHttpManager master)
         let c = fromMaybe (error "Invalid response from Facebook")
                 $ parseMaybe (parseCreds at') $ either error id so
         setCreds True c

yesod-auth/Yesod/Auth/GoogleEmail.hs

@@ -17,7 +17,6 @@ module Yesod.Auth.GoogleEmail
 
 import Yesod.Auth
 import qualified Web.Authenticate.OpenId as OpenId
-import Control.Monad.Attempt
 
 import Yesod.Form
 import Yesod.Handler
@@ -27,6 +26,7 @@ import Text.Blaze (toHtml)
 import Data.Text (Text)
 import qualified Yesod.Auth.Message as Msg
 import qualified Data.Text as T
+import Control.Exception.Lifted (try, SomeException)
 
 forwardUrl :: AuthRoute
 forwardUrl = PluginR "googleemail" ["forward"]
@@ -50,21 +50,22 @@ authGoogleEmail =
                 render <- getUrlRender
                 toMaster <- getRouteToMaster
                 let complete' = render $ toMaster complete
-                res <- runAttemptT $ OpenId.getForwardUrl oid complete' Nothing
+                master <- getYesod
+                eres <- lift $ try $ OpenId.getForwardUrl oid complete' Nothing
                     [ ("openid.ax.type.email", "http://schema.openid.net/contact/email")
                     , ("openid.ns.ax", "http://openid.net/srv/ax/1.0")
                     , ("openid.ns.ax.required", "email")
                     , ("openid.ax.mode", "fetch_request")
                     , ("openid.ax.required", "email")
                     , ("openid.ui.icon", "true")
-                    ]
+                    ] (authHttpManager master)
-                attempt
+                either
                   (\err -> do
-                        setMessage $ toHtml $ show err
+                        setMessage $ toHtml $ show (err :: SomeException)
                         redirect $ toMaster LoginR
                         )
                   redirect
-                  res
+                  eres
             Nothing -> do
                 toMaster <- getRouteToMaster
                 setMessageI Msg.NoOpenID
@@ -81,10 +82,11 @@ authGoogleEmail =
 
 completeHelper :: YesodAuth m => [(Text, Text)] -> GHandler Auth m ()
 completeHelper gets' = do
-        res <- runAttemptT $ OpenId.authenticate gets'
+        master <- getYesod
+        eres <- lift $ try $ OpenId.authenticate gets' (authHttpManager master)
         toMaster <- getRouteToMaster
         let onFailure err = do
-            setMessage $ toHtml $ show err
+            setMessage $ toHtml $ show (err :: SomeException)
             redirect $ toMaster LoginR
         let onSuccess (OpenId.Identifier ident, _) = do
                 memail <- lookupGetParam "openid.ext1.value.email"
@@ -96,4 +98,4 @@ completeHelper gets' = do
                     (Nothing, _) -> do
                         setMessage "No email address provided"
                         redirect $ toMaster LoginR
-        attempt onFailure onSuccess res
+        either onFailure onSuccess eres

yesod-auth/Yesod/Auth/OAuth.hs

@@ -19,7 +19,6 @@ import Data.Maybe
 import Data.String
 import Data.ByteString.Char8 (pack)
 import Control.Arrow ((***))
-import Control.Monad.IO.Class (liftIO)
 import Data.Text (Text, unpack)
 import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
 import Data.Text.Encoding.Error (lenientDecode)
@@ -52,15 +51,17 @@ authOAuth name ident reqUrl accUrl authUrl key sec = AuthPlugin name dispatch lo
         render <- getUrlRender
         tm <- getRouteToMaster
         let oauth' = oauth { oauthCallback = Just $ encodeUtf8 $ render $ tm url }
-        tok <- liftIO $ getTemporaryCredential oauth'
+        master <- getYesod
+        tok <- lift $ getTemporaryCredential oauth' (authHttpManager master)
         redirect $ authorizeUrl oauth' tok
     dispatch "GET" [] = do
         (verifier, oaTok) <- runInputGet $ (,)
             <$> ireq textField "oauth_verifier"
             <*> ireq textField "oauth_token"
         let reqTok = Credential [ ("oauth_verifier", encodeUtf8 verifier), ("oauth_token", encodeUtf8 oaTok)
-                                ] 
+                                ]
-        accTok <- liftIO $ getAccessToken oauth reqTok
+        master <- getYesod
+        accTok <- lift $ getAccessToken oauth reqTok (authHttpManager master)
         let crId = decodeUtf8With lenientDecode $ fromJust $ lookup (pack ident) $ unCredential accTok
             creds = Creds name crId $ map (bsToText *** bsToText ) $ unCredential accTok
         setCreds True creds

yesod-auth/Yesod/Auth/OpenId.hs

@@ -11,7 +11,6 @@ module Yesod.Auth.OpenId
 
 import Yesod.Auth
 import qualified Web.Authenticate.OpenId as OpenId
-import Control.Monad.Attempt
 
 import Yesod.Form
 import Yesod.Handler
@@ -21,6 +20,7 @@ import Text.Cassius (cassius)
 import Text.Blaze (toHtml)
 import Data.Text (Text)
 import qualified Yesod.Auth.Message as Msg
+import Control.Exception.Lifted (SomeException, try)
 
 forwardUrl :: AuthRoute
 forwardUrl = PluginR "openid" ["forward"]
@@ -60,14 +60,13 @@ authOpenIdExtended extensionFields =
                 render <- getUrlRender
                 toMaster <- getRouteToMaster
                 let complete' = render $ toMaster complete
-                res <- runAttemptT $ OpenId.getForwardUrl oid complete' Nothing extensionFields 
+                master <- getYesod
-                attempt
+                eres <- lift $ try $ OpenId.getForwardUrl oid complete' Nothing extensionFields (authHttpManager master)
-                  (\err -> do
+                case eres of
-                        setMessage $ toHtml $ show err
+                    Left err -> do
+                        setMessage $ toHtml $ show (err :: SomeException)
                         redirect $ toMaster LoginR
-                        )
+                    Right x -> redirect x
-                  redirect
-                  res
             Nothing -> do
                 toMaster <- getRouteToMaster
                 setMessageI Msg.NoOpenID
@@ -84,11 +83,12 @@ authOpenIdExtended extensionFields =
 
 completeHelper :: YesodAuth m => [(Text, Text)] -> GHandler Auth m ()
 completeHelper gets' = do
-        res <- runAttemptT $ OpenId.authenticate gets'
+        master <- getYesod
+        eres <- lift $ try $ OpenId.authenticate gets' (authHttpManager master)
         toMaster <- getRouteToMaster
         let onFailure err = do
-            setMessage $ toHtml $ show err
+            setMessage $ toHtml $ show (err :: SomeException)
             redirect $ toMaster LoginR
         let onSuccess (OpenId.Identifier ident, _) =
                 setCreds True $ Creds "openid" ident gets'
-        attempt onFailure onSuccess res
+        either onFailure onSuccess eres

yesod-auth/Yesod/Auth/Rpxnow.hs

@@ -38,7 +38,8 @@ authRpxnow app apiKey =
         token <- case token1 ++ token2 of
                         [] -> invalidArgs ["token: Value not supplied"]
                         x:_ -> return $ unpack x
-        Rpxnow.Identifier ident extra <- liftIO $ Rpxnow.authenticate apiKey token
+        master <- getYesod
+        Rpxnow.Identifier ident extra <- lift $ Rpxnow.authenticate apiKey token (authHttpManager master)
         let creds =
                 Creds "rpxnow" ident
                 $ maybe id (\x -> (:) ("verifiedEmail", x))

yesod-auth/yesod-auth.cabal

@@ -21,14 +21,13 @@ library
         cpp-options:     -DGHC7
     else
         build-depends:   base                >= 4        && < 4.3
-    build-depends:   authenticate            >= 0.11.1    && < 0.12
+    build-depends:   authenticate            >= 1.0       && < 1.1
                    , bytestring              >= 0.9.1.4   && < 0.10
                    , yesod-core              >= 0.10      && < 0.11
                    , wai                     >= 1.0       && < 1.1
                    , template-haskell
                    , pureMD5                 >= 2.0       && < 2.2
                    , random                  >= 1.0.0.2  && < 1.1
-                   , control-monad-attempt   >= 0.3.0     && < 0.4
                    , text                    >= 0.7       && < 0.12
                    , mime-mail               >= 0.3       && < 0.5
                    , blaze-html              >= 0.4.1.3   && < 0.5
@@ -46,6 +45,7 @@ library
                    , http-conduit            >= 1.1       && < 1.2
                    , aeson                   >= 0.5
                    , pwstore-fast            >= 2.2       && < 3
+                   , lifted-base             >= 0.1       && < 0.2
 
     exposed-modules: Yesod.Auth
                      Yesod.Auth.BrowserId