yogsototh/aggreact
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fixed comment POST

Browse source
This commit is contained in:
Yann Esposito (Yogsototh) 2018-12-23 23:37:19 +01:00
parent 372293ff3f
commit 8c87c7a1df
Signed by untrusted user who does not match committer: yogsototh
GPG key ID: 7B19A4C650D59646
1 changed files with 12 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
src/Aggreact/Comments.hs
View file

@ -168,9 +168,11 @@ instance ToJSON NewComment where
instance FormI.FromHttpApiData ParentId where
parseUrlPiece s = do
txt <- FormI.parseUrlPiece s
case UUID.fromText txt of
Nothing -> Left "Parent ID is not an UUID"
Just uuid -> return (ParentId (Just uuid))
if Text.null txt
then return (ParentId Nothing)
else case UUID.fromText txt of
Nothing -> Left $ "Parent ID is not an UUID (" <> txt <> ")"
Just uuid -> return (ParentId (Just uuid))
instance FormI.FromHttpApiData Slug where parseUrlPiece = fmap Slug . FormI.parseUrlPiece
instance FormI.FromHttpApiData Content where parseUrlPiece = fmap Content . FormI.parseUrlPiece
instance FormI.FromHttpApiData UserId where parseUrlPiece = fmap UserId . FormI.parseUrlPiece
@ -327,7 +329,7 @@ instance H.ToMarkup CommentPage where
H.text " for "
extlink sl sl
displayComment (commentPageComment cp) (commentPageViewTime cp) (return ())
commentForm sl "anonymous coward" (cvt cid)
commentForm sl "anonymous coward" (Just (cvt cid))
data CommentsPage =
CommentsPage
@ -346,7 +348,7 @@ instance H.ToMarkup CommentsPage where
H.h2 $ do
H.text "Comments for "
H.a ! A.href (cvt (url cp)) $ H.text (url cp)
commentForm (url cp) "anonymous coward" ""
commentForm (url cp) "anonymous coward" Nothing
H.ul $ traverse_ (showChildren (comments cp) (viewTime cp)) (IxSet.toList roots)
fromId :: Id -> UUID
@ -356,11 +358,13 @@ fromUserId (UserId x) = x
unSlug :: Slug -> Text
unSlug (Slug x) = x
commentForm :: StringConv a [Char] => a -> H.AttributeValue -> H.AttributeValue -> H.Html
commentForm slug user parent =
commentForm :: StringConv a [Char] => a -> H.AttributeValue -> (Maybe H.AttributeValue) -> H.Html
commentForm slug user mparent =
H.form ! A.action "/comments" ! A.method "post" $ do
H.input ! A.type_ "hidden" ! A.name "userid" ! A.value user
H.input ! A.type_ "hidden" ! A.name "parent" ! A.value parent
case mparent of
Just parent -> H.input ! A.type_ "hidden" ! A.name "parent" ! A.value parent
_ -> return ()
H.input ! A.type_ "hidden" ! A.name "slug" ! A.value (cvt slug)
(H.textarea ! A.name "content" ! A.rows "6" ! A.cols "60" ! A.maxlength "5000") ""
H.br