Add testsuite to make sure it is usable

ekg-servant.cabal

@@ -26,3 +26,19 @@ library
                      , unordered-containers
                      , wai
   default-language:    Haskell2010
+
+test-suite spec
+  type: exitcode-stdio-1.0
+  ghc-options: -Wall
+  default-language: Haskell2010
+  hs-source-dirs: test
+  main-is: test.hs
+  build-depends:      base == 4.*
+                    , aeson
+                    , ekg
+                    , ekg-core
+                    , ekg-servant
+                    , servant-server
+                    , text
+                    , wai
+                    , warp

lib/Servant/Ekg.hs

@@ -18,7 +18,7 @@ import qualified Data.Text                   as T
 import qualified Data.Text.Encoding          as T
 import           Data.Time.Clock
 import           GHC.TypeLits
-import           Network.HTTP.Types
+import           Network.HTTP.Types          (Method, Status (..))
 import           Network.Wai
 import           Servant.API
 import           System.Metrics
@@ -53,7 +53,7 @@ responseTimeDistribution dist application request respond =
     stop t1 = do
         t2 <- getCurrentTime
         let dt = diffUTCTime t2 t1
-        Distribution.add dist $ fromRational $ toRational dt
+        Distribution.add dist $ fromRational $ (*1000) $ toRational dt
 
 data Meters = Meters
     { metersInflight :: Gauge.Gauge
@@ -82,7 +82,7 @@ monitorEndpoints proxy store meters application request respond = do
             metersC4XX <- createCounter (prefix <> "responses.4XX") store
             metersC5XX <- createCounter (prefix <> "responses.5XX") store
             metersCXXX <- createCounter (prefix <> "responses.XXX") store
-            metersTime <- createDistribution (prefix <> "time") store
+            metersTime <- createDistribution (prefix <> "time_ms") store
             let m = Meters{..}
             return (H.insert path m ms, m)
         Just m -> return (ms,m)
@@ -118,7 +118,16 @@ instance (KnownSymbol (capture :: Symbol), HasEndpoint (sub :: *)) => HasEndpoin
                 return (p:end, method)
             _ -> Nothing
 
-instance HasEndpoint (sub :: *) => HasEndpoint ((a :: *) :> sub) where
+instance HasEndpoint (sub :: *) => HasEndpoint (Header h a :> sub) where
+    getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
+
+instance HasEndpoint (sub :: *) => HasEndpoint (QueryParam (h :: Symbol) a :> sub) where
+    getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
+
+instance HasEndpoint (sub :: *) => HasEndpoint (QueryParams (h :: Symbol) a :> sub) where
+    getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
+
+instance HasEndpoint (sub :: *) => HasEndpoint (ReqBody a :> sub) where
     getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
 
 instance HasEndpoint (Get a) where

test/test.hs

@@ -0,0 +1,74 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverlappingInstances #-}
+
+import Control.Concurrent
+import Data.Aeson
+import Data.Monoid
+import Data.Proxy
+import Data.Text
+import GHC.Generics
+import Network.Wai
+import Network.Wai.Handler.Warp
+import System.Metrics
+import Servant
+
+import Servant.Ekg
+
+-- * 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 Greet
+
+       -- POST /greet with a Greet as JSON in the request body,
+       --             returns a Greet as JSON
+  :<|> "greet" :> ReqBody Greet :> Post Greet
+
+       -- DELETE /greet/:greetid
+  :<|> "greet" :> Capture "greetid" Text :> Delete
+
+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 greet = return greet
+
+        deleteGreetH _ = return ()
+
+-- 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
+
+-- Put this all to work!
+main :: IO ()
+main = do
+    ekg <- newStore
+    ms <- newMVar mempty
+    _ <- forkIO $ run 8001 $ monitorEndpoints testApi ekg ms test
+    return ()