过滤请求路径中与服务中的静态段匹配的部分。

Question

假设我运行的是一个带有两个端点的服务with服务器，其类型如下所示：

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/
   └─•

我可能希望使用类似网络，网络，中间件，普罗米修斯的instrumentHandlerValue的方法来生成Prometheus度量，每次调用该API时都会触发它，并将一个处理程序值设置为请求的路径。

但是，如果我这样做的话：

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

这是不好的，因为对book/<Name>端点的不同请求(例如book/great-expectations和book/vanity-fair )会产生不同的标签，如果书籍数量很少，那么如果它非常大，那么这些度量所使用的数据量非常大，或者我的服务结束了，或者我的监视账单变得非常大。

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

也就是说，对/books的请求将返回Just ["books"]，对/book/little-dorrit的请求将返回Just ["book", "Name"]，对/films的请求将返回Nothing。

我可以看到您如何通过Router'上的Servant.Server.Internal.Router模式匹配来编写这篇文章，但我不清楚依靠内部包来实现这一点是否是个好主意。

有更好的办法吗？

Answer 1

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

解析器类型可以类似于：

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

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

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

这种类型有一个Alternative实例，其中failure丢弃状态(基本上是回溯)，MonadFail实例在do-blocks中模式匹配失败时返回mzero。

典型：

{-# 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)

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"]