Fix spock (#10220)

* Ignore stack build files.

* Update GHC, libs, fix breakage.

---------

Co-authored-by: Benjamin Maurer <[email protected]>

frameworks/Haskell/spock/.gitignore

@@ -0,0 +1 @@
+.stack-work

frameworks/Haskell/spock/benchmark_config.json

@@ -14,7 +14,7 @@
       "database": "Postgres",
       "framework": "Spock",
       "language": "Haskell",
-      "flavor": "GHC710",
+      "flavor": "GHC810",
       "orm": "Raw",
       "platform": "Wai",
       "webserver": "Warp",
@@ -23,7 +23,7 @@
       "display_name": "Spock",
       "notes": "",
       "versus": "",
-      "tags": ["broken"]
+      "tags": []
     }
   }]
 }

frameworks/Haskell/spock/spock.dockerfile

@@ -1,4 +1,9 @@
-FROM haskell:8.6.3
+FROM haskell:8.10.7
+
+# Fix Debian Buster repositories (moved to archive)
+RUN sed -i 's/deb.debian.org/archive.debian.org/g' /etc/apt/sources.list && \
+    sed -i 's/security.debian.org/archive.debian.org/g' /etc/apt/sources.list && \
+    sed -i '/buster-updates/d' /etc/apt/sources.list
 
 RUN apt-get update -yqq && apt-get install -yqq xz-utils make
 RUN apt-get install -yqq libpq-dev

frameworks/Haskell/spock/src/Main.hs

@@ -3,43 +3,54 @@
 
 module Main where
 
+import qualified GHC.Conc
 import           Control.Concurrent.Async
 import           Control.Monad.IO.Class
 import           Data.Aeson                    hiding (json)
 import           Data.List                     (sort)
 import           Data.Maybe                    (catMaybes, fromMaybe)
-import           Data.Pool
+import           Data.Pool                     (Pool)
+import qualified Data.Pool                     as Pool
 import qualified Database.PostgreSQL.Simple    as PG
 import           GHC.Exts
 import           Network.HTTP.Types.Status
 import           Text.Blaze.Html.Renderer.Utf8
 import qualified Text.Blaze.Html5              as H
-import           Web.Spock.Safe
+import           Web.Spock
 
 import           Models.Fortune
 import           Models.World
 import           Views.Fortune
-
-
-creds :: PG.ConnectInfo
-creds =
-    PG.ConnectInfo
-        { PG.connectHost     = "tfb-database"
-        , PG.connectPort     = 5432
-        , PG.connectUser     = "benchmarkdbuser"
-        , PG.connectPassword = "benchmarkdbpass"
-        , PG.connectDatabase = "hello_world"
-        }
-
-
-poolCfg :: PoolCfg
-poolCfg = PoolCfg 50 50 60
-
-pcconn :: ConnBuilder PG.Connection
-pcconn = ConnBuilder (PG.connect creds) PG.close poolCfg
-
-dbConn :: PoolOrConn PG.Connection
-dbConn = PCConn pcconn
+import Web.Spock.Config
+
+
+poolCfg :: Int -> PoolCfg
+poolCfg numStripes = PoolCfg
+    { pc_stripes = numStripes
+    , pc_resPerStripe = 20
+    , pc_keepOpenTime = 20
+    }
+
+
+mkPool :: PoolCfg -> IO (Pool PG.Connection)
+mkPool cfg = Pool.createPool
+            dbConnect
+            PG.close
+            (pc_stripes cfg)
+            (pc_keepOpenTime cfg)
+            (pc_resPerStripe cfg)
+
+dbConnect :: IO PG.Connection
+dbConnect = PG.connect creds
+  where
+    creds =
+        PG.ConnectInfo
+            { PG.connectHost     = "tfb-database"
+            , PG.connectPort     = 5432
+            , PG.connectUser     = "benchmarkdbuser"
+            , PG.connectPassword = "benchmarkdbpass"
+            , PG.connectDatabase = "hello_world"
+            }
 
 
 blaze :: MonadIO m => H.Html -> ActionCtxT ctx m a
@@ -77,7 +88,7 @@ test2 = do
 test3 :: Pool PG.Connection -> ActionCtxT ctx (WebStateM PG.Connection b ()) a
 test3 pool = do
     queries <- getQueriesNumber
-    worlds <- liftIO $ mapConcurrently (const (withResource pool getRandomWorld)) [1..queries]
+    worlds <- liftIO $ mapConcurrently (const (Pool.withResource pool getRandomWorld)) [1..queries]
     setHeader "Content-Type" "application/json"
     lazyBytes $ encode worlds
 {-# INLINE test3 #-}
@@ -95,8 +106,8 @@ test4 = do
 test5 :: Pool PG.Connection -> ActionCtxT ctx (WebStateM PG.Connection b ()) a
 test5 pool = do
     queries <- getQueriesNumber
-    worlds <- liftIO $ mapConcurrently (const (withResource pool getRandomWorld)) [1..queries]
-    updatedWorlds <- liftIO $ mapConcurrently (withResource pool . updateWorldRandom) (catMaybes worlds)
+    worlds <- liftIO $ mapConcurrently (const (Pool.withResource pool getRandomWorld)) [1..queries]
+    updatedWorlds <- liftIO $ mapConcurrently (Pool.withResource pool . updateWorldRandom) (catMaybes worlds)
     setHeader "Content-Type" "application/json"
     lazyBytes $ encode updatedWorlds
 {-# INLINE test5 #-}
@@ -111,10 +122,11 @@ test6 = do
 
 main :: IO ()
 main = do
-    pool <- createPool (cb_createConn pcconn) (cb_destroyConn pcconn)
-                       (pc_stripes poolCfg) (pc_keepOpenTime poolCfg)
-                       (pc_resPerStripe poolCfg)
-    runSpock 3000 $ spock (defaultSpockCfg Nothing dbConn ()) $ do
+    numCaps <- GHC.Conc.getNumCapabilities
+    let numStripes = max 1 numCaps
+    pool <- mkPool (poolCfg numStripes)
+    spockCfg <- defaultSpockCfg () (PCPool pool) ()
+    runSpock 3000 $ spock spockCfg $ do
         get "json"        test1
         get "db"          test2
         get "queries"   $ test3 pool

frameworks/Haskell/spock/stack.yaml

@@ -2,13 +2,21 @@
 # For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration/
 
 # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)
-resolver: lts-6.3
+resolver: lts-18.28
 
 # Local packages, usually specified by relative directory name
 packages:
 - '.'
 # Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)
-extra-deps: []
+extra-deps:
+  - Spock-0.14.0.0
+  - Spock-core-0.14.0.0
+  - reroute-0.6.0.0
+  - stm-containers-1.2
+  - focus-1.0.1.4
+  - stm-hamt-1.2.0.4
+  - primitive-extras-0.8
+  - primitive-unlifted-0.1.3.0
 
 # Override default flag values for local packages and extra-deps
 flags: {}

frameworks/Haskell/spock/stack.yaml.lock

@@ -0,0 +1,68 @@
+# This file was autogenerated by Stack.
+# You should not edit this file by hand.
+# For more information, please see the documentation at:
+#   https://docs.haskellstack.org/en/stable/topics/lock_files
+
+packages:
+- completed:
+    hackage: Spock-0.14.0.0@sha256:7e86ccc9e66ce0fdb84d1dcd328f852d3754c2dbfcb60d0e7e2f1cce2f32f177,3681
+    pantry-tree:
+      sha256: 6829dae9ba2492fae3e447afe13013dd863bd48fd5b8addfa74fc55d979de7b2
+      size: 1118
+  original:
+    hackage: Spock-0.14.0.0
+- completed:
+    hackage: Spock-core-0.14.0.0@sha256:386d330115cf7f82984cfbfd5190a0009b7bf6b4759acbddf2a1c05e0ef57e77,3580
+    pantry-tree:
+      sha256: 8b6ae16a663f791109b6aee858b7989239a9ecd2d58e34f098d42da93f0d3960
+      size: 1113
+  original:
+    hackage: Spock-core-0.14.0.0
+- completed:
+    hackage: reroute-0.6.0.0@sha256:43805b3fdc7ed1ba701cd10e249abc997b2291c8f374b8333bb2ea0e0d1dad0b,2382
+    pantry-tree:
+      sha256: 0a27afabb1730147d6aa0ddf5cc6368951c4625e3706cb8f5388da9739372fa3
+      size: 660
+  original:
+    hackage: reroute-0.6.0.0
+- completed:
+    hackage: stm-containers-1.2@sha256:a887f2e7692b7cf20e0b081e2d66e21076e2bd4b57016ec59c484edfa2d29397,3244
+    pantry-tree:
+      sha256: 20b1076bdb121347ccc512a67df697eed34815a8e35279b6b9a0951963b1eba2
+      size: 761
+  original:
+    hackage: stm-containers-1.2
+- completed:
+    hackage: focus-1.0.1.4@sha256:fb2da753531be62e81da10eefbb6cd91d55b60612c3bbd6d82855664347da2fd,2647
+    pantry-tree:
+      sha256: 0f76ffc78fb23e36c63e8a3e66d09d9e072bd891054adfff48b1983727d2394d
+      size: 325
+  original:
+    hackage: focus-1.0.1.4
+- completed:
+    hackage: stm-hamt-1.2.0.4@sha256:7957497c022554b7599e790696d1a3e56359ad99e5da36a251894c626ca1f60a,3970
+    pantry-tree:
+      sha256: d9a8be48da86bd4a2ba9d52ea29b9a74f1b686d439ba1bbfba04ab1a002391da
+      size: 1009
+  original:
+    hackage: stm-hamt-1.2.0.4
+- completed:
+    hackage: primitive-extras-0.8@sha256:fca0310150496867f5b9421fe1541ecda87fae17eae44885a29f9c52dd00c8ff,2963
+    pantry-tree:
+      sha256: e7c1d26202b80d1fca2ef780ec7fe76ede1275f4d9a996c6d44c08d8de1c45db
+      size: 1105
+  original:
+    hackage: primitive-extras-0.8
+- completed:
+    hackage: primitive-unlifted-0.1.3.0@sha256:a98f827740f5dcf097d885b3a47c32f4462204449620abc9d51b8c4f8619f9e6,1427
+    pantry-tree:
+      sha256: c882dca2a96b98d02b0d21875b651edb11ac67d90e736c0de7a92c410a19eb7f
+      size: 420
+  original:
+    hackage: primitive-unlifted-0.1.3.0
+snapshots:
+- completed:
+    sha256: 428ec8d5ce932190d3cbe266b9eb3c175cd81e984babf876b64019e2cbe4ea68
+    size: 590100
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/28.yaml
+  original: lts-18.28