git.iko.soy/roboservant
on master help sign in
Merge pull request #2 from mwotton/sam/refactor-api

Refactor User Facing API

commit431b5efd2ce96521b63d981b7bc984a72be3feca authorMark Wotton <mwotton@gmail.com> dateSun 13 Sep 2020, 18:39 (6 years ago) parentde39a1f41fa929
5 files changed+17−17
compare with master
unifiedsplit
README.md+1−2 package.yaml+1−1 roboservant.cabal+2−2 src/Roboservant/StateMachine.hs+10−5 test/Spec.hs+3−7
README.md+1−2
@@ -29,9 +29,8 @@ type FooApi =
2929From the tests:
3030
3131```
32− let reifiedApi = RS.toReifiedApi (RS.flattenServer @Foo.FooApi Foo.fooServer) (Proxy @(Endpoints Foo.FooApi))
3332 assert "should find an error in Foo" . not
34− =<< checkSequential (Group "Foo" [("Foo", RS.prop_sequential reifiedApi)])
33+ =<< checkSequential (Group "Foo" [("Foo", RS.prop_sequential @Foo.FooApi Foo.fooServer)])
3534```
3635
3736We have a server that blows up if the value of the int in a `Foo` ever gets above 10. Note:
package.yaml+1−1
@@ -7,7 +7,7 @@ maintainer: "mwotton@gmail.com"
77copyright: "2020 Mark Wotton, Samuel Schlesinger"
88synopsis: Automatic session-aware servant testing
99category: Web
10−description: Please see the README on GitHub at <https://github.com/githubuser/roboservant#readme>
10+description: Please see the README on GitHub at <https://github.com/mwotton/roboservant#readme>
1111
1212extra-source-files:
1313- README.md
roboservant.cabal+2−2
@@ -4,12 +4,12 @@ cabal-version: 1.12
44--
55-- see: https://github.com/sol/hpack
66--
7−-- hash: 51154f1c866aea92673a52985de6810cebda3b2662fddd7b7f88a56725e30041
7+-- hash: 83f44d7e193afdbe2e62584983f73420b90328cbc0ea01f626d16313091641cf
88
99name: roboservant
1010version: 0.1.0.0
1111synopsis: Automatic session-aware servant testing
12−description: Please see the README on GitHub at <https://github.com/githubuser/roboservant#readme>
12+description: Please see the README on GitHub at <https://github.com/mwotton/roboservant#readme>
1313category: Web
1414homepage: https://github.com/mwotton/roboservant#readme
1515bug-reports: https://github.com/mwotton/roboservant/issues
src/Roboservant/StateMachine.hs+10−5
@@ -16,7 +16,10 @@
1616{-# LANGUAGE TypeOperators #-}
1717{-# LANGUAGE UndecidableInstances #-}
1818
19−module Roboservant.StateMachine where
19+module Roboservant.StateMachine
20+( prop_sequential
21+, prop_concurrent
22+) where
2023
2124import Control.Monad.Except (runExceptT)
2225import Control.Monad.IO.Class (MonadIO, liftIO)
@@ -223,8 +226,9 @@ callEndpoint staticRoutes =
223226 -- , Ensure (no-500 here)
224227 ]
225228
226−prop_sequential :: ReifiedApi -> Property
227−prop_sequential reifiedApi = do
229+prop_sequential :: forall api. (FlattenServer api, ToReifiedApi (Endpoints api)) => Server api -> Property
230+prop_sequential server = do
231+ let reifiedApi = toReifiedApi (flattenServer @api server) (Proxy @(Endpoints api))
228232 property $ do
229233 let initialState = State mempty
230234 actions <-
@@ -235,8 +239,9 @@ prop_sequential reifiedApi = do
235239 [callEndpoint reifiedApi]
236240 executeSequential initialState actions
237241
238−prop_concurrent :: ReifiedApi -> Property
239−prop_concurrent reifiedApi =
242+prop_concurrent :: forall api. (FlattenServer api, ToReifiedApi (Endpoints api)) => Server api -> Property
243+prop_concurrent server =
244+ let reifiedApi = toReifiedApi (flattenServer @api server) (Proxy @(Endpoints api)) in
240245 let initialState = State mempty
241246 in withTests 1000 . withRetries 10 . property $ do
242247 actions <-
test/Spec.hs+3−7
@@ -1,11 +1,9 @@
11{-# LANGUAGE OverloadedStrings #-}
22{-# LANGUAGE TypeApplications #-}
33
4−import Data.Proxy (Proxy (..))
54import qualified Foo
65import Hedgehog (Group (..), checkSequential)
76import qualified Roboservant as RS
8−import Servant (Endpoints)
97import qualified UnsafeIO
108
119-- | this is pretty bad. hopefully Jacob knows a better way of doing this.
@@ -17,15 +15,13 @@ assert err False = ioError $ userError err
1715-- | This is horribly laid out, sorry. Will fix at some point.
1816main :: IO ()
1917main = do
20− let reifiedApi = RS.toReifiedApi (RS.flattenServer @Foo.FooApi Foo.fooServer) (Proxy @(Endpoints Foo.FooApi))
2118 assert "should find an error in Foo" . not
22− =<< checkSequential (Group "Foo" [("Foo", RS.prop_sequential reifiedApi)])
19+ =<< checkSequential (Group "Foo" [("Foo", RS.prop_sequential @Foo.FooApi Foo.fooServer)])
2320 -- The UnsafeIO checker does not actually really use the contextually aware stuff, though it
2421 -- could: it's mostly here to show how to test for concurrency problems.
2522 unsafeServer <- UnsafeIO.makeServer
26− let unsafeApi = RS.toReifiedApi (RS.flattenServer @UnsafeIO.UnsafeApi unsafeServer) (Proxy @(Endpoints UnsafeIO.UnsafeApi))
2723 -- this will not detect the error, as it requires concurrency.
28− assert "should find nothing" =<< checkSequential (Group "Unsafe" [("Sequential", RS.prop_sequential unsafeApi)])
24+ assert "should find nothing" =<< checkSequential (Group "Unsafe" [("Sequential", RS.prop_sequential @UnsafeIO.UnsafeApi unsafeServer)])
2925 -- this will!
3026 assert "should find with parallel check" . not
31− =<< checkSequential (Group "Unsafe" [("Parallel", RS.prop_concurrent unsafeApi)])
27+ =<< checkSequential (Group "Unsafe" [("Parallel", RS.prop_concurrent @UnsafeIO.UnsafeApi unsafeServer)])