Procházet zdrojové kódy

handling bad inputs

Jérôme Mahuet před 9 roky
rodič
revize
8d44ebc106
1 změnil soubory, kde provedl 10 přidání a 2 odebrání
  1. 10 2
      frameworks/Haskell/spock/src/Main.hs

+ 10 - 2
frameworks/Haskell/spock/src/Main.hs

@@ -6,6 +6,7 @@ module Main where
 import           Control.Monad.IO.Class
 import           Data.Aeson                    hiding (json)
 import           Data.List                     (sort)
+import           Data.Maybe                    (fromMaybe)
 import qualified Database.PostgreSQL.Simple    as PG
 import           GHC.Exts
 import           Network.HTTP.Types.Status
@@ -39,6 +40,13 @@ blaze h = do
 {-# INLINE blaze #-}
 
 
+getQueriesNumber :: MonadIO m => ActionCtxT ctx m Int
+getQueriesNumber = do
+    queriesM <- param "queries"
+    return $ max 1 . min 500 $ fromMaybe 1 queriesM
+{-# INLINE getQueriesNumber #-}
+
+
 -- | Test 1: JSON serialization
 test1 :: MonadIO m => ActionCtxT ctx m a
 test1 = do
@@ -59,7 +67,7 @@ test2 = do
 -- | Test 3: Multiple database queries
 test3 :: ActionCtxT ctx (WebStateM PG.Connection b ()) a
 test3 = do
-    queries <- max 1 . min 500 <$> param' "queries"
+    queries <- getQueriesNumber
     worlds <- runQuery $ fetchRandomWorldsAsync queries
     setHeader "Content-Type" "application/json"
     lazyBytes $ encode worlds
@@ -77,7 +85,7 @@ test4 = do
 -- | Test 5: Database Updates
 test5 :: ActionCtxT ctx (WebStateM PG.Connection b ()) a
 test5 = do
-    queries <- max 1 . min 500 <$> param' "queries"
+    queries <- getQueriesNumber
     worlds <- runQuery $ fetchRandomWorldsAsync queries
     updatedWorlds <- runQuery $ updateWorldsRandomAsync worlds
     setHeader "Content-Type" "application/json"