test5

frameworks/Haskell/spock/src/Main.hs

@@ -29,8 +29,7 @@ creds =
 
 
 dbConn :: PoolOrConn PG.Connection
-dbConn =
-  PCConn (ConnBuilder (PG.connect creds) PG.close (PoolCfg 5 5 60))
+dbConn = PCConn (ConnBuilder (PG.connect creds) PG.close (PoolCfg 5 5 60))
 
 
 blaze :: MonadIO m => H.Html -> ActionCtxT ctx m a
@@ -73,7 +72,11 @@ test4 = do
 
 -- | Test 5: Database Updates
 test5 :: ActionCtxT ctx (WebStateM PG.Connection b ()) a
-test5 = undefined
+test5 = do
+    queries <- max 1 . min 500 <$> param' "queries"
+    worlds <- runQuery $ fetchRandomWorldsAsync queries
+    updatedWorlds <- runQuery $ updateWorldsRandomAsync worlds
+    json updatedWorlds
 {-# INLINE test5 #-}
 
 -- | Test 6: Plain text

frameworks/Haskell/spock/src/Models/World.hs

@@ -5,6 +5,7 @@ module Models.World
     , fetchWorldById
     , getRandomWorld
     , fetchRandomWorldsAsync
+    , updateWorldsRandomAsync
     ) where
 
 import           Control.Concurrent.Async
@@ -36,7 +37,7 @@ instance FromRow World where
 fetchWorldById :: Int -> PG.Connection -> IO (Maybe World)
 fetchWorldById i c =
     listToMaybe <$> PG.query c
-        "SELECT id, randomNumber FROM World WHERE id = (?)"
+        "SELECT id, randomNumber FROM World WHERE id = ?"
         (PG.Only i)
 
 -- | Get a random World from the database. For the tests
@@ -51,3 +52,15 @@ fetchRandomWorldsAsync :: Int -> PG.Connection -> IO [World]
 fetchRandomWorldsAsync n c = do
     maybes <- mapConcurrently (\_ -> getRandomWorld c) [1..n]
     return $ catMaybes maybes
+
+-- | Update a World with a random number
+updateWorldRandom :: PG.Connection -> World -> IO World
+updateWorldRandom c (World _id _) = do
+    i <- randomRIO (1, 10000)
+    _ <- PG.execute c "UPDATE World SET randomNumber = ? WHERE id = ?" (i, _id)
+    return $ World _id i
+
+-- | Update a bunch of Worlds in a concurrent way.
+updateWorldsRandomAsync :: [World] -> PG.Connection -> IO [World]
+updateWorldsRandomAsync ws c =
+    mapConcurrently (updateWorldRandom c) ws