<|start_filename|>Example.lhs<|end_filename|>
# Example

Our api under test:

``` haskell
-- Obligatory fancy-types pragma tax
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

import qualified Roboservant.Server as RS
import qualified Roboservant.Client as RC
import Servant.Client(ClientEnv, baseUrlPort, parseBaseUrl, mkClientEnv)
import Network.HTTP.Client       (newManager, defaultManagerSettings)
import Roboservant.Types
import Test.Hspec
import Servant
import GHC.Generics
import Data.Typeable
import Data.Hashable
import Data.Maybe(isNothing, isJust)
import qualified Network.Wai.Handler.Warp as Warp
import Data.Aeson(FromJSON,ToJSON)

newtype A = A Int
  deriving (Generic, Eq, Show, Typeable)
  deriving newtype (Hashable, FromHttpApiData, ToHttpApiData)

instance FromJSON A
instance ToJSON A

newtype B = B Int
  deriving (Generic, Eq, Show, Typeable)
  deriving newtype (Hashable, FromHttpApiData, ToHttpApiData)

instance FromJSON B
instance ToJSON B

type Api =
  "item" :> Get '[JSON] A
    :<|> "itemAdd" :> Capture "one" B :> Capture "two" B :> Get '[JSON] B
    :<|> "item" :> Capture "itemId" B :> Get '[JSON] ()

server :: Handler A -> Server Api
server introduce = introduce :<|> combine :<|> eliminate
  where
    combine (B i) (B j) = pure $ B (i + j)
    eliminate (B i)
      | i > 10 = error "give up, eleven is way too big and probably not even real"
      | otherwise = pure ()
```

We have a "good" server, that never generates anything other than a 0. This means repeated application of
the combination/addition rule can never bring us to the dangerous state of numbers larger than 10.

``` haskell
goodServer, badServer :: Server Api
goodServer = server (pure $ A 0)
badServer = server (pure $ A 1)
```

In the test file, we first define the tests: the faulty server should fail and the good server should pass.

```haskell
main :: IO ()
main = hspec spec

spec :: Spec
spec = describe "example" $ do
  it "good server should not fail" $ do
    RS.fuzz @Api goodServer config
      >>= (`shouldSatisfy` isNothing)
  it "bad server should fail" $ do
    RS.fuzz @Api badServer config
      >>= (`shouldSatisfy` isJust)
```

The previous test just picked apart the server and ran functions manually: sometimes, we want to test via
an honest-to-goodness network port, like so:

```haskell
  around (withServer (serve (Proxy :: Proxy Api) badServer)) $ do
    it "we should also be able to run the _client_ to an independent server (ignore server error messages)" $ \(clientEnv::ClientEnv) -> do
      RC.fuzz @Api clientEnv config >>= (`shouldSatisfy` isJust)
```

(we use withApplication rather than testWithApplication because we don't primarily care what the server does here:
we want to check what a client does when presented with a faulty server.)

We expect to be able to cover the whole api from our starting point, so let's set the coverage to 0.99.
There are other tweakable things in the config, like maximum runtime, reps,
per-request healthchecks, seeds, and verbose logging. Have a look at
Roboservant.Types.Config for details.

``` haskell
config :: Config
config = defaultConfig
  { coverageThreshold = 0.99
  }
```

Unless we want to ship roboservant and all its dependencies to production, we also need
some orphan instances: because As are the only value we can get without
an input, we need to be able to break them down.

``` haskell
deriving via (Compound A) instance Breakdown A
```

if we wanted to assemble As from parts as well, we'd derive using Compound, but in this case we don't care.

``` haskell
deriving via (Atom A) instance BuildFrom A

```

Similarly, to generate the first B from the Ints we got from inside the A, we need to be able to
build it up from components.

```haskell
deriving via (Compound B) instance BuildFrom B
deriving via (Atom B) instance Breakdown B
```


test utilities:

``` haskell
withServer :: Application -> ActionWith ClientEnv -> IO ()
withServer app action = Warp.withApplication (pure app) (\p -> genClientEnv p >>= action)
  where genClientEnv port = do
          baseUrl <- parseBaseUrl "http://localhost"
          manager <- newManager defaultManagerSettings
          pure $ mkClientEnv manager (baseUrl { baseUrlPort = port })
```


<|start_filename|>src/Roboservant/Types/Internal.hs<|end_filename|>
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Roboservant.Types.Internal where

import qualified Data.Dependent.Map as DM
import Data.Dependent.Map (DMap)
import Data.Dependent.Sum
import Data.Dynamic (Dynamic, toDyn)
import Data.Hashable (Hashable, hash)
import Data.IntSet (IntSet)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.Map.Strict as Map
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import qualified Type.Reflection as R

data Provenance
  = Provenance R.SomeTypeRep Int
  deriving (Show, Eq, Generic)

instance Hashable Provenance

data StashValue a
  = StashValue
      { getStashValue :: NonEmpty ([Provenance], a),
        stashHash :: IntSet
      }
  deriving (Functor, Show)

-- wrap in newtype to give a custom Show instance, since the normal
-- instance for DMap is not happy since StashValue needs Show a to show
newtype Stash = Stash {getStash :: DMap R.TypeRep StashValue}
  deriving (Semigroup, Monoid)

instance Show Stash where
  showsPrec i (Stash x) =
    showsPrec i
      $ Map.fromList . map (\(tr :=> StashValue vs _) -> (R.SomeTypeRep tr, fmap fst vs))
      $ DM.toList x

-- | Can't be built up from parts, can't be broken down further.
newtype Atom x = Atom {unAtom :: x}
  deriving newtype (Hashable, Typeable)

-- | can be broken down and built up from generic pieces
newtype Compound x = Compound {unCompound :: x}
  deriving newtype (Hashable, Typeable)

hashedDyn :: (Hashable a, Typeable a) => a -> (Dynamic, Int)
hashedDyn a = (toDyn a, hash a)


<|start_filename|>src/Roboservant.hs<|end_filename|>
module Roboservant
  ( module Roboservant.Direct,
    module Roboservant.Types,
  )
where

import Roboservant.Direct
import Roboservant.Types


<|start_filename|>src/Roboservant/Types/Config.hs<|end_filename|>
module Roboservant.Types.Config where

import Data.Dynamic

data Config
  = Config
      { seed :: [(Dynamic, Int)],
        maxRuntime :: Double, -- seconds to test for
        maxReps :: Integer,
        rngSeed :: Int,
        coverageThreshold :: Double,
        logInfo :: String -> IO (),
        healthCheck :: IO ()
      }

defaultConfig :: Config
defaultConfig =
  Config
    { seed = [],
      maxRuntime = 0.5,
      maxReps = 1000,
      rngSeed = 0,
      coverageThreshold = 0,
      logInfo = const (pure ()),
      healthCheck = pure ()
    }

noisyConfig :: Config
noisyConfig = defaultConfig {logInfo = print}


<|start_filename|>Makefile<|end_filename|>
testwatch:
	ghcid -T main -c 'stack repl roboservant:lib roboservant:test:roboservant-test --test --ghc-options=-fobject-code' --allow-eval --restart="stack.yaml" --restart="package.yaml"  -W
pedanticwatch:
	ghcid -c 'stack repl --test --ghc-options=-fobject-code' --allow-eval --restart="stack.yaml" --restart="package.yaml"  -W
