From d941112b1cbc4e117f1c03a40b483ce814c71672 Mon Sep 17 00:00:00 2001 From: nezbite Date: Thu, 16 Jul 2020 14:44:00 +0200 Subject: [PATCH] Authentication and Authorization --- Application/Fixtures.sql | 15 ++++++++++----- Application/Helper/Controller.hs | 6 ++++-- Application/Helper/View.hs | 3 +-- Application/Schema.sql | 15 +++++++++++++-- Web/Controller/Comments.hs | 5 +++++ Web/Controller/Posts.hs | 7 +++++++ Web/FrontController.hs | 9 ++++++++- Web/Routes.hs | 5 +++++ Web/Types.hs | 21 +++++++++++++++++++++ Web/View/Context.hs | 3 ++- Web/View/Layout.hs | 25 +++++++++++++++++++++++++ 11 files changed, 101 insertions(+), 13 deletions(-) diff --git a/Application/Fixtures.sql b/Application/Fixtures.sql index 56cce0f..bccfb2e 100644 --- a/Application/Fixtures.sql +++ b/Application/Fixtures.sql @@ -14,11 +14,18 @@ SET row_security = off; SET SESSION AUTHORIZATION DEFAULT; -ALTER TABLE public.posts DISABLE TRIGGER ALL; +ALTER TABLE public.users DISABLE TRIGGER ALL; + +INSERT INTO public.users (id, email, password_hash, locked_at, failed_login_attempts) VALUES ('9f563e7a-eaf6-4629-920c-165f6dc03562', 'daniel@digitallyinduced.com', 'sha256|17|6ok5wosHG4fndz8PVOqQmQ==|bL11xiCmLx5ZePdf3MoPgb6keGgHacZEX3e4V2qOJx8=', NULL, 0); +INSERT INTO public.users (id, email, password_hash, locked_at, failed_login_attempts) VALUES ('2d78bb96-342c-4413-8d88-a8e321e08f53', 'daniel@digitallyinduced.com', 'sha256|17|9H9HhisEo6NYc6naoENeLw==|yHolD2GGPKnqRTGRH4LAb97IKXnQ2sAjQD8Etm73kTU=', NULL, 0); +INSERT INTO public.users (id, email, password_hash, locked_at, failed_login_attempts) VALUES ('9c3253cc-8bfe-44d5-a2bd-71d68541fbc9', 'daniel@digitallyinduced.com', 'sha256|17|PHrQu9flAGbENBwm+mZyqA==|XVlBvsI9eotjPii+OEmtUmDYli2zKhgoZKBW3GKZXn4=', NULL, 0); + -INSERT INTO public.posts (id, title, body, created_at) VALUES ('4ef48ade-e7f0-4afb-b4d9-5d4d1f7b9b86', 'Hello World!', 'Lorem ipsum *dolor sit amet*, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam. **This is the IHP Blog Demo App**. +ALTER TABLE public.users ENABLE TRIGGER ALL; + + +ALTER TABLE public.posts DISABLE TRIGGER ALL; -Lorem ipsum *dolor sit amet*, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam', '2020-06-07 13:10:04.340407+02'); ALTER TABLE public.posts ENABLE TRIGGER ALL; @@ -26,8 +33,6 @@ ALTER TABLE public.posts ENABLE TRIGGER ALL; ALTER TABLE public.comments DISABLE TRIGGER ALL; -INSERT INTO public.comments (id, post_id, author, body, created_at) VALUES ('1de9007a-b690-4f2d-a76e-d08cc7d8e308', '4ef48ade-e7f0-4afb-b4d9-5d4d1f7b9b86', 'Marc', 'This is the first comment!', '2020-06-07 13:11:22.07897+02'); -INSERT INTO public.comments (id, post_id, author, body, created_at) VALUES ('7386928d-a6fc-4f20-ada9-333c32345453', '4ef48ade-e7f0-4afb-b4d9-5d4d1f7b9b86', 'Marc', 'This is a second comment!', '2020-06-07 13:11:30.718887+02'); ALTER TABLE public.comments ENABLE TRIGGER ALL; diff --git a/Application/Helper/Controller.hs b/Application/Helper/Controller.hs index 01de194..19f412e 100644 --- a/Application/Helper/Controller.hs +++ b/Application/Helper/Controller.hs @@ -5,5 +5,7 @@ module Application.Helper.Controller ( -- Here you can add functions which are available in all your controllers --- To use the built in login: --- import IHP.LoginSupport.Helper.Controller +import IHP.LoginSupport.Helper.Controller +import Generated.Types + +type instance CurrentUserRecord = User \ No newline at end of file diff --git a/Application/Helper/View.hs b/Application/Helper/View.hs index 01f871a..daf669f 100644 --- a/Application/Helper/View.hs +++ b/Application/Helper/View.hs @@ -5,5 +5,4 @@ module Application.Helper.View ( -- Here you can add functions which are available in all your views --- To use the built in login: --- import IHP.LoginSupport.Helper.View +import IHP.LoginSupport.Helper.View \ No newline at end of file diff --git a/Application/Schema.sql b/Application/Schema.sql index a87c569..ce30756 100644 --- a/Application/Schema.sql +++ b/Application/Schema.sql @@ -3,13 +3,24 @@ CREATE TABLE posts ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, title TEXT NOT NULL, body TEXT NOT NULL, - created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL + created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL, + user_id UUID NOT NULL ); CREATE TABLE comments ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, post_id UUID NOT NULL, author TEXT NOT NULL, body TEXT NOT NULL, - created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL + created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL, + user_id UUID NOT NULL ); +CREATE TABLE users ( + id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, + email TEXT NOT NULL, + password_hash TEXT NOT NULL, + locked_at TIMESTAMP WITH TIME ZONE DEFAULT NULL, + failed_login_attempts INT DEFAULT 0 NOT NULL +); +ALTER TABLE comments ADD CONSTRAINT comments_ref_user_id FOREIGN KEY (user_id) REFERENCES users (id) ON DELETE NO ACTION; +ALTER TABLE posts ADD CONSTRAINT posts_ref_user_id FOREIGN KEY (user_id) REFERENCES users (id) ON DELETE NO ACTION; ALTER TABLE comments ADD CONSTRAINT comments_ref_post_id FOREIGN KEY (post_id) REFERENCES posts (id) ON DELETE CASCADE; diff --git a/Web/Controller/Comments.hs b/Web/Controller/Comments.hs index 07a6719..5d8b2cf 100644 --- a/Web/Controller/Comments.hs +++ b/Web/Controller/Comments.hs @@ -5,6 +5,8 @@ import Web.View.Comments.Index import Web.View.Comments.New import Web.View.Comments.Edit import Web.View.Comments.Show +import IHP.AuthSupport.Authorization +import IHP.LoginSupport.Helper.Controller instance Controller CommentsController where action CommentsAction = do @@ -23,6 +25,7 @@ instance Controller CommentsController where action EditCommentAction { commentId } = do comment <- fetch commentId + accessDeniedUnless (get #userId comment == currentUserId) render EditView { .. } action UpdateCommentAction { commentId } = do @@ -40,6 +43,7 @@ instance Controller CommentsController where let comment = newRecord @Comment comment |> buildComment + |> set #userId (currentUserId) |> ifValid \case Left comment -> do post <- fetch (get #postId comment) @@ -51,6 +55,7 @@ instance Controller CommentsController where action DeleteCommentAction { commentId } = do comment <- fetch commentId + accessDeniedUnless (get #userId comment == currentUserId) deleteRecord comment setSuccessMessage "Comment deleted" redirectTo CommentsAction diff --git a/Web/Controller/Posts.hs b/Web/Controller/Posts.hs index 4713962..aca588a 100644 --- a/Web/Controller/Posts.hs +++ b/Web/Controller/Posts.hs @@ -6,8 +6,12 @@ import Web.View.Posts.New import Web.View.Posts.Edit import Web.View.Posts.Show import qualified Text.MMark as MMark +import IHP.LoginSupport.Helper.Controller +import IHP.AuthSupport.Authorization instance Controller PostsController where + beforeAction = ensureIsUser + action PostsAction = do posts <- query @Post |> orderByDesc #createdAt @@ -26,6 +30,7 @@ instance Controller PostsController where action EditPostAction { postId } = do post <- fetch postId + accessDeniedUnless (get #userId post == currentUserId) render EditView { .. } action UpdatePostAction { postId } = do @@ -43,6 +48,7 @@ instance Controller PostsController where let post = newRecord @Post post |> buildPost + |> set #userId (currentUserId) |> ifValid \case Left post -> render NewView { .. } Right post -> do @@ -52,6 +58,7 @@ instance Controller PostsController where action DeletePostAction { postId } = do post <- fetch postId + accessDeniedUnless (get #userId post == currentUserId) deleteRecord post setSuccessMessage "Post deleted" redirectTo PostsAction diff --git a/Web/FrontController.hs b/Web/FrontController.hs index fe028f3..9569bed 100644 --- a/Web/FrontController.hs +++ b/Web/FrontController.hs @@ -3,8 +3,11 @@ import IHP.RouterPrelude import IHP.ControllerSupport import Generated.Types import Web.Types +import IHP.LoginSupport.Middleware +import Web.Controller.Sessions -- Controller Imports +import Web.Controller.Users import Web.Controller.Comments import Web.Controller.Posts import IHP.Welcome.Controller @@ -12,9 +15,13 @@ import IHP.Welcome.Controller instance FrontController WebApplication where controllers = [ startPage WelcomeAction + , parseRoute @SessionsController -- Generator Marker + , parseRoute @UsersController , parseRoute @CommentsController , parseRoute @PostsController ] -instance InitControllerContext WebApplication +instance InitControllerContext WebApplication where + initContext = + initAuthentication @User \ No newline at end of file diff --git a/Web/Routes.hs b/Web/Routes.hs index c611356..0799f55 100644 --- a/Web/Routes.hs +++ b/Web/Routes.hs @@ -10,3 +10,8 @@ type instance ModelControllerMap WebApplication Post = PostsController instance AutoRoute CommentsController type instance ModelControllerMap WebApplication Comment = CommentsController +instance AutoRoute SessionsController + +instance AutoRoute UsersController +type instance ModelControllerMap WebApplication User = UsersController + diff --git a/Web/Types.hs b/Web/Types.hs index 0f02608..82d226e 100644 --- a/Web/Types.hs +++ b/Web/Types.hs @@ -6,6 +6,10 @@ import IHP.ModelSupport import Application.Helper.Controller import IHP.ViewSupport import Generated.Types +import IHP.LoginSupport.Types + +instance HasNewSessionUrl User where + newSessionUrl _ = "/NewSession" data WebApplication = WebApplication deriving (Eq, Show) @@ -14,6 +18,7 @@ data ViewContext = ViewContext , flashMessages :: [IHP.Controller.Session.FlashMessage] , controllerContext :: ControllerSupport.ControllerContext , layout :: Layout + , user :: Maybe User } data PostsController @@ -35,3 +40,19 @@ data CommentsController | UpdateCommentAction { commentId :: !(Id Comment) } | DeleteCommentAction { commentId :: !(Id Comment) } deriving (Eq, Show, Data) + +data SessionsController + = NewSessionAction + | CreateSessionAction + | DeleteSessionAction + deriving (Eq, Show, Data) + +data UsersController + = UsersAction + | NewUserAction + | ShowUserAction { userId :: !(Id User) } + | CreateUserAction + | EditUserAction { userId :: !(Id User) } + | UpdateUserAction { userId :: !(Id User) } + | DeleteUserAction { userId :: !(Id User) } + deriving (Eq, Show, Data) diff --git a/Web/View/Context.hs b/Web/View/Context.hs index a78f707..ab50375 100644 --- a/Web/View/Context.hs +++ b/Web/View/Context.hs @@ -10,6 +10,7 @@ import Generated.Types import qualified IHP.ViewSupport as ViewSupport import Web.View.Layout import Web.Types +import IHP.LoginSupport.Helper.Controller instance ViewSupport.CreateViewContext ViewContext where type ViewApp ViewContext = WebApplication @@ -17,7 +18,7 @@ instance ViewSupport.CreateViewContext ViewContext where flashMessages <- IHP.Controller.Session.getAndClearFlashMessages let viewContext = ViewContext { requestContext = ?requestContext, - -- user = currentUserOrNothing, + user = currentUserOrNothing, flashMessages, controllerContext = ?controllerContext, layout = let ?viewContext = viewContext in defaultLayout diff --git a/Web/View/Layout.hs b/Web/View/Layout.hs index 4338959..e2364a2 100644 --- a/Web/View/Layout.hs +++ b/Web/View/Layout.hs @@ -24,6 +24,7 @@ defaultLayout inner = H.docTypeHtml ! A.lang "en" $ [hsx| App + {navbar}
{renderFlashMessages} {inner} @@ -31,6 +32,30 @@ defaultLayout inner = H.docTypeHtml ! A.lang "en" $ [hsx| |] +navbar :: Html +navbar = [hsx| + +|] + where + loginLogoutButton :: Html + loginLogoutButton = case (get #user viewContext) of + Just user -> [hsx|Logout|] + Nothing -> [hsx|Login|] + scripts = do when (isDevelopment FrameworkConfig.environment) [hsx||] [hsx|