Введите экземпляр и тип фантома

Я столкнулся со странной ошибкой, я не могу найти способ исправить это. Я использую серванта и пытаюсь создать универсальную библиотеку аутентификации (по умолчанию, например, без серверной части).

Код следующий:

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 ответа

Вам нужно повернуть 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,

Я столкнулся с проблемой, используя 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. В ответе Кактуса правильно сказано, что вы должны обернуть экзистенциал в новый тип, но это само по себе просто приведет к ошибке компиляции из-за ограничений Servant, вероятно, из-за некоторых проблем с HasServer пример.

Однако существует общий ответ на этот вопрос, который заключается в том, чтобы просто повторить 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

Наконец-то вы соберете все это, используя 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      

По сути, это работает, когда вы пропускаете переменную типа через различные биты и кусочки, так что в итоге вы получите API, параметризованный типом db (аналогично для обработчиков), что позволит вам использовать синонимы типа в вашем типе API и, следовательно, в ваших обработчиках.,

Если вы используете собственную монаду для своего приложения, вы можете улучшить этот шаблон, используя enter при запуске вашего authHandler (и добавьте любой контекст, в котором нуждается ваша монада приложения, в контекст, который вы передаете вам serveWithContext, но это выходит за рамки этого вопроса...).

Другие вопросы по тегам