aboutsummaryrefslogtreecommitdiff
path: root/server/lib/Uplcg/Main
diff options
context:
space:
mode:
authorJasper Van der Jeugt2020-08-23 12:30:59 +0200
committerJasper Van der Jeugt2020-08-23 12:30:59 +0200
commitbea39f31ff13e0cd039d024e2708c1405429abf9 (patch)
tree6e92189b84ccda84dd68d2d5b250f5986dcda820 /server/lib/Uplcg/Main
parent963c135da14cf1be5d09368ab6e19b4907779ac9 (diff)
Show errors on same page
Diffstat (limited to 'server/lib/Uplcg/Main')
-rw-r--r--server/lib/Uplcg/Main/Server.hs46
1 files changed, 29 insertions, 17 deletions
diff --git a/server/lib/Uplcg/Main/Server.hs b/server/lib/Uplcg/Main/Server.hs
index 4a3829b..c0849fd 100644
--- a/server/lib/Uplcg/Main/Server.hs
+++ b/server/lib/Uplcg/Main/Server.hs
@@ -29,6 +29,7 @@ import qualified Data.Text.Lazy as TL
import Data.Traversable (for)
import qualified Network.HTTP.Types.Status as HttpStatus
import qualified Network.HTTP.Types.URI as HttpUri
+import qualified Network.HTTP.Types.Method as HttpMethod
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp
import qualified Network.Wai.Handler.WebSockets as WaiWs
@@ -79,9 +80,9 @@ newRoom rid rpw cards gen = Room rid rpw
parseRoomId :: T.Text -> Either String RoomId
parseRoomId txt
- | not (T.all isAlphaNum txt) = Left "RoomId: alphanum characters only"
- | l < 6 = Left "RoomId: minimum length of 6"
- | l > 32 = Left "RoomId: maximum length of 32"
+ | not (T.all isAlphaNum txt) = Left "please use alphanum characters only"
+ | l < 1 = Left "minimum length of 1"
+ | l > 32 = Left "maximum length of 32"
| otherwise = Right $ RoomId txt
where
l = T.length txt
@@ -139,22 +140,33 @@ scottyApp :: Server -> IO Wai.Application
scottyApp server = Scotty.scottyApp $ do
Scotty.get "/" $ Scotty.redirect $ "/rooms"
- Scotty.get "/rooms" $ do
+ Scotty.matchAny "/rooms" $ do
views <- liftIO $ roomViews server
let decks = HMS.keys $ serverCards server
- Scotty.html . renderHtml $ Views.rooms views decks
-
- Scotty.post "/rooms" $ do
- rid <- getParam "id"
- rpw <- getParam "password"
- cards <- getParam "deck"
- _ <- liftIO $ createRoom server rid rpw cards
- Scotty.redirect $ TL.fromStrict $
- "/rooms/" <> unRoomId rid <>
- case rpw of
- NoRoomPassword -> ""
- RoomPassword pwd -> T.decodeUtf8 $ HttpUri.renderQuery True
- [("password", Just $ T.encodeUtf8 pwd)]
+
+ method <- Wai.requestMethod <$> Scotty.request
+ mbCreatedRoom <- if method == HttpMethod.methodPost
+ then flip Scotty.rescue (pure . Just . Left) $ do
+ rid <- getParam "id"
+ rpw <- getParam "password"
+ cards <- getParam "deck"
+ liftIO $ Just . Right <$> createRoom server rid rpw cards
+ else do
+ pure Nothing
+
+ case mbCreatedRoom of
+ Nothing -> do
+ Scotty.html . renderHtml $ Views.rooms views decks Nothing
+ Just (Left err) -> do
+ Scotty.status HttpStatus.badRequest400
+ Scotty.html . renderHtml . Views.rooms views decks .
+ Just $ TL.unpack err
+ Just (Right r) -> Scotty.redirect $ TL.fromStrict $
+ "/rooms/" <> unRoomId (roomId r) <>
+ case roomPassword r of
+ NoRoomPassword -> ""
+ RoomPassword pwd -> T.decodeUtf8 $ HttpUri.renderQuery True
+ [("password", Just $ T.encodeUtf8 pwd)]
Scotty.get "/rooms/:id" $ do
rid@(RoomId ridt) <- getParam "id"