Question

我想获得与我的处理程序相对应的当前路线。这是我的服务器的模型仅供参考：

type ServerAPI = 
         "route01" :> Get '[HTML] Text
    :<|> "route02" :> "subroute" :> Get '[HTML] Text
    :<|> "route03" :> Get '[HTML] Text

以下是一些处理程序：

route1and2Handler :: Handler Text
route1and2Handler = do
    route <- getCurrentRoute
    addVisitCountForRouteToDatabaseOrSomethingOfThatSort...
    return template

route3Handler :: Handler Text
route3Handler = return "Hello, I'm route 03"

我的服务器：

server :: Server ServerAPI
server = route1and2Handler :<|> route1and2Handler :<|> route3Handler

所以，基本上我的route1and2Handler应该有一些获得当前路线的方法。我已经尝试通过实现HasServer实例来获取请求对象到我的处理程序并从中提取url：

data FullRequest

instance HasServer a => HasServer (FullRequest :> a) where
    type Server (FullRequest :> a) = Request -> Server a
    route Proxy subserver request respond =
        route (Proxy :: Proxy a) (subserver request) request respond

[编辑] 我刚刚注意到我正在查看api旧版本的仆人，这已经无效了。新route的类型签名为route :: Proxy api -> Context context -> Delayed env (Server api) -> Router env，我真的没有办法从这里获取Request。

而不是将route1and2Handler类型签名设为Request -> Handler Text，但在尝试创建HasServer实例时遇到此错误：

`Server' is not a (visible) associated type of class `HasServer'

最后要指出的是，我的最终目标是从Handler中获取当前路线，在数据库中添加路线访问次数只是为了举例。我对计算访问次数或类似事件的方式不感兴趣。

Answer 1

一个问题有两个：

如何获取当前的请求或URL？
如何获取当前的“路线”？

请注意，URL（例如/route12/42）与路由不同（例如`“” route12“：>捕获” id“ Int：>获取'[JSON] Int）。让我们看看如何在解决了这两个问题之后简短的语言注释和导入部分。

{-# LANGUAGE ConstraintKinds         #-}
{-# LANGUAGE DataKinds               #-}
{-# LANGUAGE DeriveGeneric           #-}
{-# LANGUAGE FlexibleContexts        #-}
{-# LANGUAGE FlexibleInstances       #-}
{-# LANGUAGE MultiParamTypeClasses   #-}
{-# LANGUAGE OverloadedStrings       #-}
{-# LANGUAGE RankNTypes              #-}
{-# LANGUAGE ScopedTypeVariables     #-}
{-# LANGUAGE TypeFamilies            #-}
{-# LANGUAGE TypeOperators           #-}
{-# LANGUAGE UndecidableInstances    #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans         #-}
module Main where

import Data.Maybe             (fromMaybe)
import Control.Monad.IO.Class (liftIO)
import System.Environment     (getArgs)
import GHC.Generics           (to, from, M1 (..), K1 (..), (:*:) (..))

-- for "unsafe" vault key creation
import System.IO.Unsafe (unsafePerformIO)

import qualified Data.ByteString.Char8    as BS8
import qualified Data.Vault.Lazy          as V
import qualified Network.Wai              as Wai
import qualified Network.Wai.Handler.Warp as Warp

import Servant
import Servant.API.Generic 
import Servant.Server.Generic
import Servant.Server.Internal.RoutingApplication (passToServer)

如何获取当前的`Request`对象或URL

将当前WAI Request传递给处理程序实际上很容易。这是一种“懒惰”的方法，我们在请求中要求“一切”，并且我们必须小心处理程序（例如，我们无法触摸requestBody）。同样，此“组合器”将实现与wai服务器实现联系起来，这是一个实现细节（除了servant-server外，wai中的其他所有元素都没有暴露Raw内部）。

想法是制作Server (Wai.Request :> api) = Wai.Request -> Server api。如果我们想一想我们已经具备了这样的功能，我们可以使用Servant.API.Generic进行编写（请参见“使用泛型”食谱）：

data Routes1 route = Routes1
    { route11 :: route :- Wai.Request :> "route1" :> Get '[JSON] Int
    , route12 :: route :- Wai.Request :> "route2" :> Capture "id" Int :> Get '[JSON] Int
    }
  deriving (Generic)

routes1 :: Routes1 AsServer
routes1 = Routes1
    { route11 = \req -> liftIO $ do
        let p = Wai.rawPathInfo req
        BS8.putStrLn p
        return (BS8.length p)
    , route12 = \req i -> liftIO $ do
        let p = Wai.rawPathInfo req
        BS8.putStrLn p
        return (succ i)
    }

app1 :: Application
app1 = genericServe routes1

我们定义Routes1数据类型，实现Routes1 AsServer值并将其打开放入wai的{{1}}中。但是，要编译此示例，我们需要其他实例。我们在内部 Application组合器中使用 passToServer的实现。

route

此解决方案是很好的快速解决方案，但是可以说有更好的方法。

特定组合器

我们可能注意到我们两个处理程序都使用instance HasServer api ctx => HasServer (Wai.Request :> api) ctx where type ServerT (Wai.Request :> api) m = Wai.Request -> ServerT api m hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s route _ ctx d = route (Proxy :: Proxy api) ctx $ passToServer d id调用。那应该提醒我们。特定的组合器更加优雅。能够在核心框架之外创建新的组合器，是Wai.rawPathInto req的设计原则之一。

servant

使用新的data RawPathInfo instance HasServer api ctx => HasServer (RawPathInfo :> api) ctx where type ServerT (RawPathInfo :> api) m = BS8.ByteString -> ServerT api m hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s route _ ctx d = route (Proxy :: Proxy api) ctx $ passToServer d Wai.rawPathInfo组合器，我们可以重新实现我们的应用程序：

RawPathInfo

此版本更具声明性，而处理程序则更具限制性。我们将data Routes2 route = Routes2 { route21 :: route :- RawPathInfo :> "route1" :> Get '[JSON] Int , route22 :: route :- RawPathInfo :> "route2" :> Capture "id" Int :> Get '[JSON] Int } deriving (Generic) routes2 :: Routes2 AsServer routes2 = Routes2 { route21 = \p -> liftIO $ do BS8.putStrLn p return (BS8.length p) , route22 = \p i -> liftIO $ do BS8.putStrLn p return (succ i) } app2 :: Application app2 = genericServe routes2选择器从处理程序移到了组合器实现，删除重复。

使用`rawPathInfo`

Vault vault中的wai值不是众所周知的或未使用的。但是在这种情况下，它可能会很有用。 Using WAI's vault for fun and profit博客文章中介绍了保险柜。它填补了强类型Request的“动态”空白：我们可以将任意数据附加到请求，就像在Web框架中使用动态类型语言一样。由于Request基于servant-server，因此使用保管库是第三个答案到问题的第一部分。

我们（不安全地）创建金库的密钥：

wai

然后我们创建一个中间件，它将把rpiKey :: V.Key BS8.ByteString rpiKey = unsafePerformIO V.newKey放入rawPathInfo中。

vault

使用此方法，我们制作了应用程序的第三个变体。请注意，我们的价值可能不在金库中，那是小的功能回归。

middleware :: Wai.Middleware
middleware app req respond = do
    let vault' = V.insert rpiKey (Wai.rawPathInfo req) (Wai.vault req)
        req' = req { Wai.vault = vault' }
    app req' respond

注意：data Routes3 route = Routes3 { route31 :: route :- Vault :> "route1" :> Get '[JSON] Int , route32 :: route :- Vault :> "route2" :> Capture "id" Int :> Get '[JSON] Int } deriving (Generic) routes3 :: Routes3 AsServer routes3 = Routes3 { route31 = \v -> liftIO $ do let p = fromMaybe "?" $ V.lookup rpiKey v BS8.putStrLn p return (BS8.length p) , route32 = \v i -> liftIO $ do let p = fromMaybe "?" $ V.lookup rpiKey v BS8.putStrLn p return (succ i) } app3 :: Application app3 = middleware $ genericServe routes3可用于将信息从中间件传递给处理程序从处理程序到中间件。例如，可以完成身份验证完全在中间件中，用户信息存储在Vault中处理程序使用。

如何获取当前的路线？

问题的第二部分是如何获取当前路线。可以，我们可以解决vault吗？请注意，处理程序是 anonymous ，在相同意义上，函数也是。例如。要编写递归匿名函数，我们可以使用route2/:id组合器。我们可以使用接近的东西来传递“路线到自身”，使用fix也可以减少样板。

我们从外观普通的Servant.API.Generics数据结构开始。

Routes4

但是，我们将使用不同的 mode 而不是设置data Routes4 route = Routes4 { route41 :: route :- "route1" :> Get '[JSON] Int , route42 :: route :- "route2" :> Capture "id" Int :> Get '[JSON] Int } deriving (Generic)值。 Routes4 AsServer是一个以AsRecServer route作为第一个处理程序论点。在此示例中，我们使用route :- api，但读者可以自由使用其他自动解释，例如HasLink'作为代理！

servant-client

用法非常简单，不幸的是实现不是。

多毛位

data AsRecServer route instance GenericMode (AsRecServer route) where type AsRecServer route :- api = (route :- api) -> (AsServer :- api) routes4 :: Routes4 (AsRecServer (AsLink Link)) routes4 = Routes4 { route41 = \l -> liftIO $ do print l return 42 , route42 = \l i -> liftIO $ do print (l i) return i } app4 :: Application app4 = genericRecServe routes4的实现令人生畏。缺少的位是函数genericRecServe。简而言之，给定一个可以将所有genericHoist的{{1}}转换为modeA :- api的函数， modeB :- api将api转换为genericHoist。也许此功能应该存在于routes modeA中？

routes modeB

Servant.API.Generic由genericHoist :: ( GenericMode modeA, GenericMode modeB , Generic (routes modeA), Generic (routes modeB) , GServantHoist c api modeA modeB (Rep (routes modeA)) (Rep (routes modeB)) ) => Proxy modeA -> Proxy modeB -> Proxy c -> Proxy api -> (forall api'. c api' => Proxy api' -> (modeA :- api') -> (modeB :- api')) -> routes modeA -> routes modeB genericHoist pa pb pc api nt = to . gservantHoist pa pb pc api nt . from组成，并包含genericRecServe的变体。在限制条件下，单线实施。

genericHoist

我们使用单实例类技巧来部分适用genericServe。

genericRecServe
    :: forall routes.
       ( HasServer (ToServantApi routes) '[]
       , GenericServant routes AsApi
       , GenericServant routes AsServer
       , GenericServant routes (AsRecServer (AsLink Link))
       , Server (ToServantApi routes) ~ ToServant routes AsServer
       , GServantHoist 
          HasLink'
          (ToServantApi routes)
          (AsRecServer (AsLink Link))
          AsServer
          (Rep (routes (AsRecServer (AsLink Link))))
          (Rep (routes AsServer))
       )
    => routes (AsRecServer (AsLink Link)) -> Application
genericRecServe
    = serve (Proxy :: Proxy (ToServantApi routes)) 
    . toServant
    . genericHoist
        (Proxy :: Proxy (AsRecServer (AsLink Link)))
        (Proxy :: Proxy AsServer)
        (Proxy :: Proxy HasLink')
        (genericApi (Proxy :: Proxy routes))
        (\p f -> f $ safeLink p p)

HasLink的工作马是class (IsElem api api, HasLink api) => HasLink' api instance (IsElem api api, HasLink api) => HasLink' api genericHoist上的路线结构。请务必注意，gservantHoist和Rep参数是类参数。这让我们在实例中约束它们。

api（元数据）和class GServantHoist c api modeA modeB f g where gservantHoist :: Proxy modeA -> Proxy modeB -> Proxy c -> Proxy api -> (forall api'. c api' => Proxy api' -> (modeA :- api') -> (modeB :- api')) -> f x -> g x（产品）的实例非常简单传递，您会期望的：

M1

叶:*:的实现显示了为什么我们需要instance GServantHoist c api modeA modeB f g => GServantHoist c api modeA modeB (M1 i j f) (M1 i' j' g) where gservantHoist pa pb pc api nt = M1 . gservantHoist pa pb pc api nt . unM1 instance ( GServantHoist c apiA modeA modeB f f' , GServantHoist c apiB modeA modeB g g' ) => GServantHoist c (apiA :<|> apiB) modeA modeB (f :*: g) (f' :*: g') where gservantHoist pa pb pc _ nt (f :*: g) = gservantHoist pa pb pc (Proxy :: Proxy apiA) nt f :*: gservantHoist pa pb pc (Proxy :: Proxy apiB) nt g和K1的原因作为类参数：在这里，我们需要c和“连贯”条件，因此api，c api，api，modeA和modeB匹配。

结论

使用类似的y方法，我们可以对处理程序进行各种转换。例如，我们可以将普通路由包装在instance ( c api, (modeA :- api) ~ x, (modeB :- api) ~ y ) => GServantHoist c api modeA modeB (K1 i x) (K1 i y) where gservantHoist _pa _pb _pc api nt = K1 . nt api . unK1“中间件”中，将路线信息放入Generic中，并且该信息可由servant使用 vault收集统计信息。这样我们可以制作一个改进的版本 wai，因为目前Middleware可能会因路线重叠而感到困惑。

主要测试

servant-ekg

Answer 2

我不知道如何自动执行此操作，但可以使用safeLink功能“手动”完成。

这个想法是，如果你有一个API

type ServerAPI = 
        "route01" :> Get '[HTML] Text
   :<|> "route02" :> "subroute" :> Get '[HTML] Text
   :<|> Route3

type Route3 = "route03" :> Get '[HTML] Text

您可以使用整个API和具有特定路线的代理传递给safeLink代理，并显示生成的URI：

show (safeLink (Proxy::Proxy ServerAPI) (Proxy::Proxy Route3))

如果路线有参数，您还必须传递处理程序所采用的参数。例如：

type ServerAPI =
       ...
   :<|> Route4

type Route4 = "route04" :> Capture "cap" Int :> Get '[JSON] Text

在ghci：

ghci> :set -XKindSignatures -XDataKinds -XTypeOperators -XTypeFamilies
ghci> :type safeLink (Proxy::Proxy ServerAPI) (Proxy::Proxy Route4)
Int -> URI

您必须为每条路线执行此操作。

Answer 3

在向处理程序添加“ route”参数时，可以在合并服务器的处理程序时通过函数应用程序设置参数值。

根据您的示例：

type ServerAPI = 
         "route01" :> Get '[JSON] Text
    :<|> "route02" :> "subroute" :> Get '[JSON] Text
    :<|> "route03" :> Get '[JSON] Text

route1and2Handler :: String -> Handler Text
route1and2Handler route = do
    -- addVisitCountForRouteToDatabaseOrSomethingOfThatSort...
    return (pack route)

route3Handler :: Handler Text
route3Handler = return "Hello, I'm route 03"

server :: Server ServerAPI
server = route1and2Handler "route01" :<|> route1and2Handler "route02" :<|> route3Handler

或者，如果您真正感兴趣的是对所有路由进行通用请求处理，则最好通过在服务器和应用程序之间应用“中间件”来实现。中间件（通常为Application -> Application类型）可以访问该请求。有关wai中间件的示例，请参见wai-extra。

对所有请求执行日志记录的示例：

import Network.Wai.Middleware.RequestLogger (logStdoutDev)

...

app :: Application
app = serve serverAPI server

main :: IO ()
main = run 8081 $ logStdoutDev app

Haskell Servant从Handler获取当前路由/ URL

3 个答案:

如何获取当前的`Request`对象或URL

特定组合器

使用`rawPathInfo`

如何获取当前的路线？

多毛位

结论

主要测试

Haskell Servant从Handler获取当前路由/ URL

3 个答案:

如何获取当前的Request对象或URL

特定组合器

使用rawPathInfo

如何获取当前的路线？

多毛位

结论

主要测试

如何获取当前的`Request`对象或URL

使用`rawPathInfo`