revamp tests, change interface

2024-08-15 19:10:24 +03:00 · 2020-09-23 22:48:59 -04:00 · 2020-09-23 22:48:59 -04:00 · 41584fcbf8
commit 41584fcbf8
parent 30762a2695
8 changed files with 160 additions and 86 deletions
--- a/2
+++ b/2
@ -1,2 +1,2 @@
 testwatch:
-	ghcid -c 'stack repl --test --ghc-options=-fobject-code roboservant' --allow-eval --restart="stack.yaml" --restart="package.yaml"  -W
+	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
--- a/package.yaml
+++ b/package.yaml
@ -42,3 +42,6 @@ tests:
    dependencies:
    - roboservant
    - aeson
+    - hspec
+    - hspec-core
+    - hspec-hedgehog
--- a/roboservant.cabal
+++ b/roboservant.cabal
@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
-- hash: 54c16a0abf993f08c909111fc8c7a86a3e633745bc93734d36b3bf9ccb93062a
+-- hash: c6f561e011d580d9e17888decc01e0d8d54c8508b04d3dfff3cfcb7f37e5f2e1

 name:           roboservant
 version:        0.1.0.2
@ -67,6 +67,9 @@ test-suite roboservant-test
    , bytestring
    , containers
    , hedgehog
+    , hspec
+    , hspec-core
+    , hspec-hedgehog
    , mtl
    , roboservant
    , servant
--- a/src/Roboservant/StateMachine.hs
+++ b/src/Roboservant/StateMachine.hs
@ -37,8 +37,8 @@ import Type.Reflection (SomeTypeRep)

 import Roboservant.Types

-callEndpoint :: (MonadGen n, MonadIO m) => ReifiedApi -> Command n m State
-callEndpoint staticRoutes =
+callEndpoint :: (MonadGen n, MonadIO m) => ReifiedApi -> [Dynamic] -> Command n m State
+callEndpoint staticRoutes seed =
  let gen :: MonadGen n => State Symbolic -> Maybe (n (Op Symbolic))
      gen State {..}
        | any null options = Nothing
@ -71,6 +71,10 @@ callEndpoint staticRoutes =
        (MonadIO m) =>
        Op Concrete ->
        m (Opaque (IORef Dynamic))
+      execute (Preload tr v) = fmap Opaque . liftIO $ do
+        newIORef . concrete $ v
+        --fmap Opaque . liftIO $
+--        _ v
      execute (Op (ApiOffset offset) args) = do
        --        traceM (show (offset, args))
        fmap Opaque . liftIO $ do
@ -91,43 +95,48 @@ callEndpoint staticRoutes =
   in Command
        gen
        execute
-        [ Update $ \s@State {..} (Op (ApiOffset offset) _args) o' ->
-            s
-              { stateRefs =
-                  let (_, _, tr, _) = staticRoutes !! offset
-                   in Map.insertWith
-                        (<>)
-                        tr
-                        (pure o')
-                        stateRefs
-              }
+        [ Update $ \s@State {..} op o' ->
+            case op of
+              Preload tr v -> s { stateRefs =
+                                  Map.insertWith (<>) tr (pure o') stateRefs }
+              (Op (ApiOffset offset) _args)  ->
+                s
+                  { stateRefs =
+                      let (_, _, tr, _) = staticRoutes !! offset
+                       in Map.insertWith
+                            (<>)
+                            tr
+                            (pure o')
+                            stateRefs
+                  }
          -- , Ensure (no-500 here)
        ]

-prop_sequential :: forall api. (FlattenServer api, ToReifiedApi (Endpoints api)) => Server api -> Property
-prop_sequential server = do
+prop_sequential :: forall api. (FlattenServer api, ToReifiedApi (Endpoints api)) => Server api -> [Dynamic] -> PropertyT IO ()
+prop_sequential server seed = do
  let reifiedApi = toReifiedApi (flattenServer @api server) (Proxy @(Endpoints api))
-  property $ do
-    let initialState = State mempty
-    actions <-
-      forAll $
-        Gen.sequential
-          (Range.linear 1 100)
-          initialState
-          [callEndpoint reifiedApi]
-    executeSequential initialState actions
+  -- refs <- Map.fromList <$> mapM (\d -> (dynTypeRep d,) <$> newIORef d) seed

-prop_concurrent :: forall api. (FlattenServer api, ToReifiedApi (Endpoints api)) => Server api -> Property
+  actions <-
+    forAll $ do
+      Gen.sequential
+        (Range.linear 1 100)
+        (State mempty)
+        [callEndpoint reifiedApi seed]
+
+  executeSequential (undefined) actions
+
+prop_concurrent :: forall api. (FlattenServer api, ToReifiedApi (Endpoints api)) => Server api -> PropertyT IO ()
 prop_concurrent server =
  let reifiedApi = toReifiedApi (flattenServer @api server) (Proxy @(Endpoints api)) in
  let initialState = State mempty
-   in withTests 1000 . withRetries 10 . property $ do
+   in do
        actions <-
          forAll $
            Gen.parallel
              (Range.linear 1 50)
              (Range.linear 1 10)
              initialState
-              [callEndpoint reifiedApi]
+              [callEndpoint reifiedApi []]
        test $
          executeParallel initialState actions
--- a/src/Roboservant/Types.hs
+++ b/src/Roboservant/Types.hs
@ -179,8 +179,11 @@ newtype ApiOffset = ApiOffset Int
 -- | we need to specify an offset because it's entirely possible to have two
 --   functions with the same arguments that do different things.
 data Op (v :: * -> *) = Op ApiOffset [(TypeRep, Var (Opaque (IORef Dynamic)) v)]
+                      | Preload TypeRep (Var Dynamic v)

 deriving instance Show (Op Symbolic)

 instance HTraversable Op where
-  htraverse r (Op offset args) = Op offset <$> traverse (\(t, v) -> (t,) <$> htraverse r v) args
+  htraverse r = \case
+    Op offset args -> Op offset <$> traverse (\(t, v) -> (t,) <$> htraverse r v) args
+    Preload tr v -> Preload tr <$> htraverse r v
--- a/stack.yaml
+++ b/stack.yaml
@ -1,13 +1,23 @@
-resolver: lts-15.15
+resolver: lts-16.14
 packages:
 - .

 extra-deps:
 - servant-flatten-0.2@sha256:276896f7c5cdec5b8f8493f6205fded0cc602d050b58fdb09a6d7c85c3bb0837,1234
- quickcheck-state-machine-0.7.0@sha256:4fc4467380e35b88aab72c278856aacebbf95688059d8ad70eb82fe048df476b,4958
 - markov-chain-usage-model-0.0.0@sha256:1afa95faeb9213c4d960a669190078b41b89169462b8edd910472980671ba8c0,2112
- servant-0.17
- servant-client-0.17
- servant-client-core-0.17
- servant-server-0.17
- constrained-dynamic-0.1.0.0@sha256:3516d3b95c8180f8904671aa982af2fae55a185b18642192f5c8f50657108e82,1207
+- servant-0.18
+- servant-client-0.18
+- servant-client-core-0.18
+- servant-server-0.18
+# - hspec-hedgehog-0.0.1.2@sha256:aaeeb50a43d2bce8a1850baa3ddf934a964bfe38c64efd59306b0c1421e55b45,1405
+- QuickCheck-2.14.1@sha256:01e46d7b0a8d3148288ec977625f62d5516ebb5031a50c63f0453863301b4a79,7736
+- random-1.2.0
+- splitmix-0.1.0.1@sha256:22f9662e7e8b173421872241edd39350078a9ed4bb9e9f503948c5b483c79276,5253
+- git: https://github.com/hedgehogqa/haskell-hedgehog.git
+  commit: 03714682586e43b5ddf5c00391035471a6e01238
+  subdirs:
+    - hedgehog
+- git: https://github.com/mwotton/hspec
+  commit: cd9012414a93cf08f86e409544d4d3a8f282b507
+  subdirs:
+    - hspec-core
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@ -11,13 +11,6 @@ packages:
      sha256: 04f12c7bef2c3f9a25d94eb9489752ed498db8e243069fe95838dbb51df1dcb3
  original:
    hackage: servant-flatten-0.2@sha256:276896f7c5cdec5b8f8493f6205fded0cc602d050b58fdb09a6d7c85c3bb0837,1234
- completed:
-    hackage: quickcheck-state-machine-0.7.0@sha256:4fc4467380e35b88aab72c278856aacebbf95688059d8ad70eb82fe048df476b,4958
-    pantry-tree:
-      size: 3022
-      sha256: 045794fff983e385560b321ff5576f6ec5c2821748c3042053f72daaca7beba8
-  original:
-    hackage: quickcheck-state-machine-0.7.0@sha256:4fc4467380e35b88aab72c278856aacebbf95688059d8ad70eb82fe048df476b,4958
 - completed:
    hackage: markov-chain-usage-model-0.0.0@sha256:1afa95faeb9213c4d960a669190078b41b89169462b8edd910472980671ba8c0,2112
    pantry-tree:
@ -26,43 +19,83 @@ packages:
  original:
    hackage: markov-chain-usage-model-0.0.0@sha256:1afa95faeb9213c4d960a669190078b41b89169462b8edd910472980671ba8c0,2112
 - completed:
-    hackage: servant-0.17@sha256:e78734cb6b75c5d1e52e8f5e16bc3f557154a580bbde4932a7e1a6a90da7eb04,5029
+    hackage: servant-0.18@sha256:2b5c81089540c208b1945b5ca0c3551c862138d71b224a39fa275a62852a5c75,5068
    pantry-tree:
-      size: 2392
-      sha256: 36561a606c35393386aa48b7cc2407fa4013aba62a19d69f004ec9c2010209aa
+      size: 2458
+      sha256: 701b6443e486601dd127b92a28ca052278dea8dc528f013781c1304826e117d8
  original:
-    hackage: servant-0.17
+    hackage: servant-0.18
 - completed:
-    hackage: servant-client-0.17@sha256:433be65dd541b9a387eaaced22715a028ea846d72d141419c40ddf6fd5e3409b,4573
+    hackage: servant-client-0.18@sha256:3e3b8d145cf811e19849744ad305aa0bd42301d01ff75e1dac169bc9f5d18221,4589
    pantry-tree:
      size: 1299
-      sha256: 1f8f57c6ce96ed4f1316460aaab48f3765b2addbf1e2cd363c72bbc41fdcf907
+      sha256: 445c610d83a6e356ed2a7808af8deac84708be3e44d38cbf76e60fd6105f9715
  original:
-    hackage: servant-client-0.17
+    hackage: servant-client-0.18
 - completed:
-    hackage: servant-client-core-0.17@sha256:d64622d68d8a6934abc821171582d601a99ef0277f3d8b8ba9b483c2617e3df6,3577
+    hackage: servant-client-core-0.18@sha256:6702f04f3e5ac47abace5b26ab1948480437334747895407f0697502a403b96a,3593
    pantry-tree:
      size: 1444
-      sha256: 89461980a2562d9943f4bb84077d8c4a8c5bac76c8c16577c9344e404b2e9fb1
+      sha256: 20f538ae12091696073a2ac5f3301a4a56686f5e2889b2a9e539c0d61a332cd1
  original:
-    hackage: servant-client-core-0.17
+    hackage: servant-client-core-0.18
 - completed:
-    hackage: servant-server-0.17@sha256:1a5adf564f0b703535eb733f249b282ef2ca7b587a303c357b549fb88e7a6dcd,5388
+    hackage: servant-server-0.18@sha256:ec7f361bc9848968b1fff8091fa2213b721d3f47549421945c6a7ca1702e22e6,5424
    pantry-tree:
-      size: 2460
-      sha256: ea65ba54acb4362efedbfa7db616a51023579a6c83f18ab6d2ea6a84dea56021
+      size: 2546
+      sha256: c2470cd8665742cee13faae1db7e3d49d70b027d57c4578e3f7ba66ffc8dc7b4
  original:
-    hackage: servant-server-0.17
+    hackage: servant-server-0.18
 - completed:
-    hackage: constrained-dynamic-0.1.0.0@sha256:3516d3b95c8180f8904671aa982af2fae55a185b18642192f5c8f50657108e82,1207
+    hackage: QuickCheck-2.14.1@sha256:01e46d7b0a8d3148288ec977625f62d5516ebb5031a50c63f0453863301b4a79,7736
    pantry-tree:
-      size: 576
-      sha256: 93e4777d88e75cb1b3efef47654880304ce6fd2af12e31b0c7bd279f95abb449
+      size: 2315
+      sha256: 21961d0875fc156cdd97110a6fb277f37aa31faa3c7910895f84c82630e7ba46
  original:
-    hackage: constrained-dynamic-0.1.0.0@sha256:3516d3b95c8180f8904671aa982af2fae55a185b18642192f5c8f50657108e82,1207
+    hackage: QuickCheck-2.14.1@sha256:01e46d7b0a8d3148288ec977625f62d5516ebb5031a50c63f0453863301b4a79,7736
+- completed:
+    hackage: random-1.2.0@sha256:4321209c8faedc034810ea8ed0dbc4a36f1a1df97b75af024219f2f533da57de,6094
+    pantry-tree:
+      size: 1259
+      sha256: 29ff0a7ec5bf123e2c40f849b7af163950854a6c08c68b4a1b4364ce7a515af0
+  original:
+    hackage: random-1.2.0
+- completed:
+    hackage: splitmix-0.1.0.1@sha256:22f9662e7e8b173421872241edd39350078a9ed4bb9e9f503948c5b483c79276,5253
+    pantry-tree:
+      size: 1149
+      sha256: b9a0c60e2d4786bbb276ce6606027a99615bf703fa3e0f01911e8c6a656c5161
+  original:
+    hackage: splitmix-0.1.0.1@sha256:22f9662e7e8b173421872241edd39350078a9ed4bb9e9f503948c5b483c79276,5253
+- completed:
+    subdir: hedgehog
+    name: hedgehog
+    version: 1.0.3
+    git: https://github.com/hedgehogqa/haskell-hedgehog.git
+    pantry-tree:
+      size: 2575
+      sha256: 7e69930fef281dfeb47b2f7c745c26234768e56ffb5490065f607c57146ffbab
+    commit: 03714682586e43b5ddf5c00391035471a6e01238
+  original:
+    subdir: hedgehog
+    git: https://github.com/hedgehogqa/haskell-hedgehog.git
+    commit: 03714682586e43b5ddf5c00391035471a6e01238
+- completed:
+    subdir: hspec-core
+    name: hspec-core
+    version: 2.7.4
+    git: https://github.com/mwotton/hspec
+    pantry-tree:
+      size: 3899
+      sha256: 6ece11ad28a7f122a502e766eb1b3ef950815c2d16babb0ea8744646f1c1bd70
+    commit: cd9012414a93cf08f86e409544d4d3a8f282b507
+  original:
+    subdir: hspec-core
+    git: https://github.com/mwotton/hspec
+    commit: cd9012414a93cf08f86e409544d4d3a8f282b507
 snapshots:
 - completed:
-    size: 496112
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/15/15.yaml
-    sha256: 86169722ad0056ffc9eacc157ef80ee21d7024f92c0d2961c89ccf432db230a3
-  original: lts-15.15
+    size: 532382
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/14.yaml
+    sha256: 1ef27e36f38824abafc43224ca612211b3828fa9ffd31ba0fc2867ae2e19ba90
+  original: lts-16.14
--- a/test/Spec.hs
+++ b/test/Spec.hs
@ -7,27 +7,40 @@ import Hedgehog (Group (..), checkSequential, withTests)
 import qualified Roboservant as RS
 import qualified UnsafeIO
 import Control.Monad(when)
+import Test.Hspec.Hedgehog
+import Test.Hspec
+import Test.Hspec.Core.Spec(shouldFail)
+import Control.Monad.Trans (MonadIO(liftIO))

-- | this is pretty bad. hopefully Jacob knows a better way of doing this.
--   https://twitter.com/mwotton/status/1305189249646460933
-assert :: String -> Bool -> IO ()
-assert _ True = pure ()
-assert err False = ioError $ userError err
+-- -- | this is pretty bad. hopefully Jacob knows a better way of doing this.
+-- --   https://twitter.com/mwotton/status/1305189249646460933
+-- assert :: String -> Bool -> IO ()
+-- assert _ True = pure ()
+-- assert err False = ioError $ userError err

-- | This is horribly laid out, sorry. Will fix at some point.
-main :: IO ()
-main = do
-  assert "should find an error in Foo" . not
-    =<< checkSequential (Group "Foo" [("Foo", withTests 100000 $ RS.prop_sequential @Foo.FooApi Foo.fooServer)])
-  when False $ do
-    assert "should find an error in Headers" . not
-      =<< checkSequential (Group "Headers" [("Headers", withTests 10000 $ RS.prop_sequential @Headers.Api Headers.server)])
+main = hspec spec

-  -- The UnsafeIO checker does not actually really use the contextually aware stuff, though it
-  -- could: it's mostly here to show how to test for concurrency problems.
-  unsafeServer <- UnsafeIO.makeServer
-  -- this will not detect the error, as it requires concurrency.
-  assert "should find nothing" =<< checkSequential (Group "Unsafe" [("Sequential", RS.prop_sequential @UnsafeIO.UnsafeApi unsafeServer)])
-  -- this will!
-  assert "should find with parallel check" . not
-    =<< checkSequential (Group "Unsafe" [("Parallel", withTests 100000 $ RS.prop_concurrent @UnsafeIO.UnsafeApi unsafeServer)])
+spec :: Spec
+spec = do
+  describe "Foo" $ do
+    --
+    shouldFail $ it "finds an error" $
+      (hedgehog $ RS.prop_sequential @Foo.FooApi Foo.fooServer [])
+
+  describe "Headers" $ do
+    shouldFail $ it "should find a failure that's dependent on using header info" $ do
+      liftIO $ pendingWith "doesn't yet work"
+      (hedgehog $ RS.prop_sequential @Headers.Api Headers.server [])
+
+  -- -- The UnsafeIO checker does not actually really use the contextually aware stuff, though it
+  -- -- could: it's mostly here to show how to test for concurrency problems.
+  before UnsafeIO.makeServer $ do
+    describe "sequential checking" $ do
+      it "safe use" $ \unsafeServer -> do
+        hedgehog $ RS.prop_sequential @UnsafeIO.UnsafeApi unsafeServer []
+
+    modifyMaxSuccess (const 10000) $
+      shouldFail $
+        describe "concurrent" $ do
+          it "concurrent, dangerous use" $ \unsafeServer -> do
+            RS.prop_concurrent @UnsafeIO.UnsafeApi unsafeServer