Skip to content

Commit 8c85d6a

Browse files
cptwunderlichBenjamin Maurer
cptwunderlich
and
Benjamin Maurer
authored
Fix spock (#10220)
* Ignore stack build files. * Update GHC, libs, fix breakage. --------- Co-authored-by: Benjamin Maurer <[email protected]>
1 parent 75020f4 commit 8c85d6a

File tree

6 files changed

+129
-35
lines changed

6 files changed

+129
-35
lines changed

‎frameworks/Haskell/spock/.gitignore‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
.stack-work

‎frameworks/Haskell/spock/benchmark_config.json‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,7 @@
1414
"database": "Postgres",
1515
"framework": "Spock",
1616
"language": "Haskell",
17-
"flavor": "GHC710",
17+
"flavor": "GHC810",
1818
"orm": "Raw",
1919
"platform": "Wai",
2020
"webserver": "Warp",
@@ -23,7 +23,7 @@
2323
"display_name": "Spock",
2424
"notes": "",
2525
"versus": "",
26-
"tags": ["broken"]
26+
"tags": []
2727
}
2828
}]
2929
}

‎frameworks/Haskell/spock/spock.dockerfile‎

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,9 @@
1-
FROM haskell:8.6.3
1+
FROM haskell:8.10.7
2+
3+
# Fix Debian Buster repositories (moved to archive)
4+
RUN sed -i 's/deb.debian.org/archive.debian.org/g' /etc/apt/sources.list && \
5+
sed -i 's/security.debian.org/archive.debian.org/g' /etc/apt/sources.list && \
6+
sed -i '/buster-updates/d' /etc/apt/sources.list
27

38
RUN apt-get update -yqq && apt-get install -yqq xz-utils make
49
RUN apt-get install -yqq libpq-dev

‎frameworks/Haskell/spock/src/Main.hs‎

Lines changed: 42 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -3,43 +3,54 @@
33

44
module Main where
55

6+
import qualified GHC.Conc
67
import Control.Concurrent.Async
78
import Control.Monad.IO.Class
89
import Data.Aeson hiding (json)
910
import Data.List (sort)
1011
import Data.Maybe (catMaybes, fromMaybe)
11-
import Data.Pool
12+
import Data.Pool (Pool)
13+
import qualified Data.Pool as Pool
1214
import qualified Database.PostgreSQL.Simple as PG
1315
import GHC.Exts
1416
import Network.HTTP.Types.Status
1517
import Text.Blaze.Html.Renderer.Utf8
1618
import qualified Text.Blaze.Html5 as H
17-
import Web.Spock.Safe
19+
import Web.Spock
1820

1921
import Models.Fortune
2022
import Models.World
2123
import Views.Fortune
22-
23-
24-
creds :: PG.ConnectInfo
25-
creds =
26-
PG.ConnectInfo
27-
{ PG.connectHost = "tfb-database"
28-
, PG.connectPort = 5432
29-
, PG.connectUser = "benchmarkdbuser"
30-
, PG.connectPassword = "benchmarkdbpass"
31-
, PG.connectDatabase = "hello_world"
32-
}
33-
34-
35-
poolCfg :: PoolCfg
36-
poolCfg = PoolCfg 50 50 60
37-
38-
pcconn :: ConnBuilder PG.Connection
39-
pcconn = ConnBuilder (PG.connect creds) PG.close poolCfg
40-
41-
dbConn :: PoolOrConn PG.Connection
42-
dbConn = PCConn pcconn
24+
import Web.Spock.Config
25+
26+
27+
poolCfg :: Int -> PoolCfg
28+
poolCfg numStripes = PoolCfg
29+
{ pc_stripes = numStripes
30+
, pc_resPerStripe = 20
31+
, pc_keepOpenTime = 20
32+
}
33+
34+
35+
mkPool :: PoolCfg -> IO (Pool PG.Connection)
36+
mkPool cfg = Pool.createPool
37+
dbConnect
38+
PG.close
39+
(pc_stripes cfg)
40+
(pc_keepOpenTime cfg)
41+
(pc_resPerStripe cfg)
42+
43+
dbConnect :: IO PG.Connection
44+
dbConnect = PG.connect creds
45+
where
46+
creds =
47+
PG.ConnectInfo
48+
{ PG.connectHost = "tfb-database"
49+
, PG.connectPort = 5432
50+
, PG.connectUser = "benchmarkdbuser"
51+
, PG.connectPassword = "benchmarkdbpass"
52+
, PG.connectDatabase = "hello_world"
53+
}
4354

4455

4556
blaze :: MonadIO m => H.Html -> ActionCtxT ctx m a
@@ -77,7 +88,7 @@ test2 = do
7788
test3 :: Pool PG.Connection -> ActionCtxT ctx (WebStateM PG.Connection b ()) a
7889
test3 pool = do
7990
queries <- getQueriesNumber
80-
worlds <- liftIO $ mapConcurrently (const (withResource pool getRandomWorld)) [1..queries]
91+
worlds <- liftIO $ mapConcurrently (const (Pool.withResource pool getRandomWorld)) [1..queries]
8192
setHeader "Content-Type" "application/json"
8293
lazyBytes $ encode worlds
8394
{-# INLINE test3 #-}
@@ -95,8 +106,8 @@ test4 = do
95106
test5 :: Pool PG.Connection -> ActionCtxT ctx (WebStateM PG.Connection b ()) a
96107
test5 pool = do
97108
queries <- getQueriesNumber
98-
worlds <- liftIO $ mapConcurrently (const (withResource pool getRandomWorld)) [1..queries]
99-
updatedWorlds <- liftIO $ mapConcurrently (withResource pool . updateWorldRandom) (catMaybes worlds)
109+
worlds <- liftIO $ mapConcurrently (const (Pool.withResource pool getRandomWorld)) [1..queries]
110+
updatedWorlds <- liftIO $ mapConcurrently (Pool.withResource pool . updateWorldRandom) (catMaybes worlds)
100111
setHeader "Content-Type" "application/json"
101112
lazyBytes $ encode updatedWorlds
102113
{-# INLINE test5 #-}
@@ -111,10 +122,11 @@ test6 = do
111122

112123
main :: IO ()
113124
main = do
114-
pool <- createPool (cb_createConn pcconn) (cb_destroyConn pcconn)
115-
(pc_stripes poolCfg) (pc_keepOpenTime poolCfg)
116-
(pc_resPerStripe poolCfg)
117-
runSpock 3000 $ spock (defaultSpockCfg Nothing dbConn ()) $ do
125+
numCaps <- GHC.Conc.getNumCapabilities
126+
let numStripes = max 1 numCaps
127+
pool <- mkPool (poolCfg numStripes)
128+
spockCfg <- defaultSpockCfg () (PCPool pool) ()
129+
runSpock 3000 $ spock spockCfg $ do
118130
get "json" test1
119131
get "db" test2
120132
get "queries" $ test3 pool

‎frameworks/Haskell/spock/stack.yaml‎

Lines changed: 10 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2,13 +2,21 @@
22
# For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration/
33

44
# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)
5-
resolver: lts-6.3
5+
resolver: lts-18.28
66

77
# Local packages, usually specified by relative directory name
88
packages:
99
- '.'
1010
# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)
11-
extra-deps: []
11+
extra-deps:
12+
- Spock-0.14.0.0
13+
- Spock-core-0.14.0.0
14+
- reroute-0.6.0.0
15+
- stm-containers-1.2
16+
- focus-1.0.1.4
17+
- stm-hamt-1.2.0.4
18+
- primitive-extras-0.8
19+
- primitive-unlifted-0.1.3.0
1220

1321
# Override default flag values for local packages and extra-deps
1422
flags: {}

‎frameworks/Haskell/spock/stack.yaml.lock‎

Lines changed: 68 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,68 @@
1+
# This file was autogenerated by Stack.
2+
# You should not edit this file by hand.
3+
# For more information, please see the documentation at:
4+
# https://docs.haskellstack.org/en/stable/topics/lock_files
5+
6+
packages:
7+
- completed:
8+
hackage: Spock-0.14.0.0@sha256:7e86ccc9e66ce0fdb84d1dcd328f852d3754c2dbfcb60d0e7e2f1cce2f32f177,3681
9+
pantry-tree:
10+
sha256: 6829dae9ba2492fae3e447afe13013dd863bd48fd5b8addfa74fc55d979de7b2
11+
size: 1118
12+
original:
13+
hackage: Spock-0.14.0.0
14+
- completed:
15+
hackage: Spock-core-0.14.0.0@sha256:386d330115cf7f82984cfbfd5190a0009b7bf6b4759acbddf2a1c05e0ef57e77,3580
16+
pantry-tree:
17+
sha256: 8b6ae16a663f791109b6aee858b7989239a9ecd2d58e34f098d42da93f0d3960
18+
size: 1113
19+
original:
20+
hackage: Spock-core-0.14.0.0
21+
- completed:
22+
hackage: reroute-0.6.0.0@sha256:43805b3fdc7ed1ba701cd10e249abc997b2291c8f374b8333bb2ea0e0d1dad0b,2382
23+
pantry-tree:
24+
sha256: 0a27afabb1730147d6aa0ddf5cc6368951c4625e3706cb8f5388da9739372fa3
25+
size: 660
26+
original:
27+
hackage: reroute-0.6.0.0
28+
- completed:
29+
hackage: stm-containers-1.2@sha256:a887f2e7692b7cf20e0b081e2d66e21076e2bd4b57016ec59c484edfa2d29397,3244
30+
pantry-tree:
31+
sha256: 20b1076bdb121347ccc512a67df697eed34815a8e35279b6b9a0951963b1eba2
32+
size: 761
33+
original:
34+
hackage: stm-containers-1.2
35+
- completed:
36+
hackage: focus-1.0.1.4@sha256:fb2da753531be62e81da10eefbb6cd91d55b60612c3bbd6d82855664347da2fd,2647
37+
pantry-tree:
38+
sha256: 0f76ffc78fb23e36c63e8a3e66d09d9e072bd891054adfff48b1983727d2394d
39+
size: 325
40+
original:
41+
hackage: focus-1.0.1.4
42+
- completed:
43+
hackage: stm-hamt-1.2.0.4@sha256:7957497c022554b7599e790696d1a3e56359ad99e5da36a251894c626ca1f60a,3970
44+
pantry-tree:
45+
sha256: d9a8be48da86bd4a2ba9d52ea29b9a74f1b686d439ba1bbfba04ab1a002391da
46+
size: 1009
47+
original:
48+
hackage: stm-hamt-1.2.0.4
49+
- completed:
50+
hackage: primitive-extras-0.8@sha256:fca0310150496867f5b9421fe1541ecda87fae17eae44885a29f9c52dd00c8ff,2963
51+
pantry-tree:
52+
sha256: e7c1d26202b80d1fca2ef780ec7fe76ede1275f4d9a996c6d44c08d8de1c45db
53+
size: 1105
54+
original:
55+
hackage: primitive-extras-0.8
56+
- completed:
57+
hackage: primitive-unlifted-0.1.3.0@sha256:a98f827740f5dcf097d885b3a47c32f4462204449620abc9d51b8c4f8619f9e6,1427
58+
pantry-tree:
59+
sha256: c882dca2a96b98d02b0d21875b651edb11ac67d90e736c0de7a92c410a19eb7f
60+
size: 420
61+
original:
62+
hackage: primitive-unlifted-0.1.3.0
63+
snapshots:
64+
- completed:
65+
sha256: 428ec8d5ce932190d3cbe266b9eb3c175cd81e984babf876b64019e2cbe4ea68
66+
size: 590100
67+
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/28.yaml
68+
original: lts-18.28

0 commit comments

Comments
 (0)