yesod-auth 1.1.3 → 1.1.4
raw patch · 3 files changed
+61/−53 lines, 3 filesdep +http-types
Dependencies added: http-types
Files
- Yesod/Auth.hs +52/−50
- Yesod/Auth/Rpxnow.hs +7/−2
- yesod-auth.cabal +2/−1
Yesod/Auth.hs view
@@ -59,41 +59,41 @@ type Method = Text type Piece = Text -data AuthPlugin m = AuthPlugin+data AuthPlugin master = AuthPlugin { apName :: Text- , apDispatch :: Method -> [Piece] -> GHandler Auth m ()- , apLogin :: forall s. (Route Auth -> Route m) -> GWidget s m ()+ , apDispatch :: Method -> [Piece] -> GHandler Auth master ()+ , apLogin :: forall sub. (Route Auth -> Route master) -> GWidget sub master () } getAuth :: a -> Auth getAuth = const Auth -- | User credentials-data Creds m = Creds+data Creds master = Creds { credsPlugin :: Text -- ^ How the user was authenticated , credsIdent :: Text -- ^ Identifier. Exact meaning depends on plugin. , credsExtra :: [(Text, Text)] } -class (Yesod m, PathPiece (AuthId m), RenderMessage m FormMessage) => YesodAuth m where- type AuthId m+class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage) => YesodAuth master where+ type AuthId master -- | Default destination on successful login, if no other -- destination exists.- loginDest :: m -> Route m+ loginDest :: master -> Route master -- | Default destination on successful logout, if no other -- destination exists.- logoutDest :: m -> Route m+ logoutDest :: master -> Route master -- | Determine the ID associated with the set of credentials.- getAuthId :: Creds m -> GHandler s m (Maybe (AuthId m))+ getAuthId :: Creds master -> GHandler sub master (Maybe (AuthId master)) -- | Which authentication backends to use.- authPlugins :: m -> [AuthPlugin m]+ authPlugins :: master -> [AuthPlugin master] -- | What to show on the login page.- loginHandler :: GHandler Auth m RepHtml+ loginHandler :: GHandler Auth master RepHtml loginHandler = defaultLayout $ do setTitleI Msg.LoginTitle tm <- lift getRouteToMaster@@ -101,29 +101,29 @@ mapM_ (flip apLogin tm) (authPlugins master) -- | Used for i18n of messages provided by this package.- renderAuthMessage :: m+ renderAuthMessage :: master -> [Text] -- ^ languages -> AuthMessage -> Text renderAuthMessage _ _ = defaultMessage -- | After login and logout, redirect to the referring page, instead of -- 'loginDest' and 'logoutDest'. Default is 'False'.- redirectToReferer :: m -> Bool+ redirectToReferer :: master -> 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+ authHttpManager :: master -> Manager -- | Called on a successful login. By default, calls -- @setMessageI NowLoggedIn@.- onLogin :: GHandler s m ()+ onLogin :: GHandler sub master () onLogin = setMessageI Msg.NowLoggedIn -- | Called on logout. By default, does nothing- onLogout :: GHandler s m ()+ onLogout :: GHandler sub master () onLogout = return () -- | Retrieves user credentials, if user is authenticated.@@ -135,7 +135,7 @@ -- other than a browser. -- -- Since 1.1.2- maybeAuthId :: GHandler s m (Maybe (AuthId m))+ maybeAuthId :: GHandler sub master (Maybe (AuthId master)) maybeAuthId = defaultMaybeAuthId credsKey :: Text@@ -144,7 +144,8 @@ -- | Retrieves user credentials from the session, if user is authenticated. -- -- Since 1.1.2-defaultMaybeAuthId :: YesodAuth m => GHandler s m (Maybe (AuthId m))+defaultMaybeAuthId :: YesodAuth master+ => GHandler sub master (Maybe (AuthId master)) defaultMaybeAuthId = do ms <- lookupSession credsKey case ms of@@ -162,8 +163,7 @@ /page/#Text/STRINGS PluginR |] --- | FIXME: won't show up till redirect-setCreds :: YesodAuth m => Bool -> Creds m -> GHandler s m ()+setCreds :: YesodAuth master => Bool -> Creds master -> GHandler sub master () setCreds doRedirects creds = do y <- getYesod maid <- getAuthId creds@@ -184,7 +184,7 @@ onLogin redirectUltDest $ loginDest y -getCheckR :: YesodAuth m => GHandler Auth m RepHtmlJson+getCheckR :: YesodAuth master => GHandler Auth master RepHtmlJson getCheckR = do creds <- maybeAuthId defaultLayoutJson (do@@ -207,23 +207,25 @@ setUltDestReferer' :: YesodAuth master => GHandler sub master () setUltDestReferer' = do- m <- getYesod- when (redirectToReferer m) setUltDestReferer+ master <- getYesod+ when (redirectToReferer master) setUltDestReferer -getLoginR :: YesodAuth m => GHandler Auth m RepHtml+getLoginR :: YesodAuth master => GHandler Auth master RepHtml getLoginR = setUltDestReferer' >> loginHandler -getLogoutR :: YesodAuth m => GHandler Auth m ()-getLogoutR = setUltDestReferer' >> postLogoutR -- FIXME redirect to post+getLogoutR :: YesodAuth master => GHandler Auth master ()+getLogoutR = do+ tm <- getRouteToMaster+ setUltDestReferer' >> redirectToPost (tm LogoutR) -postLogoutR :: YesodAuth m => GHandler Auth m ()+postLogoutR :: YesodAuth master => GHandler Auth master () postLogoutR = do y <- getYesod deleteSession credsKey onLogout redirectUltDest $ logoutDest y -handlePluginR :: YesodAuth m => Text -> [Text] -> GHandler Auth m ()+handlePluginR :: YesodAuth master => Text -> [Text] -> GHandler Auth master () handlePluginR plugin pieces = do master <- getYesod env <- waiRequest@@ -232,46 +234,46 @@ [] -> notFound ap:_ -> apDispatch ap method pieces -maybeAuth :: ( YesodAuth m+maybeAuth :: ( YesodAuth master #if MIN_VERSION_persistent(1, 1, 0)- , PersistMonadBackend (b (GHandler s m)) ~ PersistEntityBackend val- , b ~ YesodPersistBackend m- , Key val ~ AuthId m- , PersistStore (b (GHandler s m))+ , PersistMonadBackend (b (GHandler sub master)) ~ PersistEntityBackend val+ , b ~ YesodPersistBackend master+ , Key val ~ AuthId master+ , PersistStore (b (GHandler sub master)) #else- , b ~ YesodPersistBackend m+ , b ~ YesodPersistBackend master , b ~ PersistEntityBackend val- , Key b val ~ AuthId m- , PersistStore b (GHandler s m)+ , Key b val ~ AuthId master+ , PersistStore b (GHandler sub master) #endif , PersistEntity val- , YesodPersist m- ) => GHandler s m (Maybe (Entity val))+ , YesodPersist master+ ) => GHandler sub master (Maybe (Entity val)) maybeAuth = runMaybeT $ do aid <- MaybeT $ maybeAuthId a <- MaybeT $ runDB $ get aid return $ Entity aid a -requireAuthId :: YesodAuth m => GHandler s m (AuthId m)+requireAuthId :: YesodAuth master => GHandler sub master (AuthId master) requireAuthId = maybeAuthId >>= maybe redirectLogin return -requireAuth :: ( YesodAuth m- , b ~ YesodPersistBackend m+requireAuth :: ( YesodAuth master+ , b ~ YesodPersistBackend master #if MIN_VERSION_persistent(1, 1, 0)- , PersistMonadBackend (b (GHandler s m)) ~ PersistEntityBackend val- , Key val ~ AuthId m- , PersistStore (b (GHandler s m))+ , PersistMonadBackend (b (GHandler sub master)) ~ PersistEntityBackend val+ , Key val ~ AuthId master+ , PersistStore (b (GHandler sub master)) #else , b ~ PersistEntityBackend val- , Key b val ~ AuthId m- , PersistStore b (GHandler s m)+ , Key b val ~ AuthId master+ , PersistStore b (GHandler sub master) #endif , PersistEntity val- , YesodPersist m- ) => GHandler s m (Entity val)+ , YesodPersist master+ ) => GHandler sub master (Entity val) requireAuth = maybeAuth >>= maybe redirectLogin return -redirectLogin :: Yesod m => GHandler s m a+redirectLogin :: Yesod master => GHandler sub master a redirectLogin = do y <- getYesod setUltDestCurrent@@ -279,7 +281,7 @@ Just z -> redirect z Nothing -> permissionDenied "Please configure authRoute" -instance YesodAuth m => RenderMessage m AuthMessage where+instance YesodAuth master => RenderMessage master AuthMessage where renderMessage = renderAuthMessage data AuthException = InvalidBrowserIDAssertion
Yesod/Auth/Rpxnow.hs view
@@ -13,7 +13,10 @@ import Yesod.Request import Text.Hamlet (hamlet) import Data.Text (pack, unpack)+import Data.Text.Encoding (encodeUtf8, decodeUtf8With)+import Data.Text.Encoding.Error (lenientDecode) import Control.Arrow ((***))+import Network.HTTP.Types (renderQuery) authRpxnow :: YesodAuth m => String -- ^ app name@@ -23,10 +26,12 @@ AuthPlugin "rpxnow" dispatch login where login tm = do- let url = {- FIXME urlEncode $ -} tm $ PluginR "rpxnow" []+ render <- lift getUrlRender+ let queryString = decodeUtf8With lenientDecode+ $ renderQuery True [("token_url", Just $ encodeUtf8 $ render $ tm $ PluginR "rpxnow" [])] toWidget [hamlet| $newline never-<iframe src="http://#{app}.rpxnow.com/openid/embed?token_url=@{url}" scrolling="no" frameBorder="no" allowtransparency="true" style="width:400px;height:240px">+<iframe src="http://#{app}.rpxnow.com/openid/embed#{queryString}" scrolling="no" frameBorder="no" allowtransparency="true" style="width:400px;height:240px"> |] dispatch _ [] = do token1 <- lookupGetParams "token"
yesod-auth.cabal view
@@ -1,5 +1,5 @@ name: yesod-auth-version: 1.1.3+version: 1.1.4 license: MIT license-file: LICENSE author: Michael Snoyman, Patrick Brisbin@@ -42,6 +42,7 @@ , blaze-html >= 0.5 && < 0.6 , blaze-markup >= 0.5.1 && < 0.6 , network+ , http-types exposed-modules: Yesod.Auth Yesod.Auth.BrowserId