added optional admin credentials

This commit is contained in:
nek0 2017-06-03 02:37:22 +02:00
parent 8980d99f7e
commit 766b990ca1
9 changed files with 128 additions and 33 deletions

View file

@ -22,6 +22,8 @@ import Text.Jasmine (minifym)
import Yesod.Default.Util (addStaticContentExternal) import Yesod.Default.Util (addStaticContentExternal)
import Yesod.Core.Types (Logger) import Yesod.Core.Types (Logger)
--snip --snip
import Yesod.Auth.Hardcoded
import Yesod.Auth.Message
import qualified Data.Text as T import qualified Data.Text as T
import Network.Wai as Wai import Network.Wai as Wai
import Data.List (tail) import Data.List (tail)
@ -115,6 +117,7 @@ instance Yesod App where
defaultLayout widget = do defaultLayout widget = do
master <- getYesod master <- getYesod
mmsg <- getMessage mmsg <- getMessage
musername <- maybeAuthId
-- We break up the default layout into two components: -- We break up the default layout into two components:
-- default-layout is the contents of the body tag, and -- default-layout is the contents of the body tag, and
@ -140,9 +143,32 @@ instance Yesod App where
-- authRoute _ = Just $ AuthR LoginR -- authRoute _ = Just $ AuthR LoginR
-- Routes not requiring authentication. -- Routes not requiring authentication.
-- isAuthorized (AuthR _) _ = return Authorized isAuthorized (AuthR _) _ = return Authorized
isAuthorized FaviconR _ = return Authorized isAuthorized FaviconR _ = return Authorized
isAuthorized RobotsR _ = return Authorized isAuthorized RobotsR _ = return Authorized
-- Routes requiring authentication
isAuthorized RestockR _ = isAdmin
isAuthorized (UpstockR _) _ = isAdmin
isAuthorized NewArticleR _ = isAdmin
isAuthorized JournalR _ = isAdmin
isAuthorized (JournalPageR _) _ = isAdmin
isAuthorized PayoutR _ = isAdmin
isAuthorized SummaryR _ = isAdmin
isAuthorized SummaryJsonR _ = isAdmin
isAuthorized (ModifyR _) _ = isAdmin
isAuthorized (DeleteBeverageR _) _ = isAdmin
isAuthorized CashCheckR _ = isAdmin
isAuthorized UploadInventoryJsonR _ = isAdmin
isAuthorized InventoryJsonR _ = isAdmin
isAuthorized AvatarR _ = isAdmin
isAuthorized (ModifyAvatarR _) _ = isAdmin
isAuthorized (AvatarDeleteR _) _ = isAdmin
isAuthorized SupplierR _ = isAdmin
isAuthorized NewSupplierR _ = isAdmin
isAuthorized (SupplierActionsR _) _ = isAdmin
isAuthorized (ModifySupplierR _) _ = isAdmin
isAuthorized (SupplierDigestR _) _ = isAdmin
isAuthorized (DeleteSupplierR _) _ = isAdmin
-- Default to Authorized for now. -- Default to Authorized for now.
isAuthorized _ _ = return Authorized isAuthorized _ _ = return Authorized
@ -174,6 +200,13 @@ instance Yesod App where
makeLogger = return . appLogger makeLogger = return . appLogger
isAdmin :: YesodAuth master => HandlerT master IO AuthResult
isAdmin = do
mu <- maybeAuthId
return $ case mu of
Nothing -> AuthenticationRequired
Just _ -> Authorized
-- How to run database actions. -- How to run database actions.
instance YesodPersist App where instance YesodPersist App where
type YesodPersistBackend App = SqlBackend type YesodPersistBackend App = SqlBackend
@ -183,30 +216,58 @@ instance YesodPersist App where
instance YesodPersistRunner App where instance YesodPersistRunner App where
getDBRunner = defaultGetDBRunner appConnPool getDBRunner = defaultGetDBRunner appConnPool
-- instance YesodAuth App where instance YesodAuth App where
-- type AuthId App = UserId type AuthId App = Text
-- -- Where to send a user after successful login -- Where to send a user after successful login
-- loginDest _ = HomeR loginDest _ = HomeR
-- -- Where to send a user after logout -- Where to send a user after logout
-- logoutDest _ = HomeR logoutDest _ = HomeR
-- -- Override the above two destinations when a Referer: header is present -- Override the above two destinations when a Referer: header is present
-- redirectToReferer _ = True redirectToReferer _ = True
-- getAuthId creds = runDB $ do -- getAuthId = return . Just . credsIdent
-- x <- getBy $ UniqueUser $ credsIdent creds
-- case x of
-- Just (Entity uid _) -> return $ Just uid
-- Nothing -> do
-- fmap Just $ insert User
-- { userIdent = credsIdent creds
-- , userPassword = Nothing
-- }
-- -- You can add other plugins like BrowserID, email or OAuth here -- getAuthId creds = runDB $ do
-- authPlugins _ = [authBrowserId def] -- x <- getBy $ UniqueUser $ credsIdent creds
-- case x of
-- Just (Entity uid _) -> return $ Just uid
-- Nothing -> do
-- fmap Just $ insert User
-- { userIdent = credsIdent creds
-- , userPassword = Nothing
-- }
-- authHttpManager = getHttpManager authenticate Creds{..} = do
settings <- getsYesod appSettings
maybe (return $ Authenticated "nobody") (\login ->
if loginName login == credsIdent
then return (Authenticated credsIdent)
else return (UserError InvalidLogin)
) (appAdminCreds settings)
-- You can add other plugins like BrowserID, email or OAuth here
authPlugins _ = [authHardcoded]
authHttpManager = getHttpManager
maybeAuthId = do
settings <- getsYesod appSettings
maybe (return $ Just "nobody")
(const $ lookupSession credsKey)
(appAdminCreds settings)
instance YesodAuthHardcoded App where
validatePassword u p = do
settings <- getsYesod appSettings
maybe (return True) (\login ->
return (u == loginName login && p == loginPass login)
) (appAdminCreds settings)
doesUserNameExist u = do
settings <- getsYesod appSettings
let name = fromMaybe "nobody" $ loginName <$> appAdminCreds settings
return (u == name)
-- instance YesodAuthPersist App -- instance YesodAuthPersist App

View file

@ -34,8 +34,10 @@ import Import
-- runtime dependency, and for efficiency. -- runtime dependency, and for efficiency.
getFaviconR :: Handler TypedContent getFaviconR :: Handler TypedContent
getFaviconR = return $ TypedContent "image/x-icon" getFaviconR = do
$ toContent $(embedFile "config/favicon.ico") cacheSeconds $ 60 * 60 * 24 * 30 -- cache for a month
return $ TypedContent "image/x-icon"
$ toContent $(embedFile "config/favicon.ico")
getRobotsR :: Handler TypedContent getRobotsR :: Handler TypedContent
getRobotsR = return $ TypedContent typePlain getRobotsR = return $ TypedContent typePlain

View file

@ -76,8 +76,20 @@ data AppSettings = AppSettings
, appCopyright :: Text , appCopyright :: Text
, appCopyrightLink :: Text , appCopyrightLink :: Text
-- ^ Text and link to source -- ^ Text and link to source
, appAdminCreds :: Maybe Login
} }
data Login = Login
{ loginName :: Text
, loginPass :: Text
}
instance FromJSON Login where
parseJSON = withObject "Login" $ \o -> do
loginName <- o .: "login"
loginPass <- o .: "password"
return Login{..}
instance FromJSON AppSettings where instance FromJSON AppSettings where
parseJSON = withObject "AppSettings" $ \o -> do parseJSON = withObject "AppSettings" $ \o -> do
let defaultDev = let defaultDev =
@ -106,6 +118,8 @@ instance FromJSON AppSettings where
appCopyright <- o .: "copyright" appCopyright <- o .: "copyright"
appCopyrightLink <- o .: "copyright_link" appCopyrightLink <- o .: "copyright_link"
appAdminCreds <- o .:? "credentials"
return AppSettings {..} return AppSettings {..}
-- | Settings for 'widgetFile', such as which template languages to support and -- | Settings for 'widgetFile', such as which template languages to support and

View file

@ -1,3 +1,4 @@
/auth AuthR Auth getAuth
/static StaticR Static appStatic /static StaticR Static appStatic
/favicon.ico FaviconR GET /favicon.ico FaviconR GET

View file

@ -32,3 +32,7 @@ cash_charge: 50
copyright: "Powered by YAMMAT" copyright: "Powered by YAMMAT"
copyright_link: "https://github.com/nek0/yammat" copyright_link: "https://github.com/nek0/yammat"
# credentials:
# login: "admin"
# password: "password"

View file

@ -143,3 +143,5 @@ CustomerId: Kód zákazníka
TotalCrates: Celkový počet přepravek TotalCrates: Celkový počet přepravek
Modify: upravit Modify: upravit
UserIdentNotUnique: Uživatelské jméno není jedinečný UserIdentNotUnique: Uživatelské jméno není jedinečný
Login: Přihlásit
Logout: Odhlásit

View file

@ -143,3 +143,5 @@ CustomerId: Kundennummer
TotalCrates: Gesamtanzahl Kästen TotalCrates: Gesamtanzahl Kästen
Modify: bearbeiten Modify: bearbeiten
UserIdentNotUnique: Benutzername ist nicht einzigartig UserIdentNotUnique: Benutzername ist nicht einzigartig
Login: Login
Logout: Logout

View file

@ -143,3 +143,5 @@ CustomerId: Customer id
TotalCrates: Total crates TotalCrates: Total crates
Modify: modify Modify: modify
UserIdentNotUnique: Username is not unique UserIdentNotUnique: Username is not unique
Login: Login
Logout: Logout

View file

@ -26,15 +26,22 @@
<hr> <hr>
<footer> <footer>
<span> $maybe username <- musername
<a href=@{RestockR}>_{MsgRestock} <span>
<span> <a href=@{RestockR}>_{MsgRestock}
<a href=@{JournalR}>_{MsgJournal} <span>
<span> <a href=@{JournalR}>_{MsgJournal}
<a href=@{SummaryR}>_{MsgSummary} <span>
<span> <a href=@{SummaryR}>_{MsgSummary}
<a href=@{AvatarR}>_{MsgAvatars} <span>
<span> <a href=@{AvatarR}>_{MsgAvatars}
<a href=@{SupplierR}>_{MsgSuppliers} <span>
<a href=@{SupplierR}>_{MsgSuppliers}
$if username /= "nobody"
<span>
<a href=@{AuthR LogoutR}>_{MsgLogout}
$nothing
<span>
<a href=@{AuthR LoginR}>_{MsgLogin}
<div .right> <div .right>
^{pageBody copyrightWidget} ^{pageBody copyrightWidget}