Отфильтруйте части пути запроса, которые соответствуют статическому сегменту в Servant

Question

Предположим, у меня запущен веб-сервер 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/
   └─•

Возможно, я захочу использовать что-то вроде toolHandlerValue Network.Wai.Middleware.Prometheus для генерации метрики Prometheus, которая срабатывает каждый раз, когда этот API вызывается, со значением обработчика, установленным на путь запроса.

Однако, если я сделаю что-то вроде следующего:

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

Это плохо, потому что разные запросы к book/<Name> конечная точка, например book/great-expectations и book/vanity-fair Если количество книг невелико, это нормально, но если оно очень большое, то объем данных, используемых этими метриками, очень велик, и либо моя услуга падает, либо мой счет за мониторинг становится очень большим.

Мне бы очень хотелось, чтобы функция принимала Servant API и Wai Request, и, если они совпадали, возвращала список сегментов в форме, одинаковой для каждой конечной точки.

Это запросы к /books вернется Just ["books"], запросы к /book/little-dorrit вернется Just ["book", "Name"], и запросы к /films вернется Nothing.

Я могу понять, как вы могли бы написать это, сопоставив шаблон на Router'от Servant.Server.Internal.Router , но мне не ясно, что полагаться на внутренний пакет для этого - хорошая идея.

Есть ли способ лучше?

Answer 1

The pathInfoфункция возвращает все сегменты пути дляRequest. Возможно, мы могли бы определить класс типов, который, учитывая Servant API, производил бы «парсер» для списка сегментов, результатом которого была бы отформатированная версия списка.

Тип парсера может быть примерно таким:

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

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

Где первый [Text]в состоянии находятся сегменты пути, которые еще предстоит проанализировать, а во втором — отформатированные сегменты пути, которые мы уже накопили.

Этот тип имеет Alternativeэкземпляр, где сбой отбрасывает состояние (в основном возврат) иMonadFailэкземпляр, который возвращаетmzeroпри сбое сопоставления с образцом внутри do-блоки.

Класс типов:

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