diff --git a/CHANGELOG.md b/CHANGELOG.md index 6259498..678cf9f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,16 @@ Unreleased ========== +1.3.0 +======= + +- Add an `HasEndpoint` instance for `RawM` +- Add an `HasEndpoint` instance for `WithResource` +- Fix `HasEndpoint` instance for `CaptureAll` + - Previously paths would never be matched since the instance + did not consume the rest of the path like `CaptureAll` does. + The rest of the path is now captured and replaced with a `*` + place holder and this is also the case for enumerating the endpoint. 1.2.0 ======= diff --git a/lib/Prometheus/Servant/Internal.hs b/lib/Prometheus/Servant/Internal.hs index 7cbf7f9..3d642ea 100644 --- a/lib/Prometheus/Servant/Internal.hs +++ b/lib/Prometheus/Servant/Internal.hs @@ -225,11 +225,30 @@ instance HasEndpoint Raw where enumerateEndpoints _ = [Endpoint [] "RAW"] instance HasEndpoint (sub :: Type) => HasEndpoint (CaptureAll (h :: Symbol) a :> sub) where + getEndpoint _ req = + case pathInfo req of + [] -> Nothing + _ -> do + Endpoint{..} <- getEndpoint (Proxy :: Proxy sub) req{pathInfo = []} + pure $ Endpoint ("*" : ePathSegments) eMethod + + enumerateEndpoints _ = do + let qualify Endpoint{..} = Endpoint ("*" : ePathSegments) eMethod + map qualify $ enumerateEndpoints (Proxy :: Proxy sub) + +instance HasEndpoint (sub :: Type) => HasEndpoint (BasicAuth (realm :: Symbol) a :> sub) where getEndpoint _ = getEndpoint (Proxy :: Proxy sub) enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub) -instance HasEndpoint (sub :: Type) => HasEndpoint (BasicAuth (realm :: Symbol) a :> sub) where +#if MIN_VERSION_servant(0,20,0) +instance HasEndpoint (sub :: Type) => HasEndpoint (WithResource a :> sub) where getEndpoint _ = getEndpoint (Proxy :: Proxy sub) enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub) + +instance HasEndpoint RawM where + getEndpoint _ _ = Just (Endpoint [] "RAW") + + enumerateEndpoints _ = [Endpoint [] "RAW"] +#endif diff --git a/package.yaml b/package.yaml index 5b824a6..adc7bbd 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: servant-prometheus -version: 1.2.0 +version: 1.3.0 github: worm2fed/servant-prometheus synopsis: Helpers for using prometheus with servant description: Please see the README on GitHub at @@ -71,18 +71,18 @@ ghc-options: - -Wno-implicit-prelude dependencies: - - base >=4.10 && < 4.18 + - base >=4.10 && < 4.21 library: source-dirs: lib dependencies: - clock >= 0.8.3 && < 0.9 - - ghc-prim >= 0.8.0 && < 0.10 - - hashable >= 1.4.2 && < 1.5 + - ghc-prim >= 0.8.0 && < 0.12 + - hashable >= 1.4.2 && < 1.6 - http-types >= 0.12.3 && < 0.13 - prometheus-client >= 1.1.0 && < 1.2 - - servant >= 0.14 && < 0.20 - - text >= 1.2.5 && < 2.1 + - servant >= 0.14 && < 0.21 + - text >= 1.2.5 && < 2.2 - wai >= 3.2.3 && < 3.3 tests: @@ -97,18 +97,19 @@ tests: dependencies: - servant-prometheus - - aeson >= 2.0 && < 2.2 - - containers >= 0.6.5 && < 0.7 + - aeson >= 2.0 && < 2.3 + - containers >= 0.6.5 && < 0.8 - hspec >= 2 && < 3 - hspec-expectations-pretty-diff >= 0.7.2.2 && < 0.8 - http-client >= 0.7.13 && < 0.8 + - http-types >=0.12.4 && <0.13 - prometheus-client - servant - - servant-client >= 0.14 && < 0.20 - - servant-server >= 0.14 && < 0.20 + - servant-client >= 0.14 && < 0.21 + - servant-server >= 0.14 && < 0.21 - text - wai - - warp >= 3.2.4 && < 3.4 + - warp >= 3.2.4 && < 3.5 benchmarks: bench: diff --git a/servant-prometheus.cabal b/servant-prometheus.cabal index e1cf05f..12afefe 100644 --- a/servant-prometheus.cabal +++ b/servant-prometheus.cabal @@ -5,7 +5,7 @@ cabal-version: 2.4 -- see: https://github.com/sol/hpack name: servant-prometheus -version: 1.2.0 +version: 1.3.0 synopsis: Helpers for using prometheus with servant description: Please see the README on GitHub at category: Servant, Web, System @@ -87,6 +87,7 @@ test-suite spec , hspec ==2.* , hspec-expectations-pretty-diff >=0.7.2.2 && <0.8 , http-client >=0.7.13 && <0.8 + , http-types >=0.12.4 && <0.13 , prometheus-client , servant , servant-client >=0.14 && <0.21 diff --git a/test/Prometheus/ServantSpec.hs b/test/Prometheus/ServantSpec.hs index ed67e6f..0e9d3ef 100644 --- a/test/Prometheus/ServantSpec.hs +++ b/test/Prometheus/ServantSpec.hs @@ -6,11 +6,15 @@ import Data.Text (Text) import Data.Text qualified as T import GHC.Generics (Generic) import Network.HTTP.Client (defaultManagerSettings, newManager) +import Network.HTTP.Types.Method (methodGet) +import Network.HTTP.Types.Status (ok200) import Network.Wai (Application) +import Network.Wai qualified as Wai import Network.Wai.Handler.Warp (Port, withApplication) import Prometheus qualified as P import Servant ( Capture + , CaptureAll , Delete , Get , JSON @@ -18,12 +22,14 @@ import Servant , Post , Proxy (..) , QueryParam + , Raw , ReqBody , Server , serve , (:<|>) (..) , (:>) ) +import Servant qualified import Servant.Client ( BaseUrl (..) , ClientError @@ -44,7 +50,7 @@ import Prometheus.Servant.Internal (Endpoint (..), HasEndpoint (..)) spec :: Spec spec = describe "servant-prometheus" $ do - let getEp :<|> postEp :<|> deleteEp = client testApi + let getEp :<|> postEp :<|> deleteEp :<|> proxyEp = client testApi it "collects number of request" $ withApp $ \port -> do @@ -54,6 +60,7 @@ spec = describe "servant-prometheus" $ do _ <- runFn $ getEp "name" Nothing _ <- runFn $ postEp (Greet "hi") _ <- runFn $ deleteEp "blah" + _ <- runFn $ proxyEp ["some", "proxy", "route"] methodGet let Metrics{..} = defaultMetrics latencies <- P.getVectorWith mLatency P.getHistogram @@ -61,9 +68,10 @@ spec = describe "servant-prometheus" $ do `shouldBe` [ ("/greet", "POST", "200") , ("/greet/:greetid", "DELETE", "200") , ("/hello/:name", "GET", "200") + , ("/proxy/*", "RAW", "200") ] map (sum . map snd . Map.toList . snd) latencies - `shouldBe` [1, 1, 1] + `shouldBe` [1, 1, 1, 1] it "is comprehensive" $ do let !_typeLevelTest = prometheusMiddleware defaultMetrics comprehensiveAPI @@ -74,6 +82,7 @@ spec = describe "servant-prometheus" $ do `shouldBe` [ Endpoint ["hello", ":name"] "GET" , Endpoint ["greet"] "POST" , Endpoint ["greet", ":greetid"] "DELETE" + , Endpoint ["proxy", "*"] "RAW" ] -- * Example @@ -94,6 +103,8 @@ type TestApi = :<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet -- DELETE /greet/:greetid :<|> "greet" :> Capture "greetid" Text :> Delete '[JSON] NoContent + -- GET /proxy/some/proxy/route + :<|> "proxy" :> CaptureAll "proxyRoute" Text :> Raw testApi :: Proxy TestApi testApi = Proxy @@ -105,7 +116,7 @@ testApi = Proxy -- -- Each handler runs in the 'EitherT (Int, String) IO' monad. server :: Server TestApi -server = helloH :<|> postGreetH :<|> deleteGreetH +server = helloH :<|> postGreetH :<|> deleteGreetH :<|> proxyH where helloH name Nothing = helloH name (Just False) helloH name (Just False) = pure . Greet $ "Hello, " <> name @@ -115,6 +126,9 @@ server = helloH :<|> postGreetH :<|> deleteGreetH deleteGreetH _ = pure NoContent + proxyH :: [Text] -> Servant.Tagged Servant.Handler Wai.Application + proxyH _ = Servant.Tagged $ \_ responder -> responder $ Wai.responseLBS ok200 [] "success" + -- | Turn the server into a WAI app. 'serve' is provided by servant, -- more precisely by the Servant.Server module. test :: Application