@@ -21,7 +21,7 @@ module Roboservant.Direct
2121
2222 -- TODO come up with something smarter than exporting all this, we should
2323 -- have some nice error-display functions
24− , RoboservantException(..), FuzzState(..), FuzzOp(..)
24+ , RoboservantException(..), FuzzState(..), FuzzOp(..), FailureType(..), Report(..)
2525 )
2626where
2727
@@ -36,7 +36,6 @@ import Data.Maybe (mapMaybe)
3636import Data.Typeable (TypeRep)
3737import Servant (Endpoints, Proxy (Proxy), Server, ServerError(..))
3838import System.Random(StdGen,randomR,mkStdGen)
39−import System.Timeout.Lifted(timeout)
4039import qualified Data.List.NonEmpty as NEL
4140import qualified Data.Map.Strict as Map
4241import Data.Time.Clock
@@ -50,16 +49,19 @@ import Roboservant.Types
5049 )
5150
5251data RoboservantException
53− = RoboservantException FailureType (Maybe SomeException) Int FuzzState
54− deriving (Show)
55−-- we believe in nussink, lebowski
52+ = RoboservantException
53+ { failureReason :: FailureType
54+ , serverException :: Maybe SomeException
55+ , fuzzState :: FuzzState
56+ } deriving (Show)
57+
5658instance Exception RoboservantException
5759
5860data FailureType
5961 = ServerCrashed
6062 | CheckerFailed
6163 | NoPossibleMoves
62− | InsufficientCoverage
64+ | InsufficientCoverage Double
6365 deriving (Show,Eq)
6466
6567
@@ -90,8 +92,9 @@ data StopReason
9092 deriving (Show,Eq)
9193
9294data Report = Report
93− { textual :: String }
94− deriving (Show,Eq)
95+ { textual :: String
96+ , rsException :: RoboservantException}
97+ deriving (Show)
9598
9699fuzz :: forall api. (FlattenServer api, ToReifiedApi (Endpoints api))
97100 => Server api
@@ -116,16 +119,20 @@ fuzz server Config{..} checker = handle (pure . Just . formatException) $ do
116119 where
117120 -- something less terrible later
118121 formatException :: RoboservantException -> Report
119− formatException = Report . show
120−
122+ formatException r@(RoboservantException failureType exception _state) = Report
123+ (unlines [ show failureType , show exception ])
124+ r
125+
121126 -- evaluateCoverage :: FuzzState -> m ()
122127 evaluateCoverage f@FuzzState{..}
123− | hitRoutes / totalRoutes > coverageThreshold = do
124− liftIO $ print ("passed coverage", hitRoutes, totalRoutes)
125− pure ()
126− | otherwise = throw $ RoboservantException InsufficientCoverage Nothing routeCount f
128+ | coverage > coverageThreshold = pure ()
129+ | otherwise = do
130+ liftIO $ do putStrLn "api endpoints covered"
131+ mapM_ print (Set.toList $ Set.fromList $ map apiOffset path)
132+ throw $ RoboservantException (InsufficientCoverage coverage) Nothing f
127133 where hitRoutes = (fromIntegral . Set.size . Set.fromList $ map apiOffset path)
128134 totalRoutes = (fromIntegral routeCount)
135+ coverage = hitRoutes / totalRoutes
129136
130137
131138 untilDone :: MonadIO m => (Integer,UTCTime) -> m a -> m StopReason
@@ -143,7 +150,7 @@ fuzz server Config{..} checker = handle (pure . Just . formatException) $ do
143150
144151 elementOrFail :: (MonadState FuzzState m, MonadIO m)
145152 => [a] -> m a
146− elementOrFail [] = liftIO . throw . RoboservantException NoPossibleMoves Nothing routeCount =<< get
153+ elementOrFail [] = liftIO . throw . RoboservantException NoPossibleMoves Nothing =<< get
147154 elementOrFail l = do
148155 st <- get
149156 let (index,newGen) = randomR (0, length l - 1) (currentRng st)
@@ -212,10 +219,10 @@ fuzz server Config{..} checker = handle (pure . Just . formatException) $ do
212219 op <- genOp
213220 catches (execute op)
214221 [ Handler (\(e :: SomeAsyncException) -> throw e)
215− , Handler (\(e :: SomeException) -> throw . RoboservantException ServerCrashed (Just e) routeCount =<< get)
222+ , Handler (\(e :: SomeException) -> throw . RoboservantException ServerCrashed (Just e) =<< get)
216223 ]
217224 catch (liftIO checker)
218− (\(e :: SomeException) -> throw . RoboservantException CheckerFailed (Just e) routeCount =<< get)
225+ (\(e :: SomeException) -> throw . RoboservantException CheckerFailed (Just e) =<< get)
219226
220227 -- actions <-
221228 -- forAll $ do