diff --git a/yesod-auth/Yesod/Auth/Hardcoded.hs b/yesod-auth/Yesod/Auth/Hardcoded.hs new file mode 100644 index 00000000..2e90645d --- /dev/null +++ b/yesod-auth/Yesod/Auth/Hardcoded.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +module Yesod.Auth.Hardcoded + ( YesodAuthHardcoded(..) + , authHardcoded + , loginR ) + where + +import Yesod.Auth (Auth, AuthPlugin (..), AuthRoute, + Creds (..), Route (..), YesodAuth, + loginErrorMessageI, setCredsRedirect) +import qualified Yesod.Auth.Message as Msg +import Yesod.Core +import Yesod.Form (ireq, runInputPost, textField) + +import Control.Applicative ((<$>), (<*>)) +import Data.Text (Text) + + +loginR :: AuthRoute +loginR = PluginR "hardcoded" ["login"] + +class (YesodAuth site) => YesodAuthHardcoded site where + + -- | Check whether given user name exists among hardcoded names. + doesUserNameExist :: Text -> HandlerT site IO Bool + + -- | Validate given user name with given password. + validatePassword :: Text -> Text -> HandlerT site IO Bool + + +authHardcoded :: YesodAuthHardcoded m => AuthPlugin m +authHardcoded = + AuthPlugin "hardcoded" dispatch loginWidget + where + dispatch "POST" ["login"] = postLoginR >>= sendResponse + dispatch _ _ = notFound + loginWidget toMaster = + [whamlet| + $newline never +