{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Yesod.Auth
    ( -- * Subsite
      Auth
    , AuthRoute
    , Route (..)
    , AuthPlugin (..)
    , getAuth
    , YesodAuth (..)
    , YesodAuthPersist (..)
      -- * Plugin interface
    , Creds (..)
    , setCreds
    , setCredsRedirect
    , clearCreds
    , loginErrorMessage
    , loginErrorMessageI
      -- * User functions
    , AuthenticationResult (..)
    , defaultMaybeAuthId
    , defaultLoginHandler
    , maybeAuthPair
    , maybeAuth
    , requireAuthId
    , requireAuthPair
    , requireAuth
      -- * Exception
    , AuthException (..)
      -- * Helper
    , MonadAuthHandler
    , AuthHandler
      -- * Internal
    , credsKey
    , provideJsonMessage
    , messageJson401
    , asHtml
    ) where

import Control.Monad                 (when)
import Control.Monad.Trans.Maybe
import UnliftIO                      (withRunInIO, MonadUnliftIO)

import Yesod.Auth.Routes
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import           Data.Text (Text)
import qualified Data.Text as T
import qualified Data.HashMap.Lazy as Map
import Data.Monoid (Endo)
import Network.HTTP.Client (Manager, Request, withResponse, Response, BodyReader)
import Network.HTTP.Client.TLS (getGlobalManager)

import qualified Network.Wai as W

import Yesod.Core
import Yesod.Persist
import Yesod.Auth.Message (AuthMessage, defaultMessage)
import qualified Yesod.Auth.Message as Msg
import Yesod.Form (FormMessage)
import Data.Typeable (Typeable)
import Control.Exception (Exception)
import Network.HTTP.Types (Status, internalServerError500, unauthorized401)
import qualified Control.Monad.Trans.Writer    as Writer
import Control.Monad (void)
import Data.Kind (Type)

type AuthRoute = Route Auth

type MonadAuthHandler master m = (MonadHandler m, YesodAuth master, master ~ HandlerSite m, Auth ~ SubHandlerSite m, MonadUnliftIO m)
type AuthHandler master a = forall m. MonadAuthHandler master m => m a

type Method = Text
type Piece = Text

-- | The result of an authentication based on credentials
--
-- @since 1.4.4
data AuthenticationResult master
    = Authenticated (AuthId master) -- ^ Authenticated successfully
    | UserError AuthMessage         -- ^ Invalid credentials provided by user
    | ServerError Text              -- ^ Some other error

data AuthPlugin master = AuthPlugin
    { forall master. AuthPlugin master -> Text
apName :: Text
    , forall master.
AuthPlugin master
-> Text -> [Text] -> AuthHandler master TypedContent
apDispatch :: Method -> [Piece] -> AuthHandler master TypedContent
    , forall master.
AuthPlugin master
-> (Route Auth -> Route master) -> WidgetFor master ()
apLogin :: (Route Auth -> Route master) -> WidgetFor master ()
    }

getAuth :: a -> Auth
getAuth :: forall a. a -> Auth
getAuth = forall a b. a -> b -> a
const Auth
Auth

-- | User credentials
data Creds master = Creds
    { forall master. Creds master -> Text
credsPlugin :: Text -- ^ How the user was authenticated
    , forall master. Creds master -> Text
credsIdent :: Text -- ^ Identifier. Exact meaning depends on plugin.
    , forall master. Creds master -> [(Text, Text)]
credsExtra :: [(Text, Text)]
    } deriving (Int -> Creds master -> ShowS
forall master. Int -> Creds master -> ShowS
forall master. [Creds master] -> ShowS
forall master. Creds master -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Creds master] -> ShowS
$cshowList :: forall master. [Creds master] -> ShowS
show :: Creds master -> String
$cshow :: forall master. Creds master -> String
showsPrec :: Int -> Creds master -> ShowS
$cshowsPrec :: forall master. Int -> Creds master -> ShowS
Show)

class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage) => YesodAuth master where
    type AuthId master

    -- | specify the layout. Uses defaultLayout by default
    authLayout :: (MonadHandler m, HandlerSite m ~ master) => WidgetFor master () -> m Html
    authLayout = forall (m :: * -> *) a.
MonadHandler m =>
HandlerFor (HandlerSite m) a -> m a
liftHandler forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall site.
Yesod site =>
WidgetFor site () -> HandlerFor site Html
defaultLayout

    -- | Default destination on successful login, if no other
    -- destination exists.
    loginDest :: master -> Route master

    -- | Default destination on successful logout, if no other
    -- destination exists.
    logoutDest :: master -> Route master

    -- | Perform authentication based on the given credentials.
    --
    -- Default implementation is in terms of @'getAuthId'@
    --
    -- @since: 1.4.4
    authenticate :: (MonadHandler m, HandlerSite m ~ master) => Creds master -> m (AuthenticationResult master)
    authenticate Creds master
creds = do
        Maybe (AuthId master)
muid <- forall master (m :: * -> *).
(YesodAuth master, MonadHandler m, HandlerSite m ~ master) =>
Creds master -> m (Maybe (AuthId master))
getAuthId Creds master
creds

        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall master. AuthMessage -> AuthenticationResult master
UserError AuthMessage
Msg.InvalidLogin) forall master. AuthId master -> AuthenticationResult master
Authenticated Maybe (AuthId master)
muid

    -- | Determine the ID associated with the set of credentials.
    --
    -- Default implementation is in terms of @'authenticate'@
    --
    getAuthId :: (MonadHandler m, HandlerSite m ~ master) => Creds master -> m (Maybe (AuthId master))
    getAuthId Creds master
creds = do
        AuthenticationResult master
auth <- forall master (m :: * -> *).
(YesodAuth master, MonadHandler m, HandlerSite m ~ master) =>
Creds master -> m (AuthenticationResult master)
authenticate Creds master
creds

        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case AuthenticationResult master
auth of
            Authenticated AuthId master
auid -> forall a. a -> Maybe a
Just AuthId master
auid
            AuthenticationResult master
_ -> forall a. Maybe a
Nothing

    -- | Which authentication backends to use.
    authPlugins :: master -> [AuthPlugin master]

    -- | What to show on the login page.
    --
    -- By default this calls 'defaultLoginHandler', which concatenates
    -- plugin widgets and wraps the result in 'authLayout'. Override if
    -- you need fancy widget containers, additional functionality, or an
    -- entirely custom page.  For example, in some applications you may
    -- want to prevent the login page being displayed for a user who is
    -- already logged in, even if the URL is visited explicitly; this can
    -- be done by overriding 'loginHandler' in your instance declaration
    -- with something like:
    --
    -- > instance YesodAuth App where
    -- >     ...
    -- >     loginHandler = do
    -- >         ma <- lift maybeAuthId
    -- >         when (isJust ma) $
    -- >             lift $ redirect HomeR   -- or any other Handler code you want
    -- >         defaultLoginHandler
    --
    loginHandler :: AuthHandler master Html
    loginHandler = forall master. AuthHandler master Html
defaultLoginHandler

    -- | Used for i18n of messages provided by this package.
    renderAuthMessage :: master
                      -> [Text] -- ^ languages
                      -> AuthMessage
                      -> Text
    renderAuthMessage master
_ [Text]
_ = AuthMessage -> Text
defaultMessage

    -- | After login and logout, redirect to the referring page, instead of
    -- 'loginDest' and 'logoutDest'. Default is 'False'.
    redirectToReferer :: master -> Bool
    redirectToReferer master
_ = Bool
False

    -- | When being redirected to the login page should the current page
    -- be set to redirect back to. Default is 'True'.
    --
    -- @since 1.4.21
    redirectToCurrent :: master -> Bool
    redirectToCurrent master
_ = Bool
True

    -- | 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 :: (MonadHandler m, HandlerSite m ~ master) => m Manager
    authHttpManager = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Manager
getGlobalManager

    -- | Called on a successful login. By default, calls
    -- @addMessageI "success" NowLoggedIn@.
    onLogin :: (MonadHandler m, master ~ HandlerSite m) => m ()
    onLogin = forall (m :: * -> *) msg.
(MonadHandler m, RenderMessage (HandlerSite m) msg) =>
Text -> msg -> m ()
addMessageI Text
"success" AuthMessage
Msg.NowLoggedIn

    -- | Called on logout. By default, does nothing
    onLogout :: (MonadHandler m, master ~ HandlerSite m) => m ()
    onLogout = forall (m :: * -> *) a. Monad m => a -> m a
return ()

    -- | Retrieves user credentials, if user is authenticated.
    --
    -- By default, this calls 'defaultMaybeAuthId' to get the user ID from the
    -- session. This can be overridden to allow authentication via other means,
    -- such as checking for a special token in a request header. This is
    -- especially useful for creating an API to be accessed via some means
    -- other than a browser.
    --
    -- @since 1.2.0
    maybeAuthId :: (MonadHandler m, master ~ HandlerSite m) => m (Maybe (AuthId master))

    default maybeAuthId
        :: (MonadHandler m, master ~ HandlerSite m, YesodAuthPersist master, Typeable (AuthEntity master))
        => m (Maybe (AuthId master))
    maybeAuthId = forall (m :: * -> *) master.
(MonadHandler m, HandlerSite m ~ master, YesodAuthPersist master,
 Typeable (AuthEntity master)) =>
m (Maybe (AuthId master))
defaultMaybeAuthId

    -- | Called on login error for HTTP requests. By default, calls
    -- @addMessage@ with "error" as status and redirects to @dest@.
    onErrorHtml :: (MonadHandler m, HandlerSite m ~ master) => Route master -> Text -> m Html
    onErrorHtml Route master
dest Text
msg = do
        forall (m :: * -> *). MonadHandler m => Text -> Html -> m ()
addMessage Text
"error" forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml Text
msg
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Html -> Html
asHtml forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) url a.
(MonadHandler m, RedirectUrl (HandlerSite m) url) =>
url -> m a
redirect Route master
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
      :: (MonadHandler m, HandlerSite m ~ master, MonadUnliftIO m)
      => Request
      -> (Response BodyReader -> m a)
      -> m a
    runHttpRequest Request
req Response BodyReader -> m a
inner = do
      Manager
man <- forall master (m :: * -> *).
(YesodAuth master, MonadHandler m, HandlerSite m ~ master) =>
m Manager
authHttpManager
      forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a.
Request -> Manager -> (Response BodyReader -> IO a) -> IO a
withResponse Request
req Manager
man forall a b. (a -> b) -> a -> b
$ forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response BodyReader -> m a
inner

    {-# MINIMAL loginDest, logoutDest, (authenticate | getAuthId), authPlugins #-}

{-# DEPRECATED getAuthId "Define 'authenticate' instead; 'getAuthId' will be removed in the next major version" #-}

-- | Internal session key used to hold the authentication information.
--
-- @since 1.2.3
credsKey :: Text
credsKey :: Text
credsKey = Text
"_ID"

-- | Retrieves user credentials from the session, if user is authenticated.
--
-- This function does /not/ confirm that the credentials are valid, see
-- 'maybeAuthIdRaw' for more information. The first call in a request
-- does a database request to make sure that the account is still in the database.
--
-- @since 1.1.2
defaultMaybeAuthId
    :: (MonadHandler m, HandlerSite m ~ master, YesodAuthPersist master, Typeable (AuthEntity master))
    => m (Maybe (AuthId master))
defaultMaybeAuthId :: forall (m :: * -> *) master.
(MonadHandler m, HandlerSite m ~ master, YesodAuthPersist master,
 Typeable (AuthEntity master)) =>
m (Maybe (AuthId master))
defaultMaybeAuthId = forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
    Text
s   <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupSession Text
credsKey
    AuthId master
aid <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s. PathPiece s => Text -> Maybe s
fromPathPiece Text
s
    AuthEntity master
_   <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) master.
(MonadHandler m, YesodAuthPersist master,
 Typeable (AuthEntity master), HandlerSite m ~ master) =>
AuthId master -> m (Maybe (AuthEntity master))
cachedAuth AuthId master
aid
    forall (m :: * -> *) a. Monad m => a -> m a
return AuthId master
aid

cachedAuth
    :: ( MonadHandler m
       , YesodAuthPersist master
       , Typeable (AuthEntity master)
       , HandlerSite m ~ master
       )
    => AuthId master
    -> m (Maybe (AuthEntity master))
cachedAuth :: forall (m :: * -> *) master.
(MonadHandler m, YesodAuthPersist master,
 Typeable (AuthEntity master), HandlerSite m ~ master) =>
AuthId master -> m (Maybe (AuthEntity master))
cachedAuth
    = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall val. CachedMaybeAuth val -> Maybe val
unCachedMaybeAuth
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. (MonadHandler m, Typeable a) => m a -> m a
cached
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall val. Maybe val -> CachedMaybeAuth val
CachedMaybeAuth
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall master (m :: * -> *).
(YesodAuthPersist master, MonadHandler m,
 HandlerSite m ~ master) =>
AuthId master -> m (Maybe (AuthEntity master))
getAuthEntity


-- | Default handler to show the login page.
--
-- This is the default 'loginHandler'.  It concatenates plugin widgets and
-- wraps the result in 'authLayout'.  See 'loginHandler' for more details.
--
-- @since 1.4.9
defaultLoginHandler :: AuthHandler master Html
defaultLoginHandler :: forall master. AuthHandler master Html
defaultLoginHandler = do
    Route Auth -> Route master
tp <- forall (m :: * -> *).
MonadHandler m =>
m (Route (SubHandlerSite m) -> Route (HandlerSite m))
getRouteToParent
    forall master (m :: * -> *).
(YesodAuth master, MonadHandler m, HandlerSite m ~ master) =>
WidgetFor master () -> m Html
authLayout forall a b. (a -> b) -> a -> b
$ do
        forall (m :: * -> *) msg.
(MonadWidget m, RenderMessage (HandlerSite m) msg) =>
msg -> m ()
setTitleI AuthMessage
Msg.LoginTitle
        master
master <- forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
getYesod
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall master.
AuthPlugin master
-> (Route Auth -> Route master) -> WidgetFor master ()
apLogin Route Auth -> Route master
tp) (forall master. YesodAuth master => master -> [AuthPlugin master]
authPlugins master
master)


loginErrorMessageI
  :: Route Auth
  -> AuthMessage
  -> AuthHandler master TypedContent
loginErrorMessageI :: forall master.
Route Auth -> AuthMessage -> AuthHandler master TypedContent
loginErrorMessageI Route Auth
dest AuthMessage
msg = do
  Route Auth -> Route master
toParent <- forall (m :: * -> *).
MonadHandler m =>
m (Route (SubHandlerSite m) -> Route (HandlerSite m))
getRouteToParent
  forall (m :: * -> *) master.
(MonadHandler m, HandlerSite m ~ master, YesodAuth master) =>
Route master -> AuthMessage -> m TypedContent
loginErrorMessageMasterI (Route Auth -> Route master
toParent Route Auth
dest) AuthMessage
msg


loginErrorMessageMasterI
  :: (MonadHandler m, HandlerSite m ~ master, YesodAuth master)
  => Route master
  -> AuthMessage
  -> m TypedContent
loginErrorMessageMasterI :: forall (m :: * -> *) master.
(MonadHandler m, HandlerSite m ~ master, YesodAuth master) =>
Route master -> AuthMessage -> m TypedContent
loginErrorMessageMasterI Route master
dest AuthMessage
msg = do
  AuthMessage -> Text
mr <- forall (m :: * -> *) message.
(MonadHandler m, RenderMessage (HandlerSite m) message) =>
m (message -> Text)
getMessageRender
  forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
Route (HandlerSite m) -> Text -> m TypedContent
loginErrorMessage Route master
dest (AuthMessage -> Text
mr AuthMessage
msg)

-- | For HTML, set the message and redirect to the route.
-- For JSON, send the message and a 401 status
loginErrorMessage
         :: (MonadHandler m, YesodAuth (HandlerSite m))
         => Route (HandlerSite m)
         -> Text
         -> m TypedContent
loginErrorMessage :: forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
Route (HandlerSite m) -> Text -> m TypedContent
loginErrorMessage Route (HandlerSite m)
dest Text
msg = forall (m :: * -> *).
MonadHandler m =>
Text -> m Html -> m TypedContent
messageJson401 Text
msg (forall master (m :: * -> *).
(YesodAuth master, MonadHandler m, HandlerSite m ~ master) =>
Route master -> Text -> m Html
onErrorHtml Route (HandlerSite m)
dest Text
msg)

messageJson401
  :: MonadHandler m
  => Text
  -> m Html
  -> m TypedContent
messageJson401 :: forall (m :: * -> *).
MonadHandler m =>
Text -> m Html -> m TypedContent
messageJson401 = forall (m :: * -> *).
MonadHandler m =>
Status -> Text -> m Html -> m TypedContent
messageJsonStatus Status
unauthorized401

messageJson500 :: MonadHandler m => Text -> m Html -> m TypedContent
messageJson500 :: forall (m :: * -> *).
MonadHandler m =>
Text -> m Html -> m TypedContent
messageJson500 = forall (m :: * -> *).
MonadHandler m =>
Status -> Text -> m Html -> m TypedContent
messageJsonStatus Status
internalServerError500

messageJsonStatus
  :: MonadHandler m
  => Status
  -> Text
  -> m Html
  -> m TypedContent
messageJsonStatus :: forall (m :: * -> *).
MonadHandler m =>
Status -> Text -> m Html -> m TypedContent
messageJsonStatus Status
status Text
msg m Html
html = forall (m :: * -> *).
MonadHandler m =>
Writer (Endo [ProvidedRep m]) () -> m TypedContent
selectRep forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *) a.
(Monad m, HasContentType a) =>
m a -> Writer (Endo [ProvidedRep m]) ()
provideRep m Html
html
    forall (m :: * -> *) a.
(Monad m, HasContentType a) =>
m a -> Writer (Endo [ProvidedRep m]) ()
provideRep forall a b. (a -> b) -> a -> b
$ do
        let obj :: Value
obj = [Pair] -> Value
object [Key
"message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
msg]
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) c a.
(MonadHandler m, ToTypedContent c) =>
Status -> c -> m a
sendResponseStatus Status
status Value
obj
        forall (m :: * -> *) a. Monad m => a -> m a
return Value
obj

provideJsonMessage :: Monad m => Text -> Writer.Writer (Endo [ProvidedRep m]) ()
provideJsonMessage :: forall (m :: * -> *).
Monad m =>
Text -> Writer (Endo [ProvidedRep m]) ()
provideJsonMessage Text
msg = forall (m :: * -> *) a.
(Monad m, HasContentType a) =>
m a -> Writer (Endo [ProvidedRep m]) ()
provideRep forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [Key
"message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
msg]


setCredsRedirect
  :: (MonadHandler m, YesodAuth (HandlerSite m))
  => Creds (HandlerSite m) -- ^ new credentials
  -> m TypedContent
setCredsRedirect :: forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
Creds (HandlerSite m) -> m TypedContent
setCredsRedirect Creds (HandlerSite m)
creds = do
    HandlerSite m
y    <- forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
getYesod
    AuthenticationResult (HandlerSite m)
auth <- forall master (m :: * -> *).
(YesodAuth master, MonadHandler m, HandlerSite m ~ master) =>
Creds master -> m (AuthenticationResult master)
authenticate Creds (HandlerSite m)
creds
    case AuthenticationResult (HandlerSite m)
auth of
        Authenticated AuthId (HandlerSite m)
aid -> do
            forall (m :: * -> *). MonadHandler m => Text -> Text -> m ()
setSession Text
credsKey forall a b. (a -> b) -> a -> b
$ forall s. PathPiece s => s -> Text
toPathPiece AuthId (HandlerSite m)
aid
            forall master (m :: * -> *).
(YesodAuth master, MonadHandler m, master ~ HandlerSite m) =>
m ()
onLogin
            TypedContent
res <- forall (m :: * -> *).
MonadHandler m =>
Writer (Endo [ProvidedRep m]) () -> m TypedContent
selectRep forall a b. (a -> b) -> a -> b
$ do
                forall (m :: * -> *) a.
(Monad m, ToContent a) =>
ContentType -> m a -> Writer (Endo [ProvidedRep m]) ()
provideRepType ContentType
typeHtml forall a b. (a -> b) -> a -> b
$
                    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Html -> Html
asHtml forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) url a.
(RedirectUrl (HandlerSite m) url, MonadHandler m) =>
url -> m a
redirectUltDest forall a b. (a -> b) -> a -> b
$ forall master. YesodAuth master => master -> Route master
loginDest HandlerSite m
y
                forall (m :: * -> *).
Monad m =>
Text -> Writer (Endo [ProvidedRep m]) ()
provideJsonMessage Text
"Login Successful"
            forall (m :: * -> *) c a.
(MonadHandler m, ToTypedContent c) =>
c -> m a
sendResponse TypedContent
res

        UserError AuthMessage
msg ->
            case forall site. Yesod site => site -> Maybe (Route site)
authRoute HandlerSite m
y of
                Maybe (Route (HandlerSite m))
Nothing -> do
                    Text
msg' <- forall {m :: * -> *}.
(MonadHandler m, YesodAuth (HandlerSite m)) =>
AuthMessage -> m Text
renderMessage' AuthMessage
msg
                    forall (m :: * -> *).
MonadHandler m =>
Text -> m Html -> m TypedContent
messageJson401 Text
msg' forall a b. (a -> b) -> a -> b
$ forall master (m :: * -> *).
(YesodAuth master, MonadHandler m, HandlerSite m ~ master) =>
WidgetFor master () -> m Html
authLayout forall a b. (a -> b) -> a -> b
$ -- TODO
                        forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
toWidget [whamlet|<h1>_{msg}|]
                Just Route (HandlerSite m)
ar -> forall (m :: * -> *) master.
(MonadHandler m, HandlerSite m ~ master, YesodAuth master) =>
Route master -> AuthMessage -> m TypedContent
loginErrorMessageMasterI Route (HandlerSite m)
ar AuthMessage
msg

        ServerError Text
msg -> do
            $(logError) Text
msg

            case forall site. Yesod site => site -> Maybe (Route site)
authRoute HandlerSite m
y of
                Maybe (Route (HandlerSite m))
Nothing -> do
                    Text
msg' <- forall {m :: * -> *}.
(MonadHandler m, YesodAuth (HandlerSite m)) =>
AuthMessage -> m Text
renderMessage' AuthMessage
Msg.AuthError
                    forall (m :: * -> *).
MonadHandler m =>
Text -> m Html -> m TypedContent
messageJson500 Text
msg' forall a b. (a -> b) -> a -> b
$ forall master (m :: * -> *).
(YesodAuth master, MonadHandler m, HandlerSite m ~ master) =>
WidgetFor master () -> m Html
authLayout forall a b. (a -> b) -> a -> b
$
                        forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
toWidget [whamlet|<h1>_{Msg.AuthError}|]
                Just Route (HandlerSite m)
ar -> forall (m :: * -> *) master.
(MonadHandler m, HandlerSite m ~ master, YesodAuth master) =>
Route master -> AuthMessage -> m TypedContent
loginErrorMessageMasterI Route (HandlerSite m)
ar AuthMessage
Msg.AuthError

  where
    renderMessage' :: AuthMessage -> m Text
renderMessage' AuthMessage
msg = do
        [Text]
langs <- forall (m :: * -> *). MonadHandler m => m [Text]
languages
        HandlerSite m
master <- forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
getYesod
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall master.
YesodAuth master =>
master -> [Text] -> AuthMessage -> Text
renderAuthMessage HandlerSite m
master [Text]
langs AuthMessage
msg

-- | Sets user credentials for the session after checking them with authentication backends.
setCreds :: (MonadHandler m, YesodAuth (HandlerSite m))
         => Bool                  -- ^ if HTTP redirects should be done
         -> Creds (HandlerSite m) -- ^ new credentials
         -> m ()
setCreds :: forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
Bool -> Creds (HandlerSite m) -> m ()
setCreds Bool
doRedirects Creds (HandlerSite m)
creds =
    if Bool
doRedirects
      then forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
Creds (HandlerSite m) -> m TypedContent
setCredsRedirect Creds (HandlerSite m)
creds
      else do AuthenticationResult (HandlerSite m)
auth <- forall master (m :: * -> *).
(YesodAuth master, MonadHandler m, HandlerSite m ~ master) =>
Creds master -> m (AuthenticationResult master)
authenticate Creds (HandlerSite m)
creds
              case AuthenticationResult (HandlerSite m)
auth of
                  Authenticated AuthId (HandlerSite m)
aid -> forall (m :: * -> *). MonadHandler m => Text -> Text -> m ()
setSession Text
credsKey forall a b. (a -> b) -> a -> b
$ forall s. PathPiece s => s -> Text
toPathPiece AuthId (HandlerSite m)
aid
                  AuthenticationResult (HandlerSite m)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | same as defaultLayoutJson, but uses authLayout
authLayoutJson
  :: (ToJSON j, MonadAuthHandler master m)
  => WidgetFor master ()  -- ^ HTML
  -> m j  -- ^ JSON
  -> m TypedContent
authLayoutJson :: forall j master (m :: * -> *).
(ToJSON j, MonadAuthHandler master m) =>
WidgetFor master () -> m j -> m TypedContent
authLayoutJson WidgetFor master ()
w m j
json = forall (m :: * -> *).
MonadHandler m =>
Writer (Endo [ProvidedRep m]) () -> m TypedContent
selectRep forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *) a.
(Monad m, HasContentType a) =>
m a -> Writer (Endo [ProvidedRep m]) ()
provideRep forall a b. (a -> b) -> a -> b
$ forall master (m :: * -> *).
(YesodAuth master, MonadHandler m, HandlerSite m ~ master) =>
WidgetFor master () -> m Html
authLayout WidgetFor master ()
w
    forall (m :: * -> *) a.
(Monad m, HasContentType a) =>
m a -> Writer (Endo [ProvidedRep m]) ()
provideRep forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToJSON a => a -> Value
toJSON m j
json

-- | Clears current user credentials for the session.
--
-- @since 1.1.7
clearCreds :: (MonadHandler m, YesodAuth (HandlerSite m))
           => Bool -- ^ if HTTP, redirect to 'logoutDest'
           -> m ()
clearCreds :: forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
Bool -> m ()
clearCreds Bool
doRedirects = do
    forall master (m :: * -> *).
(YesodAuth master, MonadHandler m, master ~ HandlerSite m) =>
m ()
onLogout
    forall (m :: * -> *). MonadHandler m => Text -> m ()
deleteSession Text
credsKey
    HandlerSite m
y  <- forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
getYesod
    Bool
aj <- forall (m :: * -> *). MonadHandler m => m Bool
acceptsJson
    case (Bool
aj, Bool
doRedirects) of
      (Bool
True, Bool
_)               -> forall (m :: * -> *) c a.
(MonadHandler m, ToTypedContent c) =>
c -> m a
sendResponse Value
successfulLogout
      (Bool
False, Bool
True)           -> forall (m :: * -> *) url a.
(RedirectUrl (HandlerSite m) url, MonadHandler m) =>
url -> m a
redirectUltDest (forall master. YesodAuth master => master -> Route master
logoutDest HandlerSite m
y)
      (Bool, Bool)
_                       -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    where successfulLogout :: Value
successfulLogout = [Pair] -> Value
object [Key
"message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
msg]
          msg :: Text
          msg :: Text
msg = Text
"Logged out successfully!"

getCheckR :: AuthHandler master TypedContent
getCheckR :: forall master. AuthHandler master TypedContent
getCheckR = do
    Maybe (AuthId master)
creds <- forall master (m :: * -> *).
(YesodAuth master, MonadHandler m, master ~ HandlerSite m) =>
m (Maybe (AuthId master))
maybeAuthId
    forall j master (m :: * -> *).
(ToJSON j, MonadAuthHandler master m) =>
WidgetFor master () -> m j -> m TypedContent
authLayoutJson (do
        forall (m :: * -> *). MonadWidget m => Html -> m ()
setTitle Html
"Authentication Status"
        forall site a (m :: * -> *).
(ToWidget site a, MonadWidget m, HandlerSite m ~ site) =>
a -> m ()
toWidget forall a b. (a -> b) -> a -> b
$ forall {v}. Maybe v -> Html
html' Maybe (AuthId master)
creds) (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {a}. Maybe a -> Value
jsonCreds Maybe (AuthId master)
creds)
  where
    html' :: Maybe v -> Html
html' Maybe v
creds =
        [shamlet|
$newline never
<h1>Authentication Status
$maybe _ <- creds
    <p>Logged in.
$nothing
    <p>Not logged in.
|]
    jsonCreds :: Maybe a -> Value
jsonCreds Maybe a
creds =
        forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList
            [ (String -> Text
T.pack String
"logged_in", Bool -> Value
Bool forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a b. a -> b -> a
const Bool
True) Maybe a
creds)
            ]

setUltDestReferer' :: (MonadHandler m, YesodAuth (HandlerSite m)) => m ()
setUltDestReferer' :: forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
m ()
setUltDestReferer' = do
    HandlerSite m
master <- forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
getYesod
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall master. YesodAuth master => master -> Bool
redirectToReferer HandlerSite m
master) forall (m :: * -> *). MonadHandler m => m ()
setUltDestReferer

getLoginR :: AuthHandler master Html
getLoginR :: forall master. AuthHandler master Html
getLoginR = forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
m ()
setUltDestReferer' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall master. YesodAuth master => AuthHandler master Html
loginHandler

getLogoutR :: AuthHandler master ()
getLogoutR :: forall master. AuthHandler master ()
getLogoutR = do
  Route Auth -> Route master
tp <- forall (m :: * -> *).
MonadHandler m =>
m (Route (SubHandlerSite m) -> Route (HandlerSite m))
getRouteToParent
  forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
m ()
setUltDestReferer' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) url a.
(MonadHandler m, RedirectUrl (HandlerSite m) url) =>
url -> m a
redirectToPost (Route Auth -> Route master
tp Route Auth
LogoutR)

postLogoutR :: AuthHandler master ()
postLogoutR :: forall master. AuthHandler master ()
postLogoutR = forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
Bool -> m ()
clearCreds Bool
True

handlePluginR :: Text -> [Text] -> AuthHandler master TypedContent
handlePluginR :: forall master. Text -> [Text] -> AuthHandler master TypedContent
handlePluginR Text
plugin [Text]
pieces = do
    master
master <- forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
getYesod
    Request
env <- forall (m :: * -> *). MonadHandler m => m Request
waiRequest
    let method :: Text
method = OnDecodeError -> ContentType -> Text
decodeUtf8With OnDecodeError
lenientDecode forall a b. (a -> b) -> a -> b
$ Request -> ContentType
W.requestMethod Request
env
    case forall a. (a -> Bool) -> [a] -> [a]
filter (\AuthPlugin master
x -> forall master. AuthPlugin master -> Text
apName AuthPlugin master
x forall a. Eq a => a -> a -> Bool
== Text
plugin) (forall master. YesodAuth master => master -> [AuthPlugin master]
authPlugins master
master) of
        [] -> forall (m :: * -> *) a. MonadHandler m => m a
notFound
        AuthPlugin master
ap:[AuthPlugin master]
_ -> forall master.
AuthPlugin master
-> Text -> [Text] -> AuthHandler master TypedContent
apDispatch AuthPlugin master
ap Text
method [Text]
pieces

-- | Similar to 'maybeAuthId', but additionally look up the value associated
-- with the user\'s database identifier to get the value in the database. This
-- assumes that you are using a Persistent database.
--
-- @since 1.1.0
maybeAuth :: ( YesodAuthPersist master
             , val ~ AuthEntity master
             , Key val ~ AuthId master
             , PersistEntity val
             , Typeable val
             , MonadHandler m
             , HandlerSite m ~ master
             ) => m (Maybe (Entity val))
maybeAuth :: forall master val (m :: * -> *).
(YesodAuthPersist master, val ~ AuthEntity master,
 Key val ~ AuthId master, PersistEntity val, Typeable val,
 MonadHandler m, HandlerSite m ~ master) =>
m (Maybe (Entity val))
maybeAuth = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall record. Key record -> record -> Entity record
Entity)) forall master (m :: * -> *).
(YesodAuthPersist master, Typeable (AuthEntity master),
 MonadHandler m, HandlerSite m ~ master) =>
m (Maybe (AuthId master, AuthEntity master))
maybeAuthPair

-- | Similar to 'maybeAuth', but doesn’t assume that you are using a
-- Persistent database.
--
-- @since 1.4.0
maybeAuthPair
  :: ( YesodAuthPersist master
     , Typeable (AuthEntity master)
     , MonadHandler m
     , HandlerSite m ~ master
     )
  => m (Maybe (AuthId master, AuthEntity master))
maybeAuthPair :: forall master (m :: * -> *).
(YesodAuthPersist master, Typeable (AuthEntity master),
 MonadHandler m, HandlerSite m ~ master) =>
m (Maybe (AuthId master, AuthEntity master))
maybeAuthPair = forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
    AuthId master
aid <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall master (m :: * -> *).
(YesodAuth master, MonadHandler m, master ~ HandlerSite m) =>
m (Maybe (AuthId master))
maybeAuthId
    AuthEntity master
ae  <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) master.
(MonadHandler m, YesodAuthPersist master,
 Typeable (AuthEntity master), HandlerSite m ~ master) =>
AuthId master -> m (Maybe (AuthEntity master))
cachedAuth AuthId master
aid
    forall (m :: * -> *) a. Monad m => a -> m a
return (AuthId master
aid, AuthEntity master
ae)


newtype CachedMaybeAuth val = CachedMaybeAuth { forall val. CachedMaybeAuth val -> Maybe val
unCachedMaybeAuth :: Maybe val }

-- | Class which states that the given site is an instance of @YesodAuth@
-- and that its @AuthId@ is a lookup key for the full user information in
-- a @YesodPersist@ database.
--
-- The default implementation of @getAuthEntity@ assumes that the @AuthId@
-- for the @YesodAuth@ superclass is in fact a persistent @Key@ for the
-- given value.  This is the common case in Yesod, and means that you can
-- easily look up the full information on a given user.
--
-- @since 1.4.0
class (YesodAuth master, YesodPersist master) => YesodAuthPersist master where
    -- | If the @AuthId@ for a given site is a persistent ID, this will give the
    -- value for that entity. E.g.:
    --
    -- > type AuthId MySite = UserId
    -- > AuthEntity MySite ~ User
    --
    -- @since 1.2.0
    type AuthEntity master :: Type
    type AuthEntity master = KeyEntity (AuthId master)

    getAuthEntity :: (MonadHandler m, HandlerSite m ~ master)
                  => AuthId master -> m (Maybe (AuthEntity master))

    default getAuthEntity
        :: ( YesodPersistBackend master ~ backend
           , PersistRecordBackend (AuthEntity master) backend
           , Key (AuthEntity master) ~ AuthId master
           , PersistStore backend
           , MonadHandler m
           , HandlerSite m ~ master
           )
        => AuthId master -> m (Maybe (AuthEntity master))
    getAuthEntity = forall (m :: * -> *) a.
MonadHandler m =>
HandlerFor (HandlerSite m) a -> m a
liftHandler forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall site a.
YesodPersist site =>
YesodDB site a -> HandlerFor site a
runDB forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get


type family KeyEntity key
type instance KeyEntity (Key x) = x

-- | Similar to 'maybeAuthId', but redirects to a login page if user is not
-- authenticated or responds with error 401 if this is an API client (expecting JSON).
--
-- @since 1.1.0
requireAuthId :: (MonadHandler m, YesodAuth (HandlerSite m)) => m (AuthId (HandlerSite m))
requireAuthId :: forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
m (AuthId (HandlerSite m))
requireAuthId = forall master (m :: * -> *).
(YesodAuth master, MonadHandler m, master ~ HandlerSite m) =>
m (Maybe (AuthId master))
maybeAuthId forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a.
(YesodAuth (HandlerSite m), MonadHandler m) =>
m a
handleAuthLack forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Similar to 'maybeAuth', but redirects to a login page if user is not
-- authenticated or responds with error 401 if this is an API client (expecting JSON).
--
-- @since 1.1.0
requireAuth :: ( YesodAuthPersist master
               , val ~ AuthEntity master
               , Key val ~ AuthId master
               , PersistEntity val
               , Typeable val
               , MonadHandler m
               , HandlerSite m ~ master
               ) => m (Entity val)
requireAuth :: forall master val (m :: * -> *).
(YesodAuthPersist master, val ~ AuthEntity master,
 Key val ~ AuthId master, PersistEntity val, Typeable val,
 MonadHandler m, HandlerSite m ~ master) =>
m (Entity val)
requireAuth = forall master val (m :: * -> *).
(YesodAuthPersist master, val ~ AuthEntity master,
 Key val ~ AuthId master, PersistEntity val, Typeable val,
 MonadHandler m, HandlerSite m ~ master) =>
m (Maybe (Entity val))
maybeAuth forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a.
(YesodAuth (HandlerSite m), MonadHandler m) =>
m a
handleAuthLack forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Similar to 'requireAuth', but not tied to Persistent's 'Entity' type.
-- Instead, the 'AuthId' and 'AuthEntity' are returned in a tuple.
--
-- @since 1.4.0
requireAuthPair
  :: ( YesodAuthPersist master
     , Typeable (AuthEntity master)
     , MonadHandler m
     , HandlerSite m ~ master
     )
  => m (AuthId master, AuthEntity master)
requireAuthPair :: forall master (m :: * -> *).
(YesodAuthPersist master, Typeable (AuthEntity master),
 MonadHandler m, HandlerSite m ~ master) =>
m (AuthId master, AuthEntity master)
requireAuthPair = forall master (m :: * -> *).
(YesodAuthPersist master, Typeable (AuthEntity master),
 MonadHandler m, HandlerSite m ~ master) =>
m (Maybe (AuthId master, AuthEntity master))
maybeAuthPair forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a.
(YesodAuth (HandlerSite m), MonadHandler m) =>
m a
handleAuthLack forall (m :: * -> *) a. Monad m => a -> m a
return

handleAuthLack :: (YesodAuth (HandlerSite m), MonadHandler m) => m a
handleAuthLack :: forall (m :: * -> *) a.
(YesodAuth (HandlerSite m), MonadHandler m) =>
m a
handleAuthLack = do
    Bool
aj <- forall (m :: * -> *). MonadHandler m => m Bool
acceptsJson
    if Bool
aj then forall (m :: * -> *) a. MonadHandler m => m a
notAuthenticated else forall (m :: * -> *) a.
(YesodAuth (HandlerSite m), MonadHandler m) =>
m a
redirectLogin

redirectLogin :: (YesodAuth (HandlerSite m), MonadHandler m) => m a
redirectLogin :: forall (m :: * -> *) a.
(YesodAuth (HandlerSite m), MonadHandler m) =>
m a
redirectLogin = do
    HandlerSite m
y <- forall (m :: * -> *). MonadHandler m => m (HandlerSite m)
getYesod
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall master. YesodAuth master => master -> Bool
redirectToCurrent HandlerSite m
y) forall (m :: * -> *). MonadHandler m => m ()
setUltDestCurrent
    case forall site. Yesod site => site -> Maybe (Route site)
authRoute HandlerSite m
y of
        Just Route (HandlerSite m)
z -> forall (m :: * -> *) url a.
(MonadHandler m, RedirectUrl (HandlerSite m) url) =>
url -> m a
redirect Route (HandlerSite m)
z
        Maybe (Route (HandlerSite m))
Nothing -> forall (m :: * -> *) a. MonadHandler m => Text -> m a
permissionDenied Text
"Please configure authRoute"

instance YesodAuth master => RenderMessage master AuthMessage where
    renderMessage :: master -> [Text] -> AuthMessage -> Text
renderMessage = forall master.
YesodAuth master =>
master -> [Text] -> AuthMessage -> Text
renderAuthMessage

data AuthException = InvalidFacebookResponse
    deriving Int -> AuthException -> ShowS
[AuthException] -> ShowS
AuthException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthException] -> ShowS
$cshowList :: [AuthException] -> ShowS
show :: AuthException -> String
$cshow :: AuthException -> String
showsPrec :: Int -> AuthException -> ShowS
$cshowsPrec :: Int -> AuthException -> ShowS
Show
instance Exception AuthException

instance YesodAuth master => YesodSubDispatch Auth master where
    yesodSubDispatch :: YesodSubRunnerEnv Auth master -> Application
yesodSubDispatch = $(mkYesodSubDispatch resourcesAuth)

asHtml :: Html -> Html
asHtml :: Html -> Html
asHtml = forall a. a -> a
id