4

假设我正在运行一个具有两个端点的 Servant 网络服务器，其类型如下所示：

type BookAPI =
  "books" :> Get '[JSON] (Map Text Text)
    :<|> "book" :> Capture "Name" Text :> ReqBody '[JSON] (Text) :> Post '[JSON] (Text)

λ:T.putStrLn $ layout (Proxy :: Proxy BookAPI)
/
├─ book/
│  └─ <capture>/
│     └─•
└─ books/
   └─•

我可能想使用Network.Wai.Middleware.Prometheus 的 instrumentHandlerValue 之类的东西来生成每次调用此 API 时都会触发的 Prometheus 指标，并将处理程序值设置为请求的路径。

但是，如果我执行以下操作：

prometheusMiddlware = instrumentHandlerValue (T.intercalate "\\" . pathInfo)

这很糟糕，因为对端点的不同请求book/<Name>，例如book/great-expectations和book/vanity-fair导致不同的标签，如果书籍数量很少，这很好，但如果它非常大，那么这些指标使用的数据量非常大，要么我的服务崩溃了，或者我的监控账单变得非常大。

我非常想要一个函数，它接受一个仆人 API 和一个 Wai 请求，如果匹配，则以每个端点相同的形式返回一个段列表。

即 requests to/books将返回Just ["books"]， requests to/book/little-dorrit将返回Just ["book", "Name"]， requests to/films将返回Nothing。

我可以看到您如何通过Router'来自Servant.Server.Internal.Router的模式匹配来编写此代码，但我不清楚依靠内部包来执行此操作是个好主意。

有没有更好的办法？

4

1 回答 1

1

该pathInfo函数返回 a 的所有路径段Request。也许我们可以定义一个类型类，给定一个 Servant API，为段列表生成一个“解析器”，其结果将是列表的格式化版本。

解析器类型可能类似于：

import Data.Text 
import Control.Monad.State.Strict
import Control.Applicative

type PathParser = StateT ([Text],[Text]) Maybe ()

其中[Text]状态中的第一个是尚未解析的路径段，第二个是我们迄今为止积累的格式化路径段。

这种类型有一个Alternative实例，其中失败丢弃状态（基本上是回溯）和一个在-blocks内的模式匹配失败MonadFail时返回的实例。mzerodo

类型类：

{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
import Data.Data ( Proxy )
import GHC.TypeLits

class HasPathParser (x :: k) where
    pathParser :: Proxy x -> PathParser

的实例Symbol将路径片段从待处理列表移动到已处理列表：

instance KnownSymbol piece => HasPathParser (piece :: Symbol) where
  pathParser _ = do
      (piece : rest, found) <- get -- we are using MonadFail here
      guard (piece == Data.Text.pack (symbolVal (Proxy @piece)))
      put (rest, piece : found)

for 的实例Capture将路径变量的名称（而不是值）放在已处理列表中：

instance KnownSymbol name => HasPathParser (Capture name x) where
  pathParser _ = do
      (_ : rest, found) <- get  -- we are using MonadFail here
      put (rest, Data.Text.pack (symbolVal (Proxy @name)) : found)

当我们到达Verb( GET, POST...) 时，我们要求不应保留任何待处理的路径片段：

instance HasPathParser (Verb method statusCode contextTypes a) where
  pathParser _ = do
      ([], found) <- get -- we are using MonadFail here
      put ([], found)

其他一些情况：

instance HasPathParser (ReqBody x y) where
  pathParser _ = pure ()

instance (HasPathParser a, HasPathParser b) => HasPathParser (a :> b) where
  pathParser _ = pathParser (Proxy @a) *> pathParser (Proxy @b)

instance (HasPathParser a, HasPathParser b) => HasPathParser (a :<|> b) where
  pathParser _ = pathParser (Proxy @a) <|> pathParser (Proxy @b)

让它发挥作用：

main :: IO ()
main = do
    do let Just ([], result) = execStateT (pathParser (Proxy @BookAPI)) (["books"],[])
       print result
       -- ["books"]
    do let Just ([], result) = execStateT (pathParser (Proxy @BookAPI)) (["book", "somebookid"],[])
       print result
       -- ["Name","book"]
于 2021-12-29T20:20:25.863 回答