Benchmarking

bench/Main.hs

@@ -0,0 +1,42 @@
+{-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE DeriveGeneric        #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE PolyKinds            #-}
+{-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE TypeOperators        #-}
+module Main (main) where
+
+import           Control.Concurrent
+import           Data.Text                (Text)
+import           Network.Wai              (Application)
+import           Network.Wai.Handler.Warp
+import           Servant
+import           Servant.Ekg
+import           System.Metrics
+import           System.Process
+
+
+type BenchApi = "hello" :> Capture "name" Text :> Get '[JSON] Text
+
+benchApi :: Proxy BenchApi
+benchApi = Proxy
+
+server :: Server BenchApi
+server = return
+
+servantEkgServer :: IO Application
+servantEkgServer = do
+  store <- newStore
+  ms <- newMVar mempty
+  return $ monitorEndpoints benchApi store ms (serve benchApi server)
+
+benchApp :: IO Application -> IO ()
+benchApp app = withApplication app $ \port ->
+  callCommand $ "wrk -c 2 -d 10s -s bench/wrk.lua -t 2 'http://localhost:" ++ show port ++ "'"
+
+main :: IO ()
+main = do
+  putStrLn "Benchmarking servant-ekg"
+  benchApp servantEkgServer
+  putStrLn "Benchmarking without servant-ekg"
+  benchApp . return $ serve benchApi server

bench/wrk.lua

@@ -0,0 +1,7 @@
+counter = 0
+
+request = function()
+   path = "/hello/" .. counter
+   counter = counter + 1
+   return wrk.format(nil, path)
+end

lib/Servant/Ekg.hs

@@ -103,7 +103,8 @@ instance (HasEndpoint (a :: *), HasEndpoint (b :: *)) => HasEndpoint (a :<|> b)
         getEndpoint (Proxy :: Proxy a) req `mplus`
         getEndpoint (Proxy :: Proxy b) req
 
-instance (KnownSymbol (path :: Symbol), HasEndpoint (sub :: *)) => HasEndpoint (path :> sub) where
+instance (KnownSymbol (path :: Symbol), HasEndpoint (sub :: *))
+    => HasEndpoint (path :> sub) where
     getEndpoint _ req =
         case pathInfo req of
             p:ps | p == T.pack (symbolVal (Proxy :: Proxy path)) -> do
@@ -111,7 +112,8 @@ instance (KnownSymbol (path :: Symbol), HasEndpoint (sub :: *)) => HasEndpoint (
                 return (p:end, method)
             _ -> Nothing
 
-instance (KnownSymbol (capture :: Symbol), HasEndpoint (sub :: *)) => HasEndpoint (Capture capture a :> sub) where
+instance (KnownSymbol (capture :: Symbol), HasEndpoint (sub :: *))
+    => HasEndpoint (Capture capture a :> sub) where
     getEndpoint _ req =
         case pathInfo req of
             _:ps -> do

servant-ekg.cabal

@@ -47,3 +47,18 @@ test-suite spec
                     , hspec == 2.*
                     , unordered-containers
                     , transformers
+
+executable bench
+  hs-source-dirs: bench
+  main-is: Main.hs
+  ghc-options: -Wall -threaded -O2
+  build-depends:      base == 4.*
+                    , aeson
+                    , ekg
+                    , ekg-core
+                    , servant-ekg
+                    , servant-server
+                    , text
+                    , wai
+                    , warp >= 3.2.4 && < 3.3
+                    , process