{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} module Servant.EkgSpec (spec) where import Data.Aeson import qualified Data.HashMap.Strict as H import Data.Monoid ((<>)) import Data.Proxy import Data.Text import GHC.Generics import Network.HTTP.Client (defaultManagerSettings, newManager) import Network.Wai import Network.Wai.Handler.Warp import Servant import Servant.Client #if MIN_VERSION_servant(0,15,0) import Servant.Test.ComprehensiveAPI (comprehensiveAPI) #else import Servant.API.Internal.Test.ComprehensiveAPI (comprehensiveAPI) #endif import System.Metrics import Test.Hspec import Servant.Ekg #if !MIN_VERSION_servant_client(0,16,0) #define ClientError ServantError #endif -- * Spec spec :: Spec spec = describe "servant-ekg" $ do let getEp :<|> postEp :<|> deleteEp = client testApi it "collects number of request" $ withApp $ \port store -> do mgr <- newManager defaultManagerSettings let runFn :: ClientM a -> IO (Either ClientError a) runFn fn = runClientM fn (mkClientEnv mgr (BaseUrl Http "localhost" port "")) _ <- runFn $ getEp "name" Nothing _ <- runFn $ postEp (Greet "hi") _ <- runFn $ deleteEp "blah" m <- sampleAll store case H.lookup "servant.path.hello.:name.GET.responses.2XX" m of Nothing -> fail "Expected some value" Just v -> v `shouldBe` Counter 1 case H.lookup "servant.path.greet.POST.responses.2XX" m of Nothing -> fail "Expected some value" Just v -> v `shouldBe` Counter 1 case H.lookup "servant.path.greet.:greetid.DELETE.responses.2XX" m of Nothing -> fail "Expected some value" Just v -> v `shouldBe` Counter 1 it "is comprehensive" $ do _typeLevelTest <- monitorEndpoints comprehensiveAPI =<< newStore True `shouldBe` True it "enumerates the parts of an API correctly" $ enumerateEndpoints testApi `shouldBe` [ APIEndpoint ["hello",":name"] "GET", APIEndpoint ["greet"] "POST", APIEndpoint ["greet",":greetid"] "DELETE" ] -- * Example -- | A greet message data type newtype Greet = Greet { _msg :: Text } deriving (Generic, Show) instance FromJSON Greet instance ToJSON Greet -- API specification type TestApi = -- GET /hello/:name?capital={true, false} returns a Greet as JSON "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON] Greet -- POST /greet with a Greet as JSON in the request body, -- returns a Greet as JSON :<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet -- DELETE /greet/:greetid :<|> "greet" :> Capture "greetid" Text :> Delete '[JSON] NoContent testApi :: Proxy TestApi testApi = Proxy -- Server-side handlers. -- -- There's one handler per endpoint, which, just like in the type -- that represents the API, are glued together using :<|>. -- -- Each handler runs in the 'EitherT (Int, String) IO' monad. server :: Server TestApi server = helloH :<|> postGreetH :<|> deleteGreetH where helloH name Nothing = helloH name (Just False) helloH name (Just False) = return . Greet $ "Hello, " <> name helloH name (Just True) = return . Greet . toUpper $ "Hello, " <> name postGreetH = return deleteGreetH _ = return NoContent -- Turn the server into a WAI app. 'serve' is provided by servant, -- more precisely by the Servant.Server module. test :: Application test = serve testApi server withApp :: (Port -> Store -> IO a) -> IO a withApp a = do ekg <- newStore monitorEndpoints' <- monitorEndpoints testApi ekg withApplication (return $ monitorEndpoints' test) $ \p -> a p ekg