Merge pull request #11 from haskell-servant/servant-0.16

Servant 0.16
2024-11-22 19:19:43 +01:00 · 2019-02-28 09:07:34 +02:00 · 2019-02-28 09:07:34 +02:00 · 65fae84ae6
commit 65fae84ae6
parent 8f5e9ad2bb 9c5a6ce1a3
7 changed files with 137 additions and 75 deletions
--- a/.travis.yml
+++ b/.travis.yml
@ -1,6 +1,6 @@
 # This Travis job script has been generated by a script via
 #
-#   haskell-ci '--output=.travis.yml' '--branches=master' 'cabal.project'
+#   haskell-ci '--output=.travis.yml' '--config=cabal.haskell-ci' 'cabal.project'
 #
 # For more information, see https://github.com/haskell-CI/haskell-ci
 #
@ -20,68 +20,66 @@ cache:
    - $HOME/.cabal/store

 before_cache:
-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
+  - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log
  # remove files that are regenerated by 'cabal update'
-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*
-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json
-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache
-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar
-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx
+  - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*
+  - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json
+  - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache
+  - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar
+  - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx

-  - rm -rfv $HOME/.cabal/packages/head.hackage
+  - rm -rfv $CABALHOME/packages/head.hackage

 matrix:
  include:
    - compiler: "ghc-8.6.3"
-    # env: TEST=--disable-tests BENCH=--disable-benchmarks
      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.6.3], sources: [hvr-ghc]}}
    - compiler: "ghc-8.4.4"
-    # env: TEST=--disable-tests BENCH=--disable-benchmarks
      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.4.4], sources: [hvr-ghc]}}
    - compiler: "ghc-8.2.2"
-    # env: TEST=--disable-tests BENCH=--disable-benchmarks
      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.2.2], sources: [hvr-ghc]}}
    - compiler: "ghc-8.0.2"
-    # env: TEST=--disable-tests BENCH=--disable-benchmarks
      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.0.2], sources: [hvr-ghc]}}

 before_install:
-  - HC=${CC}
+  - HC=/opt/ghc/bin/${CC}
+  - HCVER=$(echo "$TRAVIS_COMPILER" | sed 's/ghc-//')
+  - echo $HCVER
  - HCPKG=${HC/ghc/ghc-pkg}
  - unset CC
+  - CABAL=/opt/ghc/bin/cabal
+  - CABALHOME=$HOME/.cabal
+  - export PATH="$CABALHOME/bin:$PATH"
  - ROOTDIR=$(pwd)
-  - mkdir -p $HOME/.local/bin
-  - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH"
  - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))
  - echo $HCNUMVER

 install:
-  - cabal --version
+  - ${CABAL} --version
  - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
-  - BENCH=${BENCH---enable-benchmarks}
-  - TEST=${TEST---enable-tests}
-  - HADDOCK=${HADDOCK-true}
-  - UNCONSTRAINED=${UNCONSTRAINED-true}
-  - NOINSTALLEDCONSTRAINTS=${NOINSTALLEDCONSTRAINTS-false}
+  - TEST=--enable-tests
+  - BENCH=--enable-benchmarks
  - GHCHEAD=${GHCHEAD-false}
-  - travis_retry cabal update -v
-  - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config"
+  - if [ "$TRAVIS_OS_NAME" = "windows" ]; then export CABALHOME=$APPDATA/cabal; else export CABALHOME=$HOME/.cabal; fi
+  - travis_retry ${CABAL} update -v
+  - sed -i.bak 's/^jobs:/-- jobs:/' $CABALHOME/config
  - rm -fv cabal.project cabal.project.local
-  - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'
-  - "printf 'packages: \".\"\\n' > cabal.project"
+  - grep -Ev -- '^\s*--' $CABALHOME/config | grep -Ev '^\s*$'
+  - rm -f cabal.project
+  - touch cabal.project
+  - "printf 'packages: \".\"\\n' >> cabal.project"
  - "printf 'write-ghc-environment-files: always\\n' >> cabal.project"
-  - "echo 'reorder-goals: True' >> cabal.project"
-  - "echo 'max-backjumps: 100' >> cabal.project"
  - touch cabal.project.local
-  - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg  | grep -vw -- servant-ekg | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi"
+  - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(servant-ekg)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
  - cat cabal.project || true
  - cat cabal.project.local || true
-  - if [ -f "./configure.ac" ]; then
-      (cd "." && autoreconf -i);
-    fi
+  - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi
  - rm -f cabal.project.freeze
-  - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all
-  - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all
+  - ${CABAL} new-freeze -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dry
+  - "cat \"cabal.project.freeze\" | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"
+  - rm  "cabal.project.freeze"
+  - ${CABAL} new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all
+  - ${CABAL} new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all
  - rm -rf .ghc.environment.* "."/dist
  - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)

@ -89,33 +87,43 @@ install:
 # any command which exits with a non-zero exit code causes the build to fail.
 script:
  # test that source-distributions can be generated
-  - cabal new-sdist all
+  - ${CABAL} new-sdist all
  - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/
  - cd ${DISTDIR} || false
  - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;
-  - "printf 'packages: servant-ekg-*/*.cabal\\n' > cabal.project"
+  - rm -f cabal.project
+  - touch cabal.project
+  - "printf 'packages: \"servant-ekg-*/*.cabal\"\\n' >> cabal.project"
  - "printf 'write-ghc-environment-files: always\\n' >> cabal.project"
-  - "echo 'reorder-goals: True' >> cabal.project"
-  - "echo 'max-backjumps: 100' >> cabal.project"
  - touch cabal.project.local
-  - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg  | grep -vw -- servant-ekg | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi"
+  - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(servant-ekg)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
  - cat cabal.project || true
  - cat cabal.project.local || true
  # this builds all libraries and executables (without tests/benchmarks)
-  - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all
+  - ${CABAL} new-build -w ${HC} --disable-tests --disable-benchmarks all

  # build & run tests, build benchmarks
-  - cabal new-build -w ${HC} ${TEST} ${BENCH} all
-  - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} ${BENCH} all; fi
+  - ${CABAL} new-build -w ${HC} ${TEST} ${BENCH} all
+  - if [ "x$TEST" = "x--enable-tests" ]; then ${CABAL} new-test -w ${HC} ${TEST} ${BENCH} all; fi

  # cabal check
-  - (cd servant-ekg-* && cabal check)
+  - (cd servant-ekg-* && ${CABAL} check)

  # haddock
-  - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi
+  - ${CABAL} new-haddock -w ${HC} ${TEST} ${BENCH} all

  # Build without installed constraints for packages in global-db
-  - if $UNCONSTRAINED; then rm -f cabal.project.local; cabal new-build -w ${HC} --disable-tests --disable-benchmarks all; else echo "Not building without installed constraints"; fi
+  - rm -f cabal.project.local; ${CABAL} new-build -w ${HC} --disable-tests --disable-benchmarks all;

-# REGENDATA ["--output=.travis.yml","--branches=master","cabal.project"]
+  # Constraint sets
+  - rm -rf cabal.project.local
+
+  # Constraint set servant-0.15
+  - ${CABAL} new-build -w ${HC} --disable-tests --disable-benchmarks  --constraint='servant ==0.15.*' all
+
+  # Constraint set servant-0.16
+  - ${CABAL} new-build -w ${HC} --disable-tests --disable-benchmarks  --constraint='servant ==0.16.*' all
+
+
+# REGENDATA ["--output=.travis.yml","--config=cabal.haskell-ci","cabal.project"]
 # EOF
--- a/README.md
+++ b/README.md
@ -0,0 +1,41 @@
+# servant-ekg
+
+[![Build Status](https://travis-ci.org/haskell-servant/servant-ekg.png)](https://travis-ci.org/haskell-servant/servant-ekg)
+
+# Servant Performance Counters
+
+This package lets you track peformance counters for each of your Servant endpoints using EKG.
+
+# Usage
+
+Servant-EKG knows how to handle all official Servant combinators out of the box.
+
+## Instrumenting your API
+To use Servant-EKG, you'll need to wrap your WAI application with the Servant-EKG middleware.
+
+```
+import Network.Wai.Handler.Warp
+import System.Metrics
+import Servant.Ekg
+
+wrapWithEkg :: Proxy api -> Server api -> IO Application
+wrapWithEkg api server = do
+  store   <- newStore
+  metrics <- newMVar mempty
+
+  return $ monitorEndpoints api store metrics (serve api server)
+
+main :: IO ()
+main = do
+  let api    = ...
+      server = ...
+
+  app <- wrapWithEkg api server
+
+  run 8080 app
+```
+
+## Runtime overhead
+Instrumenting your API introduces a non-zero runtime overhead, on the order of 200 - 600 µsec depending upon your machine. It's a good idea to run the benchmarks on your intended production platform to get an idea of how large the overhead will be. You'll need to have `wrk` installed to run the benchmarks.
+
+In general, the runtime overhead should be effectively negligible if your handlers are issuing network requests, such as to databases. If you have handlers that are small, CPU-only, and requested frequently, you will see a performance hit from Servant-EKG.
--- a/cabal.haskell-ci
+++ b/cabal.haskell-ci
@ -0,0 +1,9 @@
+branches: master
+
+constraint-set servant-0.15
+  ghc: >= 8.0 && <8.8
+  constraints: servant ==0.15.*
+
+constraint-set servant-0.16
+  ghc: >= 8.0 && <8.8
+  constraints: servant ==0.16.*
--- a/cabal.project
+++ b/cabal.project
@ -1,3 +1 @@
 packages: .
-reorder-goals: True
-max-backjumps: 100
--- a/lib/Servant/Ekg.hs
+++ b/lib/Servant/Ekg.hs
@ -4,10 +4,10 @@
 {-# LANGUAGE FlexibleInstances   #-}
 {-# LANGUAGE KindSignatures      #-}
 {-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE PolyKinds           #-}
 {-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeOperators       #-}
-{-# LANGUAGE PolyKinds           #-}
 module Servant.Ekg where

 import           Control.Concurrent.MVar
@ -116,6 +116,7 @@ instance (KnownSymbol (path :: Symbol), HasEndpoint (sub :: *))
                return (p:end, method)
            _ -> Nothing

+
 instance (KnownSymbol (capture :: Symbol), HasEndpoint (sub :: *))
    => HasEndpoint (Capture' mods capture a :> sub) where
    getEndpoint _ req =
@ -147,8 +148,10 @@ instance HasEndpoint (sub :: *) => HasEndpoint (QueryFlag h :> sub) where
 instance HasEndpoint (sub :: *) => HasEndpoint (ReqBody' mods cts a :> sub) where
    getEndpoint _ = getEndpoint (Proxy :: Proxy sub)

+#if MIN_VERSION_servant(0,15,0)
 instance HasEndpoint (sub :: *) => HasEndpoint (StreamBody' mods framing ct a :> sub) where
    getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
+#endif

 instance HasEndpoint (sub :: *) => HasEndpoint (RemoteHost :> sub) where
    getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
@ -168,19 +171,17 @@ instance HasEndpoint (sub :: *) => HasEndpoint (WithNamedContext x y sub) where
 instance ReflectMethod method => HasEndpoint (Verb method status cts a) where
    getEndpoint _ req = case pathInfo req of
        [] | requestMethod req == method -> Just ([], method)
-        _ -> Nothing
+        _                                -> Nothing
      where method = reflectMethod (Proxy :: Proxy method)

 instance ReflectMethod method => HasEndpoint (Stream method status framing ct a) where
    getEndpoint _ req = case pathInfo req of
        [] | requestMethod req == method -> Just ([], method)
-        _ -> Nothing
+        _                                -> Nothing
      where method = reflectMethod (Proxy :: Proxy method)

-instance HasEndpoint (Raw) where
+instance HasEndpoint Raw where
    getEndpoint _ _ = Just ([],"RAW")

-#if MIN_VERSION_servant(0,8,1)
 instance HasEndpoint (sub :: *) => HasEndpoint (CaptureAll (h :: Symbol) a :> sub) where
    getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
-#endif
--- a/servant-ekg.cabal
+++ b/servant-ekg.cabal
@ -1,6 +1,6 @@
 cabal-version: >=1.10
 name:          servant-ekg
-version:       0.2.1.0
+version:       0.2.2.0
 synopsis:      Helpers for using ekg with servant
 description:   Helpers for using ekg with servant, e.g.. counters per endpoint.
 license:       BSD3
@ -24,13 +24,13 @@ library
  hs-source-dirs:   lib
  build-depends:
      base                  >=4.9      && <4.13
-    , ekg-core              >=0.1.1.6  && <0.2
+    , ekg-core              >=0.1.1.4  && <0.2
    , http-types            >=0.12.2   && <0.13
-    , servant               >=0.15     && <0.16
+    , servant               >=0.14     && <0.17
    , text                  >=1.2.3.0  && <1.3
    , time                  >=1.6.0.1  && <1.9
    , unordered-containers  >=0.2.9.0  && <0.3
-    , wai                   >=3.2.2    && <3.3
+    , wai                   >=3.2.0    && <3.3

  default-language: Haskell2010

--- a/test/Servant/EkgSpec.hs
+++ b/test/Servant/EkgSpec.hs
@ -1,32 +1,41 @@
-{-# LANGUAGE CPP                  #-}
-{-# LANGUAGE DataKinds            #-}
-{-# LANGUAGE DeriveGeneric        #-}
-{-# LANGUAGE OverloadedStrings    #-}
-{-# LANGUAGE PolyKinds            #-}
-{-# LANGUAGE TypeFamilies         #-}
-{-# LANGUAGE TypeOperators        #-}
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PolyKinds         #-}
+{-# LANGUAGE RankNTypes        #-}
+{-# LANGUAGE TypeFamilies      #-}
+{-# LANGUAGE TypeOperators     #-}

 module Servant.EkgSpec (spec) where

 import           Control.Concurrent
 import           Data.Aeson
-import           Data.Monoid
+import qualified Data.HashMap.Strict                        as H
+import           Data.Monoid                                ((<>))
 import           Data.Proxy
-import qualified Data.HashMap.Strict as H
 import           Data.Text
 import           GHC.Generics
-import           Network.HTTP.Client (defaultManagerSettings, newManager)
+import           Network.HTTP.Client                        (defaultManagerSettings,
+                                                             newManager)
 import           Network.Wai
 import           Network.Wai.Handler.Warp
 import           Servant
 import           Servant.Client
-import           Servant.Test.ComprehensiveAPI (comprehensiveAPI)
+#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 qualified System.Metrics.Counter as Counter
+import qualified System.Metrics.Counter                     as Counter
 import           Test.Hspec

 import           Servant.Ekg

+#if !MIN_VERSION_servant_client(0,16,0)
+#define ClientError ServantError
+#endif

 -- * Spec

@ -35,10 +44,10 @@ spec = describe "servant-ekg" $ do

  let getEp :<|> postEp :<|> deleteEp = client testApi

-  it "collects number of request" $ do
+  it "collects number of request" $
    withApp $ \port mvar -> do
      mgr <- newManager defaultManagerSettings
-      let runFn :: ClientM a -> IO (Either ServantError a)
+      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")
@ -98,11 +107,7 @@ server = helloH :<|> postGreetH :<|> deleteGreetH

        postGreetH = return

-#if MIN_VERSION_servant(0,8,0)
        deleteGreetH _ = return NoContent
-#else
-        deleteGreetH _ = return ()
-#endif

 -- Turn the server into a WAI app. 'serve' is provided by servant,
 -- more precisely by the Servant.Server module.