Skip to content

Instantly share code, notes, and snippets.

@connrs
Last active February 10, 2017 20:50
Show Gist options
  • Save connrs/1d06e9a03683bc749d7d72643150aff0 to your computer and use it in GitHub Desktop.
Save connrs/1d06e9a03683bc749d7d72643150aff0 to your computer and use it in GitHub Desktop.
isSuperAdminCheck (Yesod Google Group question)
isAuthorized AssetR _ = isSuperAdmin
isAuthorized HomeR _ = isAuthenticated
-- | Are you logged in?
isAuthenticated :: Handler AuthResult
isAuthenticated =
do muid <- maybeAuthId
return $
case muid of
Nothing -> Unauthorized "You must login to access this page"
Just _ -> Authorized
-- | Are you a super admin
isSuperAdmin :: Handler AuthResult
isSuperAdmin = maybeAuthId >>= isSuperAdminCheck SuperAdmin
-- | Check that the user has the required role (using Esqueleto)
isSuperAdminCheck
:: RoleType -> Maybe (Key User) -> Handler AuthResult
isSuperAdminCheck _ Nothing =
return $ Unauthorized "You need to be an administrator to access this area."
isSuperAdminCheck r (Just uid) =
runDB $
do us <-
E.select $
E.from $
\(user `E.InnerJoin` userRole) ->
do E.on $
userRole ^. UserRoleUserId E.==. user ^. UserId E.&&.
E.isNothing (userRole ^. UserRoleDeletedAt) E.&&.
userRole ^.
UserRoleRoleType E.==.
E.val r
E.where_ (user ^. UserId E.==. E.val uid)
return user
case us of
[users] -> return Authorized
_ ->
return $
Unauthorized "You need to be an administrator to access this area."
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment