我遇到了一个奇怪的错误,我无法找到解决方法。我正在使用servant,我正在尝试构建一个通用的身份验证库(例如,默认情况下没有后端)。
代码如下:
type TokenProtect auth = AuthProtect "auth-token"
type instance AuthServerData (TokenProtect auth) = Id auth
Id
是另一种类型的家庭。错误消息如下。
• Family instance purports to bind type variable ‘auth’
but the real LHS (expanding synonyms) is:
AuthServerData (AuthProtect "auth-token") = ...
• In the type instance declaration for ‘AuthServerData’
你知道如何修复这段代码吗?
答案 0 :(得分:0)
您需要将TokenProtect
转换为newtype
包装器:
newtype TokenProtect auth = TokenProtect (AuthProtect "auth-token")
type instance AuthServerData (TokenProtect auth) = Id auth
原因是类型同义词只是:同义词;所以你的代码相当于写
type instance AuthServerData (AuthProtect "auth-token") = Id auth
当然是指未绑定的类型变量auth
。
答案 1 :(得分:0)
我使用Servant遇到了这个问题,我认为我的用例类似于原始的提问者。基本上我希望AuthProtect允许我将由类提供的某种类型同义词约束的类型线程化到我的处理程序,例如
class IsDatabase db where
type DatabaseAuthResult db :: *
instance IsDatabase MyDBType
type DatabaseAuthResult MyDBType = DBUser
因此需要类似原始海报的代码:
type TokenProtect db = AuthProtect "auth-token"
type instance AuthServerData (TokenProtect db) = DatabaseAuthResult db
据我所知,这在Servant general auth implementation的结构中是不可能的。仙人掌'回答正确地说你必须将存在主体包装在一个newtype中,但这本身只会导致编译错误与Servant约束有关,可能是HasServer
实例的一些问题。
然而,这个问题有一个普遍的答案,就是用您自己的实现复制Servant的AuthProtect
,AuthHandler
等,并为它编写自己的HasServer版本
-- import for all the internal servant stuff like addAuthCheck
import Servant.Server.Internal.RoutingApplication
data DBAuthProtect (tag :: k) db deriving (Typeable)
newtype DBAuthHandler r db result = DBAuthHandler {unDBAuthHandler :: r -> Handler result}
instance ( HasServer api context
, HasContextEntry context (DBAuthHandler Request db (AuthServerData (DBAuthProtect tag db))))
=> HasServer (DBAuthProtect tag db :> api) context where
type ServerT (DBAuthProtect tag db :> api) m = AuthServerData (DBAuthProtect tag db) -> ServerT api m
route Proxy context subserver =
route (Proxy :: Proxy api) context (subserver `addAuthCheck` withRequest authCheck)
where
authHandler :: Request -> Handler (AuthServerData (DBAuthProtect tag db))
authHandler = unDBAuthHandler (getContextEntry context)
authCheck :: Request -> DelayedIO (AuthServerData (DBAuthProtect tag db))
authCheck = (>>= either delayedFailFatal return) . liftIO . runExceptT . authHandler
然后,您可以将此类似地用于AuthProtect
,例如
type TokenProtect db = DBAuthProtect "auth-token" db
type instance AuthServerData (TokenProtect db) = DatabaseAuthResult db
type ProtectedAPI db = "private" :> TokenProtect db :> Get [...]
dbAuthHandler :: (IsDatabase db) => db -> DBAuthHandler Request db (DatabaseAuthResult db)
dbAuthHandler db = DBAuthHandler $ \ req -> do
-- req :: Request
-- ... do some work here and return a type (DatabaseAuthResult db), so for MyDBType you would return DBUser - you have both the db itself and the request to work with
最后,您可以使用Servant的serveWithContext
将所有内容放在一起,并在上下文中提供部分应用的处理程序
mkContext :: db -> Context '[DBAuthHandler Request db (AuthServerData db)]
mkContext db = dbAuthHandler db :. EmptyContext
main :: IO ()
main = do
db <- getMyDBSomehow -- a concrete type, say MyDBType
let myApi = (Proxy :: Proxy (ProtectedAPI MyDBType))
serveWithContext myApi (mkContext db) handlers
基本上它的工作方式是通过各种各样的部分来处理类型变量,这样你最终得到一个由db类型参数化的api(类似于处理程序),允许你在api类型中使用类型同义词,因此在你的处理程序中。
如果您为自己的应用程序使用自定义monad,则可以在运行authHandler时使用enter
来改进此模式(并将应用程序monad所需的任何上下文添加到传递给您的上下文中{{1} },但这超出了这个问题的范围......)。