From 69d5795eedd72ecc68cf29e91f6d18182c51fb49 Mon Sep 17 00:00:00 2001
From: Jack Wines <jack@winesj.com>
Date: Fri, 16 Jun 2023 20:22:31 -0700
Subject: [PATCH] fail on >100 input lengths

This is already limited by <input> on frontend so it only happens if the user
deliberately crafts a malicious request
---
 src/Error.hs |  3 +++
 src/Main.hs  | 14 ++++++++++++--
 2 files changed, 15 insertions(+), 2 deletions(-)

diff --git a/src/Error.hs b/src/Error.hs
index 02ec9ad..a08f949 100644
--- a/src/Error.hs
+++ b/src/Error.hs
@@ -13,3 +13,6 @@ badPollId = throwError . withReason err400 . T.append "not a valid id: " . T.pac
 
 noPollFound :: P.PollId -> AppM a
 noPollFound = throwError . withReason err404 . T.append "invalid id, no poll with id: " . T.pack . show
+
+nameTooLong :: AppM a
+nameTooLong = throwError . withReason err400 $ "poll field was too long"
diff --git a/src/Main.hs b/src/Main.hs
index 81db7a1..8e5b3a2 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -34,6 +34,11 @@ import qualified Network.HTTP.Types.Status as TS
 import LucidUtils
 import qualified Data.Text.Lazy as TL
 
+checkLength :: T.Text -> AppM ()
+checkLength txt
+  | (T.length txt) <= 100 = pure ()
+  | otherwise = Er.nameTooLong
+
 throwOrLift :: AppM a -> Maybe a -> AppM a
 throwOrLift err = My.maybe err pure
 
@@ -86,9 +91,9 @@ nthPlaces =
   with span_ [classes_ ["third-place",  "badge"]] "3rd"]
     ++ map (\n -> with span_ [class_ "badge"] . toHtml $ T.append (T.pack . show $ n) "th") [4 :: Int ..]
 
-
 makePoll :: P.CreatePollInfo -> AppM (L.Html ())
 makePoll pollReq = do
+  checkTextLengths
   db <- Rd.asks db
   gen <- Rd.asks gen
   pollId <- P.PollId <$> R.uniformWord64 gen
@@ -97,13 +102,18 @@ makePoll pollReq = do
   pure . div_ $ do
     "done! people can fill out your poll at "
     with a_ [href_ fillOutLink] (toHtml fillOutLink)
-
+  where
+    checkTextLengths = do
+      M.mapM_ checkLength . LN.toList . P.options $ pollReq
+      checkLength . P.question $ pollReq
+      maybe (pure ()) checkLength . P.title $ pollReq
 
 toPollIdLink :: P.PollId -> T.Text
 toPollIdLink (P.PollId pollId) = T.append "https://rankedchoice.net/poll/" (T.pack . show $ pollId)
 
 vote :: P.PollId -> B.Ballot -> AppM (L.Html ())
 vote pollId ballot = do
+  M.mapM_ checkLength . B.options $ ballot
   db <- Rd.asks db
   liftIO $ Ac.update db (DB.PostBallot pollId ballot')
   pure $ with div_ [id_ "resultLink"] $ do