git.iko.soy/roboservant
on master help sign in
revamp tests, change interface
commit41584fcbf871ba8c600c9931eb8ee85b306be8d0 authorMark Wotton <mwotton@gmail.com> dateWed 23 Sep 2020, 22:48 (6 years ago) parent30762a2
8 files changed+160−86
compare with master
unifiedsplit
Makefile+1−1 package.yaml+3 roboservant.cabal+4−1 src/Roboservant/StateMachine.hs+35−26 src/Roboservant/Types.hs+4−1 stack.yaml+17−7 stack.yaml.lock+62−29 test/Spec.hs+34−21
Makefile+1−1
@@ -1,2 +1,2 @@
11testwatch:
2− ghcid -c 'stack repl --test --ghc-options=-fobject-code roboservant' --allow-eval --restart="stack.yaml" --restart="package.yaml" -W
2+ ghcid -T main -c 'stack repl --test --ghc-options=-fobject-code roboservant --ghc-options="+RTS -N4"' --allow-eval --restart="stack.yaml" --restart="package.yaml" -W
package.yaml+3
@@ -42,3 +42,6 @@ tests:
4242 dependencies:
4343 - roboservant
4444 - aeson
45+ - hspec
46+ - hspec-core
47+ - hspec-hedgehog
roboservant.cabal+4−1
@@ -4,7 +4,7 @@ cabal-version: 1.12
44--
55-- see: https://github.com/sol/hpack
66--
7−-- hash: 54c16a0abf993f08c909111fc8c7a86a3e633745bc93734d36b3bf9ccb93062a
7+-- hash: c6f561e011d580d9e17888decc01e0d8d54c8508b04d3dfff3cfcb7f37e5f2e1
88
99name: roboservant
1010version: 0.1.0.2
@@ -67,6 +67,9 @@ test-suite roboservant-test
6767 , bytestring
6868 , containers
6969 , hedgehog
70+ , hspec
71+ , hspec-core
72+ , hspec-hedgehog
7073 , mtl
7174 , roboservant
7275 , servant
src/Roboservant/StateMachine.hs+35−26
@@ -37,8 +37,8 @@ import Type.Reflection (SomeTypeRep)
3737
3838import Roboservant.Types
3939
40−callEndpoint :: (MonadGen n, MonadIO m) => ReifiedApi -> Command n m State
41−callEndpoint staticRoutes =
40+callEndpoint :: (MonadGen n, MonadIO m) => ReifiedApi -> [Dynamic] -> Command n m State
41+callEndpoint staticRoutes seed =
4242 let gen :: MonadGen n => State Symbolic -> Maybe (n (Op Symbolic))
4343 gen State {..}
4444 | any null options = Nothing
@@ -71,6 +71,10 @@ callEndpoint staticRoutes =
7171 (MonadIO m) =>
7272 Op Concrete ->
7373 m (Opaque (IORef Dynamic))
74+ execute (Preload tr v) = fmap Opaque . liftIO $ do
75+ newIORef . concrete $ v
76+ --fmap Opaque . liftIO $
77+-- _ v
7478 execute (Op (ApiOffset offset) args) = do
7579 -- traceM (show (offset, args))
7680 fmap Opaque . liftIO $ do
@@ -91,43 +95,48 @@ callEndpoint staticRoutes =
9195 in Command
9296 gen
9397 execute
94− [ Update $ \s@State {..} (Op (ApiOffset offset) _args) o' ->
95− s
96− { stateRefs =
97− let (_, _, tr, _) = staticRoutes !! offset
98− in Map.insertWith
99− (<>)
100− tr
101− (pure o')
102− stateRefs
103− }
98+ [ Update $ \s@State {..} op o' ->
99+ case op of
100+ Preload tr v -> s { stateRefs =
101+ Map.insertWith (<>) tr (pure o') stateRefs }
102+ (Op (ApiOffset offset) _args) ->
103+ s
104+ { stateRefs =
105+ let (_, _, tr, _) = staticRoutes !! offset
106+ in Map.insertWith
107+ (<>)
108+ tr
109+ (pure o')
110+ stateRefs
111+ }
104112 -- , Ensure (no-500 here)
105113 ]
106114
107−prop_sequential :: forall api. (FlattenServer api, ToReifiedApi (Endpoints api)) => Server api -> Property
108−prop_sequential server = do
115+prop_sequential :: forall api. (FlattenServer api, ToReifiedApi (Endpoints api)) => Server api -> [Dynamic] -> PropertyT IO ()
116+prop_sequential server seed = do
109117 let reifiedApi = toReifiedApi (flattenServer @api server) (Proxy @(Endpoints api))
110− property $ do
111− let initialState = State mempty
112− actions <-
113− forAll $
114− Gen.sequential
115− (Range.linear 1 100)
116− initialState
117− [callEndpoint reifiedApi]
118− executeSequential initialState actions
118+ -- refs <- Map.fromList <$> mapM (\d -> (dynTypeRep d,) <$> newIORef d) seed
119119
120−prop_concurrent :: forall api. (FlattenServer api, ToReifiedApi (Endpoints api)) => Server api -> Property
120+ actions <-
121+ forAll $ do
122+ Gen.sequential
123+ (Range.linear 1 100)
124+ (State mempty)
125+ [callEndpoint reifiedApi seed]
126+
127+ executeSequential (undefined) actions
128+
129+prop_concurrent :: forall api. (FlattenServer api, ToReifiedApi (Endpoints api)) => Server api -> PropertyT IO ()
121130prop_concurrent server =
122131 let reifiedApi = toReifiedApi (flattenServer @api server) (Proxy @(Endpoints api)) in
123132 let initialState = State mempty
124− in withTests 1000 . withRetries 10 . property $ do
133+ in do
125134 actions <-
126135 forAll $
127136 Gen.parallel
128137 (Range.linear 1 50)
129138 (Range.linear 1 10)
130139 initialState
131− [callEndpoint reifiedApi]
140+ [callEndpoint reifiedApi []]
132141 test $
133142 executeParallel initialState actions
src/Roboservant/Types.hs+4−1
@@ -179,8 +179,11 @@ newtype ApiOffset = ApiOffset Int
179179-- | we need to specify an offset because it's entirely possible to have two
180180-- functions with the same arguments that do different things.
181181data Op (v :: * -> *) = Op ApiOffset [(TypeRep, Var (Opaque (IORef Dynamic)) v)]
182+ | Preload TypeRep (Var Dynamic v)
182183
183184deriving instance Show (Op Symbolic)
184185
185186instance HTraversable Op where
186− htraverse r (Op offset args) = Op offset <$> traverse (\(t, v) -> (t,) <$> htraverse r v) args
187+ htraverse r = \case
188+ Op offset args -> Op offset <$> traverse (\(t, v) -> (t,) <$> htraverse r v) args
189+ Preload tr v -> Preload tr <$> htraverse r v
stack.yaml+17−7
@@ -1,13 +1,23 @@
1−resolver: lts-15.15
1+resolver: lts-16.14
22packages:
33- .
44
55extra-deps:
66- servant-flatten-0.2@sha256:276896f7c5cdec5b8f8493f6205fded0cc602d050b58fdb09a6d7c85c3bb0837,1234
7−- quickcheck-state-machine-0.7.0@sha256:4fc4467380e35b88aab72c278856aacebbf95688059d8ad70eb82fe048df476b,4958
87- markov-chain-usage-model-0.0.0@sha256:1afa95faeb9213c4d960a669190078b41b89169462b8edd910472980671ba8c0,2112
9−- servant-0.17
10−- servant-client-0.17
11−- servant-client-core-0.17
12−- servant-server-0.17
13−- constrained-dynamic-0.1.0.0@sha256:3516d3b95c8180f8904671aa982af2fae55a185b18642192f5c8f50657108e82,1207
8+- servant-0.18
9+- servant-client-0.18
10+- servant-client-core-0.18
11+- servant-server-0.18
12+# - hspec-hedgehog-0.0.1.2@sha256:aaeeb50a43d2bce8a1850baa3ddf934a964bfe38c64efd59306b0c1421e55b45,1405
13+- QuickCheck-2.14.1@sha256:01e46d7b0a8d3148288ec977625f62d5516ebb5031a50c63f0453863301b4a79,7736
14+- random-1.2.0
15+- splitmix-0.1.0.1@sha256:22f9662e7e8b173421872241edd39350078a9ed4bb9e9f503948c5b483c79276,5253
16+- git: https://github.com/hedgehogqa/haskell-hedgehog.git
17+ commit: 03714682586e43b5ddf5c00391035471a6e01238
18+ subdirs:
19+ - hedgehog
20+- git: https://github.com/mwotton/hspec
21+ commit: cd9012414a93cf08f86e409544d4d3a8f282b507
22+ subdirs:
23+ - hspec-core
stack.yaml.lock+62−29
@@ -11,13 +11,6 @@ packages:
1111 sha256: 04f12c7bef2c3f9a25d94eb9489752ed498db8e243069fe95838dbb51df1dcb3
1212 original:
1313 hackage: servant-flatten-0.2@sha256:276896f7c5cdec5b8f8493f6205fded0cc602d050b58fdb09a6d7c85c3bb0837,1234
14−- completed:
15− hackage: quickcheck-state-machine-0.7.0@sha256:4fc4467380e35b88aab72c278856aacebbf95688059d8ad70eb82fe048df476b,4958
16− pantry-tree:
17− size: 3022
18− sha256: 045794fff983e385560b321ff5576f6ec5c2821748c3042053f72daaca7beba8
19− original:
20− hackage: quickcheck-state-machine-0.7.0@sha256:4fc4467380e35b88aab72c278856aacebbf95688059d8ad70eb82fe048df476b,4958
2114- completed:
2215 hackage: markov-chain-usage-model-0.0.0@sha256:1afa95faeb9213c4d960a669190078b41b89169462b8edd910472980671ba8c0,2112
2316 pantry-tree:
@@ -26,43 +19,83 @@ packages:
2619 original:
2720 hackage: markov-chain-usage-model-0.0.0@sha256:1afa95faeb9213c4d960a669190078b41b89169462b8edd910472980671ba8c0,2112
2821- completed:
29− hackage: servant-0.17@sha256:e78734cb6b75c5d1e52e8f5e16bc3f557154a580bbde4932a7e1a6a90da7eb04,5029
22+ hackage: servant-0.18@sha256:2b5c81089540c208b1945b5ca0c3551c862138d71b224a39fa275a62852a5c75,5068
3023 pantry-tree:
31− size: 2392
32− sha256: 36561a606c35393386aa48b7cc2407fa4013aba62a19d69f004ec9c2010209aa
24+ size: 2458
25+ sha256: 701b6443e486601dd127b92a28ca052278dea8dc528f013781c1304826e117d8
3326 original:
34− hackage: servant-0.17
27+ hackage: servant-0.18
3528- completed:
36− hackage: servant-client-0.17@sha256:433be65dd541b9a387eaaced22715a028ea846d72d141419c40ddf6fd5e3409b,4573
29+ hackage: servant-client-0.18@sha256:3e3b8d145cf811e19849744ad305aa0bd42301d01ff75e1dac169bc9f5d18221,4589
3730 pantry-tree:
3831 size: 1299
39− sha256: 1f8f57c6ce96ed4f1316460aaab48f3765b2addbf1e2cd363c72bbc41fdcf907
32+ sha256: 445c610d83a6e356ed2a7808af8deac84708be3e44d38cbf76e60fd6105f9715
4033 original:
41− hackage: servant-client-0.17
34+ hackage: servant-client-0.18
4235- completed:
43− hackage: servant-client-core-0.17@sha256:d64622d68d8a6934abc821171582d601a99ef0277f3d8b8ba9b483c2617e3df6,3577
36+ hackage: servant-client-core-0.18@sha256:6702f04f3e5ac47abace5b26ab1948480437334747895407f0697502a403b96a,3593
4437 pantry-tree:
4538 size: 1444
46− sha256: 89461980a2562d9943f4bb84077d8c4a8c5bac76c8c16577c9344e404b2e9fb1
39+ sha256: 20f538ae12091696073a2ac5f3301a4a56686f5e2889b2a9e539c0d61a332cd1
40+ original:
41+ hackage: servant-client-core-0.18
42+- completed:
43+ hackage: servant-server-0.18@sha256:ec7f361bc9848968b1fff8091fa2213b721d3f47549421945c6a7ca1702e22e6,5424
44+ pantry-tree:
45+ size: 2546
46+ sha256: c2470cd8665742cee13faae1db7e3d49d70b027d57c4578e3f7ba66ffc8dc7b4
47+ original:
48+ hackage: servant-server-0.18
49+- completed:
50+ hackage: QuickCheck-2.14.1@sha256:01e46d7b0a8d3148288ec977625f62d5516ebb5031a50c63f0453863301b4a79,7736
51+ pantry-tree:
52+ size: 2315
53+ sha256: 21961d0875fc156cdd97110a6fb277f37aa31faa3c7910895f84c82630e7ba46
54+ original:
55+ hackage: QuickCheck-2.14.1@sha256:01e46d7b0a8d3148288ec977625f62d5516ebb5031a50c63f0453863301b4a79,7736
56+- completed:
57+ hackage: random-1.2.0@sha256:4321209c8faedc034810ea8ed0dbc4a36f1a1df97b75af024219f2f533da57de,6094
58+ pantry-tree:
59+ size: 1259
60+ sha256: 29ff0a7ec5bf123e2c40f849b7af163950854a6c08c68b4a1b4364ce7a515af0
61+ original:
62+ hackage: random-1.2.0
63+- completed:
64+ hackage: splitmix-0.1.0.1@sha256:22f9662e7e8b173421872241edd39350078a9ed4bb9e9f503948c5b483c79276,5253
65+ pantry-tree:
66+ size: 1149
67+ sha256: b9a0c60e2d4786bbb276ce6606027a99615bf703fa3e0f01911e8c6a656c5161
4768 original:
48− hackage: servant-client-core-0.17
69+ hackage: splitmix-0.1.0.1@sha256:22f9662e7e8b173421872241edd39350078a9ed4bb9e9f503948c5b483c79276,5253
4970- completed:
50− hackage: servant-server-0.17@sha256:1a5adf564f0b703535eb733f249b282ef2ca7b587a303c357b549fb88e7a6dcd,5388
71+ subdir: hedgehog
72+ name: hedgehog
73+ version: 1.0.3
74+ git: https://github.com/hedgehogqa/haskell-hedgehog.git
5175 pantry-tree:
52− size: 2460
53− sha256: ea65ba54acb4362efedbfa7db616a51023579a6c83f18ab6d2ea6a84dea56021
76+ size: 2575
77+ sha256: 7e69930fef281dfeb47b2f7c745c26234768e56ffb5490065f607c57146ffbab
78+ commit: 03714682586e43b5ddf5c00391035471a6e01238
5479 original:
55− hackage: servant-server-0.17
80+ subdir: hedgehog
81+ git: https://github.com/hedgehogqa/haskell-hedgehog.git
82+ commit: 03714682586e43b5ddf5c00391035471a6e01238
5683- completed:
57− hackage: constrained-dynamic-0.1.0.0@sha256:3516d3b95c8180f8904671aa982af2fae55a185b18642192f5c8f50657108e82,1207
84+ subdir: hspec-core
85+ name: hspec-core
86+ version: 2.7.4
87+ git: https://github.com/mwotton/hspec
5888 pantry-tree:
59− size: 576
60− sha256: 93e4777d88e75cb1b3efef47654880304ce6fd2af12e31b0c7bd279f95abb449
89+ size: 3899
90+ sha256: 6ece11ad28a7f122a502e766eb1b3ef950815c2d16babb0ea8744646f1c1bd70
91+ commit: cd9012414a93cf08f86e409544d4d3a8f282b507
6192 original:
62− hackage: constrained-dynamic-0.1.0.0@sha256:3516d3b95c8180f8904671aa982af2fae55a185b18642192f5c8f50657108e82,1207
93+ subdir: hspec-core
94+ git: https://github.com/mwotton/hspec
95+ commit: cd9012414a93cf08f86e409544d4d3a8f282b507
6396snapshots:
6497- completed:
65− size: 496112
66− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/15/15.yaml
67− sha256: 86169722ad0056ffc9eacc157ef80ee21d7024f92c0d2961c89ccf432db230a3
68− original: lts-15.15
98+ size: 532382
99+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/14.yaml
100+ sha256: 1ef27e36f38824abafc43224ca612211b3828fa9ffd31ba0fc2867ae2e19ba90
101+ original: lts-16.14
test/Spec.hs+34−21
@@ -7,27 +7,40 @@ import Hedgehog (Group (..), checkSequential, withTests)
77import qualified Roboservant as RS
88import qualified UnsafeIO
99import Control.Monad(when)
10+import Test.Hspec.Hedgehog
11+import Test.Hspec
12+import Test.Hspec.Core.Spec(shouldFail)
13+import Control.Monad.Trans (MonadIO(liftIO))
1014
11−-- | this is pretty bad. hopefully Jacob knows a better way of doing this.
12−-- https://twitter.com/mwotton/status/1305189249646460933
13−assert :: String -> Bool -> IO ()
14−assert _ True = pure ()
15−assert err False = ioError $ userError err
15+-- -- | this is pretty bad. hopefully Jacob knows a better way of doing this.
16+-- -- https://twitter.com/mwotton/status/1305189249646460933
17+-- assert :: String -> Bool -> IO ()
18+-- assert _ True = pure ()
19+-- assert err False = ioError $ userError err
1620
17−-- | This is horribly laid out, sorry. Will fix at some point.
18−main :: IO ()
19−main = do
20− assert "should find an error in Foo" . not
21− =<< checkSequential (Group "Foo" [("Foo", withTests 100000 $ RS.prop_sequential @Foo.FooApi Foo.fooServer)])
22− when False $ do
23− assert "should find an error in Headers" . not
24− =<< checkSequential (Group "Headers" [("Headers", withTests 10000 $ RS.prop_sequential @Headers.Api Headers.server)])
21+main = hspec spec
2522
26− -- The UnsafeIO checker does not actually really use the contextually aware stuff, though it
27− -- could: it's mostly here to show how to test for concurrency problems.
28− unsafeServer <- UnsafeIO.makeServer
29− -- this will not detect the error, as it requires concurrency.
30− assert "should find nothing" =<< checkSequential (Group "Unsafe" [("Sequential", RS.prop_sequential @UnsafeIO.UnsafeApi unsafeServer)])
31− -- this will!
32− assert "should find with parallel check" . not
33− =<< checkSequential (Group "Unsafe" [("Parallel", withTests 100000 $ RS.prop_concurrent @UnsafeIO.UnsafeApi unsafeServer)])
23+spec :: Spec
24+spec = do
25+ describe "Foo" $ do
26+ --
27+ shouldFail $ it "finds an error" $
28+ (hedgehog $ RS.prop_sequential @Foo.FooApi Foo.fooServer [])
29+
30+ describe "Headers" $ do
31+ shouldFail $ it "should find a failure that's dependent on using header info" $ do
32+ liftIO $ pendingWith "doesn't yet work"
33+ (hedgehog $ RS.prop_sequential @Headers.Api Headers.server [])
34+
35+ -- -- The UnsafeIO checker does not actually really use the contextually aware stuff, though it
36+ -- -- could: it's mostly here to show how to test for concurrency problems.
37+ before UnsafeIO.makeServer $ do
38+ describe "sequential checking" $ do
39+ it "safe use" $ \unsafeServer -> do
40+ hedgehog $ RS.prop_sequential @UnsafeIO.UnsafeApi unsafeServer []
41+
42+ modifyMaxSuccess (const 10000) $
43+ shouldFail $
44+ describe "concurrent" $ do
45+ it "concurrent, dangerous use" $ \unsafeServer -> do
46+ RS.prop_concurrent @UnsafeIO.UnsafeApi unsafeServer