posts: belong to user

3v0k4 · Jul 21, 2019 · b9ed678 · b9ed678
1 parent dd46b15
commit b9ed678
Show file tree

Hide file tree

Showing 2 changed files with 11 additions and 5 deletions.
diff --git a/config/models.persistentmodels b/config/models.persistentmodels
@@ -19,3 +19,4 @@ Comment json -- Adding "json" causes ToJSON and FromJSON instances to be derived
 Post
     title Text
     text Textarea
+    userId UserId
diff --git a/src/Handler/Posts.hs b/src/Handler/Posts.hs
@@ -10,21 +10,26 @@ module Handler.Posts where
 
 import Import
 
-postForm :: Form Post
-postForm =
+postForm :: UserId -> Form Post
+postForm userId =
   renderDivs $
-    Post <$> areq textField "Title" Nothing <*> areq textareaField "Text" Nothing
+    Post <$>
+    areq textField "Title" Nothing <*>
+    areq textareaField "Text" Nothing <*>
+    areq hiddenField "" (Just userId)
 
 getPostsR :: Handler Html
 getPostsR = do
-  (widget, enctype) <- generateFormPost postForm
+  userId <- fmap fst $ requireAuthPair
+  (widget, enctype) <- generateFormPost $ postForm userId
   allPosts :: [Entity Post] <- runDB $ selectList [] [ Desc PostId ]
   emptyLayout $ do
     $(widgetFile "posts")
 
 postPostsR :: Handler Html
 postPostsR = do
-  ((result, widget), enctype) <- runFormPost postForm
+  userId <- fmap fst $ requireAuthPair
+  ((result, widget), enctype) <- runFormPost $ postForm userId
   allPosts :: [Entity Post] <- runDB $ selectList [] [ Desc PostId ]
   case result of
     FormSuccess post -> do