yesod-auth 1.4.6.1 → 1.4.7

raw patch · 4 files changed

+45/−20 lines, 4 filesdep ~basedep ~conduitdep ~conduit-extraPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, conduit, conduit-extra, http-conduit, resourcet

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• Yesod/Auth.hs +14/−2
• Yesod/Auth/GoogleEmail2.hs +24/−16
• yesod-auth.cabal +3/−2

@@ -1,3 +1,7 @@+## 1.4.7++* add a runHttpRequest function for handling HTTP errors+ ## 1.4.6  * Use nonce package to generate verification keys and CSRF tokens [#1011](https://github.com/yesodweb/yesod/pull/1011)

@@ -46,6 +46,7 @@     , asHtml     ) where +import           Control.Applicative ((<$>)) import Control.Monad                 (when) import Control.Monad.Trans.Maybe @@ -57,11 +58,12 @@ import qualified Data.Text as T import qualified Data.HashMap.Lazy as Map import Data.Monoid (Endo)-import Network.HTTP.Conduit (Manager)+import Network.HTTP.Client (Manager, Request, withResponse, Response, BodyReader)  import qualified Network.Wai as W  import Yesod.Core+import Yesod.Core.Types (HandlerT(..), unHandlerT) import Yesod.Persist import Yesod.Auth.Message (AuthMessage, defaultMessage) import qualified Yesod.Auth.Message as Msg@@ -146,7 +148,7 @@     authPlugins :: master -> [AuthPlugin master]      -- | What to show on the login page.-    -- +    --     -- Default handler concatenates plugin widgets and wraps the result     -- in 'authLayout'. Override if you need fancy widget containers     -- or entirely custom page.@@ -207,6 +209,16 @@     onErrorHtml dest msg = do         setMessage $ toHtml msg         fmap asHtml $ redirect dest++    -- | runHttpRequest gives you a chance to handle an HttpException and retry+    --  The default behavior is to simply execute the request which will throw an exception on failure+    --+    --  The HTTP 'Request' is given in case it is useful to change behavior based on inspecting the request.+    --  This is an experimental API that is not broadly used throughout the yesod-auth code base+    runHttpRequest :: Request -> (Response BodyReader -> HandlerT master IO a) -> HandlerT master IO a+    runHttpRequest req inner = do+      man <- authHttpManager <$> getYesod+      HandlerT $ \t -> withResponse req man $ \res -> unHandlerT (inner res) t      {-# MINIMAL loginDest, logoutDest, (authenticate | getAuthId), authPlugins, authHttpManager #-} 

@@ -50,11 +50,11 @@ import           Yesod.Auth               (Auth, AuthPlugin (AuthPlugin),                                            AuthRoute, Creds (Creds),                                            Route (PluginR), YesodAuth,-                                           authHttpManager, setCredsRedirect)+                                           runHttpRequest, setCredsRedirect) import qualified Yesod.Auth.Message       as Msg import           Yesod.Core               (HandlerSite, HandlerT, MonadHandler,                                            TypedContent, getRouteToParent,-                                           getUrlRender, getYesod, invalidArgs,+                                           getUrlRender, invalidArgs,                                            lift, liftIO, lookupGetParam,                                            lookupSession, notFound, redirect,                                            setSession, whamlet, (.:))@@ -63,7 +63,8 @@ import           Blaze.ByteString.Builder (fromByteString, toByteString) import           Control.Applicative      ((<$>), (<*>)) import           Control.Arrow            (second)-import           Control.Monad            (liftM, unless, when)+import           Control.Monad            (unless, when)+import           Control.Monad.IO.Class   (MonadIO) import qualified Crypto.Nonce             as Nonce import           Data.Aeson               ((.:?)) import qualified Data.Aeson               as A@@ -71,7 +72,7 @@ import           Data.Aeson.Parser        (json') import           Data.Aeson.Types         (FromJSON (parseJSON), parseEither,                                            parseMaybe, withObject, withText)-import           Data.Conduit             (($$+-))+import           Data.Conduit             (($$+-), ($$)) import           Data.Conduit.Attoparsec  (sinkParser) import qualified Data.HashMap.Strict      as M import           Data.Maybe               (fromMaybe)@@ -83,7 +84,8 @@ import qualified Data.Text.Lazy.Builder   as TL import           Network.HTTP.Client      (Manager, parseUrl, requestHeaders,                                            responseBody, urlEncodedBody)-import           Network.HTTP.Conduit     (http)+import           Network.HTTP.Client.Conduit (Request, bodyReaderSource)+import           Network.HTTP.Conduit (http) import           Network.HTTP.Types       (renderQueryText) import           System.IO.Unsafe         (unsafePerformIO) @@ -202,9 +204,7 @@                     req'                         { requestHeaders = []                         }-        manager <- liftM authHttpManager $ lift getYesod-        res <- http req manager-        value <- responseBody res $$+- sinkParser json'+        value <- makeHttpRequest req         token@(Token accessToken' tokenType') <-             case parseEither parseJSON value of                 Left e -> error e@@ -215,7 +215,7 @@         -- User's access token is saved for further access to API         when storeToken $ setSession accessTokenKey accessToken' -        personValue <- lift $ getPersonValue manager token+        personValue <- makeHttpRequest =<< personValueRequest token         person <- case parseEither parseJSON personValue of                 Left e -> error e                 Right x -> return x@@ -229,25 +229,33 @@      dispatch _ _ = notFound +makeHttpRequest+  :: (YesodAuth site)+  => Request+  -> HandlerT Auth (HandlerT site IO) A.Value+makeHttpRequest req = lift $+    runHttpRequest req $ \res -> bodyReaderSource (responseBody res) $$ sinkParser json'+ -- | Allows to fetch information about a user from Google's API. --   In case of parsing error returns 'Nothing'. --   Will throw 'HttpException' in case of network problems or error response code. -- -- Since 1.4.3 getPerson :: Manager -> Token -> HandlerT site IO (Maybe Person)-getPerson manager token = parseMaybe parseJSON <$> getPersonValue manager token+getPerson manager token = parseMaybe parseJSON <$> (do+    req <- personValueRequest token+    res <- http req manager+    responseBody res $$+- sinkParser json'+  ) -getPersonValue :: Manager -> Token -> HandlerT site IO A.Value-getPersonValue manager token = do+personValueRequest :: MonadIO m => Token -> m Request+personValueRequest token = do     req2' <- liftIO $ parseUrl "https://www.googleapis.com/plus/v1/people/me"-    let req2 = req2'+    return req2'             { requestHeaders =                 [ ("Authorization", encodeUtf8 $ "Bearer " `mappend` accessToken token)                 ]             }-    res2 <- http req2 manager-    val <- responseBody res2 $$+- sinkParser json'-    return val  -------------------------------------------------------------------------------- -- | An authentication token which was acquired from OAuth callback.

@@ -1,5 +1,5 @@ name:            yesod-auth-version:         1.4.6.1+version:         1.4.7 license:         MIT license-file:    LICENSE author:          Michael Snoyman, Patrick Brisbin@@ -39,7 +39,8 @@                    , transformers            >= 0.2.2                    , persistent              >= 2.1       && < 2.3                    , persistent-template     >= 2.1       && < 2.2-                   , http-conduit            >= 1.5+                   , http-client+                   , http-conduit            >= 2.1                    , aeson                   >= 0.7                    , lifted-base             >= 0.1                    , blaze-html              >= 0.5