键入实例和幻像类型

时间:2016-07-17 11:00:52

标签: haskell ghc servant phantom-types type-synonyms

我遇到了一个奇怪的错误,我无法找到解决方法。我正在使用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’

你知道如何修复这段代码吗?

2 个答案:

答案 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的AuthProtectAuthHandler等,并为它编写自己的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} },但这超出了这个问题的范围......)。