Authentication and Authorization

Application/Fixtures.sql

@@ -14,20 +14,25 @@ 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', '[email protected]', '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', '[email protected]', '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', '[email protected]', '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;
 
 
 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;

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

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

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;

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

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

Web/FrontController.hs

@@ -3,18 +3,25 @@ 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
 
 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

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
+

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)

Web/View/Context.hs

@@ -10,14 +10,15 @@ 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
     createViewContext = do
         flashMessages <- IHP.Controller.Session.getAndClearFlashMessages
         let viewContext = ViewContext {
                 requestContext = ?requestContext,
-                -- user = currentUserOrNothing,
+                user = currentUserOrNothing,
                 flashMessages,
                 controllerContext = ?controllerContext,
                 layout = let ?viewContext = viewContext in defaultLayout

Web/View/Layout.hs

@@ -24,13 +24,38 @@ defaultLayout inner = H.docTypeHtml ! A.lang "en" $ [hsx|
     <title>App</title>
 </head>
 <body>
+    {navbar}
     <div class="container mt-4">
         {renderFlashMessages}
         {inner}
     </div>
 </body>
 |]
 
+navbar :: Html
+navbar = [hsx|
+<nav class="navbar navbar-expand-lg navbar-light bg-light">
+  <a class="navbar-brand" href="#">IHP Blog</a>
+  <button class="navbar-toggler" type="button" data-toggle="collapse" data-target="#navbarSupportedContent" aria-controls="navbarSupportedContent" aria-expanded="false" aria-label="Toggle navigation">
+    <span class="navbar-toggler-icon"></span>
+  </button>
+
+  <div class="collapse navbar-collapse" id="navbarSupportedContent">
+    <ul class="navbar-nav mr-auto">
+      <li class="nav-item">
+        <a class="nav-link" href={PostsAction}>Posts</a>
+      </li>
+    </ul>
+    {loginLogoutButton}
+  </div>
+</nav>
+|]
+    where
+        loginLogoutButton :: Html
+        loginLogoutButton = case (get #user viewContext) of
+            Just user -> [hsx|<a class="js-delete js-delete-no-confirm text-secondary" href={DeleteSessionAction}>Logout</a>|]
+            Nothing -> [hsx|<a class="text-secondary" href={NewSessionAction}>Login</a>|]
+
 scripts = do
     when (isDevelopment FrameworkConfig.environment) [hsx|<script id="livereload-script" src="/livereload.js"></script>|]
     [hsx|