不同类型的 ReaderT?
Differently kinded ReaderT?
冒着成为 XY Problem 的风险,是否可以拥有一个具有不同种类环境的 ReaderT
?我正在尝试类似...
type AppM (perms :: [*]) = ReaderT (perms :: [*]) IO
...但是编译器抱怨...
Expected a type, but ‘(perms :: [*])’ has kind ‘[*]’
...大概是因为 ReaderT
被定义为...
newtype ReaderT r (m :: k -> *) (a :: k) = ReaderT {runReaderT :: r -> m a}
...其中 r
属于 *
我正在尝试在类型级别跟踪 permissions/roles,我的最终目标是编写类似...
的函数
ensurePermission :: (p :: Permission) -> AppM (p :. ps) ()
... 每次调用 ensurePermission
appends/prepends 对 monad 的权限列表(在类型级别)的新权限。
编辑
我尝试了以下方法,它似乎可以编译,但我不确定发生了什么。从概念上讲,perms
仍然不是那种 [*]
。编译器如何接受此片段,而原始片段却不接受?
data HList (l :: [*]) where
HNil :: HList '[]
HCons :: e -> HList l -> HList (e ': l)
type AppM (perms :: [*]) = ReaderT (HList perms) IO
编辑#2
我尝试改进我的代码片段以进一步匹配我的最终目标,但我又遇到了另一个 "kind" 问题:
编译器不接受以下代码:
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
data Permission = PermissionA
| PermissionB
$(genSingletons [''Permission])
data PList (perms :: [Permission]) where
PNil :: PList '[]
PCons :: p -> PList perms -> PList (p ': perms)
-- • Expected kind ‘[Permission]’, but ‘p : perms’ has kind ‘[*]’
-- • In the first argument of ‘PList’, namely ‘(p : perms)’
-- In the type ‘PList (p : perms)’
-- In the definition of data constructor ‘PCons’
-- |
-- 26 | PCons :: p -> PList perms -> PList (p ': perms)
-- | ^^^^^^^^^^
它也不接受以下变体...
data PList (perms :: [Permission]) where
PNil :: PList '[]
PCons :: (p :: Permission) -> PList perms -> PList (p ': perms)
-- • Expected a type, but ‘(p :: Permission)’ has kind ‘Permission’
-- • In the type ‘(p :: Permission)’
-- In the definition of data constructor ‘PCons’
-- In the data declaration for ‘PList’
-- |
-- 26 | PCons :: (p :: Permission) -> PList perms -> PList (p ': perms)
-- | ^^^^^^^^^^^^^^^^^
是的,我认为我们这里有一个 XY 问题,所以让我们退后一步。
A Reader
是一个 monad,用于携带可以方便读取的 value。您没有值——您有一个要在类型级别强制执行的权限列表——所以我认为您不需要或不想要 reader、异构列表或其他类似的东西那。
相反,给定一个布尔权限列表:
data Permission = PermissionA | PermissionB deriving (Show)
你想定义一个在类型级别参数化的 monad 及其授予的权限列表。围绕底层 IO
monad 的新型包装器将执行:
{-# LANGUAGE DataKinds, KindSignatures, GeneralizedNewtypeDeriving #-}
newtype M (ps :: [Permission]) a = M (IO a) deriving (Functor, Applicative, Monad)
您还需要类型函数(也称为类型族)来确定权限是否在权限列表中:
{-# LANGUAGE TypeFamilies, TypeOperators #-}
type family Allowed (p :: Permission) ps where
Allowed p '[] = False
Allowed p (p:ps) = True
Allowed p (q:ps) = Allowed p ps
现在,如果你想编写需要特定权限的函数,你可以这样写:
deleteA :: (Allowed PermissionA ps ~ True) => M ps ()
deleteA = M $ print "Deleted A"
readB :: (Allowed PermissionB ps ~ True) => M ps ()
readB = M $ print "Read B"
copyBtoA :: ( Allowed PermissionA ps ~ True
, Allowed PermissionB ps ~ True) => M ps ()
copyBtoA = M $ print "Copied B to A"
为了运行一个M
动作,我们引入了一个运行没有权限的函数:
-- runM with no permissions
runM :: M '[] a -> IO a
runM (M act) = act
请注意,如果您尝试 runM readB
,您将收到类型错误(无法将 False
与 True
匹配——这不是最大的错误消息,但是.. .).
要授予权限,我们引入功能:
-- grant permissions
grantA :: M (PermissionA:ps) a -> M ps a
grantA (M act) = M act
grantB :: M (PermissionB:ps) a -> M ps a
grantB (M act) = M act
这些函数本质上是术语级别的恒等函数——它们只是解包和重新包装 M
构造函数。但是,它们在类型级别的操作是为其输入参数添加权限。这意味着:
runM $ grantB $ readB
现在 type-checks。也一样:
runM $ grantA . grantB $ readB
runM $ grantB . grantA $ readB
runM $ grantB . grantA . grantB $ readB
etc.
然后你可以编写如下程序:
program :: IO ()
program = runM $ do
grantA $ do
deleteA
grantB $ do
readB
copyBtoA
同时拒绝以下节目:
program1 :: IO ()
program1 = runM $ do
grantA $ do
deleteA
grantB $ do
readB
copyBtoA -- error, needs PermissionB
这个基础设施可能有点丑陋,但它应该是您 type-based 所需要的全部,完全 compile-time 权限检查。
不妨试用一下这个版本,看看它是否满足您的需求。完整代码为:
{-# LANGUAGE DataKinds, KindSignatures, GeneralizedNewtypeDeriving,
TypeFamilies, TypeOperators #-}
data Permission = PermissionA | PermissionB deriving (Show)
newtype M (ps :: [Permission]) a = M (IO a) deriving (Functor, Applicative, Monad)
type family Allowed (p :: Permission) ps where
Allowed p '[] = False
Allowed p (p:ps) = True
Allowed p (q:ps) = Allowed p ps
-- runM with no permissions
runM :: M '[] a -> IO a
runM (M act) = act
-- grant permissions
grantA :: M (PermissionA:ps) a -> M ps a
grantA (M act) = M act
grantB :: M (PermissionB:ps) a -> M ps a
grantB (M act) = M act
deleteA :: (Allowed PermissionA ps ~ True) => M ps ()
deleteA = M $ print "Deleted A"
readB :: (Allowed PermissionB ps ~ True) => M ps ()
readB = M $ print "Read B"
copyBtoA :: ( Allowed PermissionA ps ~ True
, Allowed PermissionB ps ~ True) => M ps ()
copyBtoA = M $ print "Copied B to A"
program :: IO ()
program = runM $ do
grantA $ do
deleteA
grantB $ do
readB
copyBtoA
两个基于@dfeuer 评论的附加说明。首先,它提醒我 grantA
和 grantB
同样可以使用 Data.Coerce
中的 "safe" coerce
函数编写,如下所示。这个版本和上面的版本生成的代码没有区别,所以看个人喜好吧:
import Data.Coerce
-- grant permissions
grantA :: M (PermissionA:ps) a -> M ps a
grantA = coerce
grantB :: M (PermissionB:ps) a -> M ps a
grantB = coerce
其次,@dfeuer 所说的是这里没有明确区分用于控制权限的可信代码基础和依赖于类型系统来执行权限系统的代码 "rest" .例如,M
构造函数上的模式匹配本质上是危险的,因为您可以从一个权限上下文中提取 IO a
并在另一个权限上下文中重建它。 (这基本上就是 grantA
和 grantB
为无条件提升权限所做的事情。)如果你在受信任的代码库之外这样做 "by accident",你最终可能会绕过权限系统。在许多应用程序中,这没什么大不了的。
但是,如果您试图证明系统安全,您可能需要一个小型可信代码库,该代码库与危险的 M
构造函数一起工作,并且仅导出 "safe" API通过类型系统确保安全性。在这种情况下,您将拥有一个导出类型 M
但不导出其构造函数 M(..)
的模块。相反,您将导出智能构造函数以创建具有适当权限的 M
操作。
此外,由于不明确的技术原因,即使不导出 M
构造函数,"untrusted" 代码仍然可以在不同的权限上下文之间进行强制转换:
stealPermission :: M (PermissionA:ps) a -> M ps a
stealPermission = coerce
因为 M
类型构造函数的第一个参数有一个 so-called "role",默认为 "phantom" 而不是 "nominal"。如果你覆盖这个:
{-# LANGUAGE RoleAnnotations #-}
type role M nominal _
then coerce
只能在构造函数在范围内的地方使用,这就弥补了这个漏洞。不受信任的代码仍然可以使用 unsafeCoerce
,但有一些机制(Google 用于 "Safe Haskell")来防止这种情况。
在单独的 Gist 中,您评论道:
@K.A.Buhr, wow! Thank you for such a detailed reply. You are correct that this is an XY problem, and you've pretty-much nailed the actual problem that I'm trying to solve. Another important piece of context is that, at some point these type-level permissions will have to be "reified" at the value-level. This is because the final check is against the permissions granted to the currently signed-in user, which are stored in the DB.
Taking this into account, I'm planning to have two "general" functions, say:
requiredPermission :: (RequiredPermission p ps) => Proxy p -> AppM ps ()
optionalPermission :: (OptionalPermission p ps) => Proxy p -> AppM ps ()
Here's the difference:
requiredPermission
will simply add the permission to the type-level list and it will be verified when runAppM
is called. If the current user does not have ALL the required permissions, then runAppM
will immediately throw a 401 error to the UI.
- On the other hand,
optionalPermission
will extract the user from the Reader
environment, check the permission, and return a True / False. runAppM
will do nothing with OptionalPermissions
. These will be for cases where the absence of a permission should NOT fail the entire action, but skip a specific step in the action.
Given this context, I'm not sure if I would end-up with functions, like grantA or grantB. The "unwrapping" of ALL the RequestPermissions in the AppM constructor will be done by runAppM, which will also ensure that the currently sign-in user actually has these permissions.
请注意,“具体化”类型的方法不止一种。例如,以下程序——通过狡猾的黑魔法诡计——设法在不使用代理或单例的情况下具体化 运行time 类型!
main = do
putStr "Enter \"Int\" or \"String\": "
s <- getLine
putStrLn $ case s of "Int" -> "Here is an integer: " ++ show (42 :: Int)
"String" -> "Here is a string: " ++ show ("hello" :: String)
同样,grantA
的以下变体设法将仅在 运行 时间已知的用户权限提升到 type-level:
whenA :: M (PermissionA:ps) () -> M ps ()
whenA act = do
perms <- asks userPermissions -- get perms from environment
if PermissionA `elem` perms
then act
else notAuthenticated
在这里可以使用单例来避免不同权限的样板,并提高这段受信任代码的类型安全性(即,PermissionA
的两次出现被强制匹配)。同样,约束类型可能会在每次权限检查时保存 5 或 6 个字符。然而,这些改进都不是必需的,并且它们可能会增加大量的复杂性,如果可能的话,应该避免这种情况,直到 after 你得到一个工作原型。换句话说,无法运行的优雅代码并不那么优雅。
本着这种精神,这就是我如何调整我的原始解决方案以支持一组必须在特定“入口点”(例如,特定路由的 Web 请求)满足的“必需”权限,并执行 运行时间权限检查用户数据库。
首先,我们有一组权限:
data Permission
= ReadP -- read content
| MetaP -- view (private) metadata
| WriteP -- write content
| AdminP -- all permissions
deriving (Show, Eq)
和一个用户数据库:
type User = String
userDB :: [(User, [Permission])]
userDB
= [ ("alice", [ReadP, WriteP])
, ("bob", [ReadP])
, ("carl", [AdminP])
]
以及包含用户权限和您想要在 reader 中携带的任何其他内容的环境:
data Env = Env
{ uperms :: [Permission] -- user's actual permissions
, user :: String -- other Env stuff
} deriving (Show)
我们还需要类型和术语级别的函数来检查权限列表:
type family Allowed (p :: Permission) ps where
Allowed p (AdminP:ps) = True -- admins can do anything
Allowed p '[] = False
Allowed p (p:ps) = True
Allowed p (q:ps) = Allowed p ps
allowed :: Permission -> [Permission] -> Bool
allowed p (AdminP:ps) = True
allowed p (q:ps) | p == q = True
| otherwise = allowed p ps
allowed p [] = False
(是的,您可以使用 singletons
库同时定义这两个函数,但现在让我们在没有单例的情况下执行此操作。)
和以前一样,我们将有一个带有权限列表的 monad。您可以将其视为代码中此时已检查和验证的权限列表。我们将使它成为具有 ReaderT Env
组件的通用 m
的 monad 转换器:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
newtype AppT (perms :: [Permission]) m a = AppT (ReaderT Env m a)
deriving (Functor, Applicative, Monad, MonadReader Env, MonadIO)
现在,我们可以在这个 monad 中定义动作,这些动作构成了我们应用程序的构建块:
readPage :: (Allowed ReadP perms ~ True, MonadIO m) => Int -> AppT perms m ()
readPage n = say $ "Read page " ++ show n
metaPage :: (Allowed ReadP perms ~ True, MonadIO m) => Int -> AppT perms m ()
metaPage n = say $ "Secret metadata " ++ show (n^2)
editPage :: (Allowed ReadP perms ~ True, Allowed WriteP perms ~ True, MonadIO m) => Int -> AppT perms m ()
editPage n = say $ "Edit page " ++ show n
say :: MonadIO m => String -> m ()
say = liftIO . putStrLn
在每种情况下,在已检查和验证的权限列表包括类型签名中列出的所需权限的任何上下文中都允许该操作。 (是的,约束种类在这里可以很好地工作,但让我们保持简单。)
我们可以用这些构建更复杂的动作,就像我们在另一个答案中所做的那样:
readPageWithMeta :: ( Allowed 'ReadP perms ~ 'True, Allowed 'MetaP perms ~ 'True
, MonadIO m) => Int -> AppT perms m ()
readPageWithMeta n = do
readPage n
metaPage n
请注意,GHC 实际上可以自动推断此类型签名,确定需要 ReadP
和 MetaP
权限。如果我们想让 MetaP
权限可选,我们可以这样写:
readPageWithOptionalMeta :: ( Allowed 'ReadP perms ~ 'True
, MonadIO m) => Int -> AppT perms m ()
readPageWithOptionalMeta n = do
readPage n
whenMeta $ metaPage n
其中 whenMeta
允许根据可用权限执行可选操作。 (见下文。)同样,可以自动推断出这个签名。
到目前为止,虽然我们允许可选权限,但我们还没有明确处理“必需”权限。这些将在 入口点 指定,这将使用单独的 monad 定义:
newtype EntryT' (reqP :: [Permission]) (checkedP :: [Permission]) m a
= EntryT (ReaderT Env m a)
deriving (Functor, Applicative, Monad, MonadReader Env, MonadIO)
type EntryT reqP = EntryT' reqP reqP
这需要一些解释。 EntryT'
(带勾号)有两个权限列表。第一个是入口点所需权限的完整列表,每个特定入口点都有一个固定值。第二个是已“检查”的那些权限的子集(在静态意义上,函数调用已到位以检查和验证用户是否具有所需的权限)。当我们定义入口点时,它将从空列表构建到所需权限的完整列表。我们将把它用作 type-level 机制来确保正确的权限检查函数调用集就位。 EntryT
(无勾号)的(静态)检查权限等于其所需权限,这就是我们知道 运行 是安全的(针对特定用户动态确定的权限集,这将全部根据类型进行检查。
runEntryT :: MonadIO m => User -> EntryT req m () -> m ()
runEntryT u (EntryT act)
= case lookup u userDB of
Nothing -> say $ "error 401: no such user '" ++ u ++ "'"
Just perms -> runReaderT act (Env perms u)
要定义一个入口点,我们将使用这样的东西:
entryReadPage :: MonadIO m => Int -> EntryT '[ReadP] m ()
entryReadPage n = _somethingspecial_ $ do
readPage n
whenMeta $ metaPage n
请注意,我们这里有一个 do
块,由 AppT
个积木构成。事实上,它等同于上面的 readPageWithOptionalMeta
类型也是如此:
(Allowed 'ReadP perms ~ 'True, MonadIO m) => Int -> AppT perms m ()
这里的_somethingspecial_
需要适配这个AppT
(其权限列表需要ReadP
在运行之前检查和验证)到一个入口点其所需和(静态)检查权限列表为 [ReadP]
。我们将使用一组函数来检查实际的 运行 时间权限:
requireRead :: MonadIO m => EntryT' r c m () -> EntryT' r (ReadP:c) m ()
requireRead = unsafeRequire ReadP
requireWrite :: MonadIO m => EntryT' r c m () -> EntryT' r (WriteP:c) m ()
requireWrite = unsafeRequire WriteP
-- plus functions for the rest of the permissions
全部根据以下定义:
unsafeRequire :: MonadIO m => Permission -> EntryT' r c m () -> EntryT' r c' m ()
unsafeRequire p act = do
ps <- asks uperms
if allowed p ps
then coerce act
else say $ "error 403: requires permission " ++ show p
现在,当我们写:
entryReadPage :: MonadIO m => Int -> EntryT '[ReadP] m ()
entryReadPage n = requireRead . _ $ do
readPage n
whenMeta $ metaPage n
外部类型是正确的,反映了 requireXXX
函数列表与类型签名中所需权限列表匹配的事实。剩余的孔具有类型:
AppT perms0 m0 () -> EntryT' '[ReadP] '[] m ()
由于我们构造权限检查的方式,这是 t 的特例e 安全转换:
toRunAppT :: MonadIO m => AppT r m a -> EntryT' r '[] m a
toRunAppT = coerce
换句话说,我们可以使用一个相当不错的语法来编写我们最终的入口点定义,它的字面意思是我们“需要 Read
到 运行 这个 AppT
”:
entryReadPage :: MonadIO m => Int -> EntryT '[ReadP] m ()
entryReadPage n = requireRead . toRunAppT $ do
readPage n
whenMeta $ metaPage n
类似地:
entryEditPage :: MonadIO m => Int -> EntryT '[ReadP, WriteP] m ()
entryEditPage n = requireRead . requireWrite . toRunAppT $ do
editPage n
whenMeta $ metaPage n
观察到所需权限的列表明确包含在入口点的类型中,并且执行 运行 对这些权限进行时间检查的 requireXXX
函数的组成列表必须与这些相同的权限完全匹配,以相同的顺序,对其进行类型检查。
最后一块拼图是 whenMeta
的实现,它执行 运行time 权限检查并在权限可用时执行可选操作。
whenMeta :: Monad m => AppT (MetaP:perms) m () -> AppT perms m ()
whenMeta = unsafeWhen MetaP
-- and similar functions for other permissions
unsafeWhen :: Monad m => Permission -> AppT perms m () -> AppT perms' m ()
unsafeWhen p act = do
ps <- asks uperms
if allowed p ps
then coerce act
else return ()
这是带有测试工具的完整程序。你可以看到:
Username/Req (e.g., "alice Read 5"): alice Read 5 -- Alice...
Read page 5
Username/Req (e.g., "alice Read 5"): bob Read 5 -- and Bob can read.
Read page 5
Username/Req (e.g., "alice Read 5"): carl Read 5 -- Carl gets the metadata, too
Read page 5
Secret metadata 25
Username/Req (e.g., "alice Read 5"): bob Edit 3 -- Bob can't edit...
error 403: requires permission WriteP
Username/Req (e.g., "alice Read 5"): alice Edit 3 -- but Alice can.
Edit page 3
Username/Req (e.g., "alice Read 5"):
来源:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Realistic where
import Control.Monad.Reader
import Data.Coerce
-- |Set of permissions
data Permission
= ReadP -- read content
| MetaP -- view (private) metadata
| WriteP -- write content
| AdminP -- all permissions
deriving (Show, Eq)
type User = String
-- |User database
userDB :: [(User, [Permission])]
userDB
= [ ("alice", [ReadP, WriteP])
, ("bob", [ReadP])
, ("carl", [AdminP])
]
-- |Environment with 'uperms' and whatever else is needed
data Env = Env
{ uperms :: [Permission] -- user's actual permissions
, user :: String -- other Env stuff
} deriving (Show)
-- |Check for permission in type-level and term-level lists
type family Allowed (p :: Permission) ps where
Allowed p (AdminP:ps) = True -- admins can do anything
Allowed p '[] = False
Allowed p (p:ps) = True
Allowed p (q:ps) = Allowed p ps
allowed :: Permission -> [Permission] -> Bool
allowed p (AdminP:ps) = True
allowed p (q:ps) | p == q = True
| otherwise = allowed p ps
allowed p [] = False
-- |An application action running with a given list of checked permissions.
newtype AppT (perms :: [Permission]) m a = AppT (ReaderT Env m a)
deriving (Functor, Applicative, Monad, MonadReader Env, MonadIO)
-- Optional actions run if permissions are available at runtime.
whenRead :: Monad m => AppT (ReadP:perms) m () -> AppT perms m ()
whenRead = unsafeWhen ReadP
whenMeta :: Monad m => AppT (MetaP:perms) m () -> AppT perms m ()
whenMeta = unsafeWhen MetaP
whenWrite :: Monad m => AppT (WriteP:perms) m () -> AppT perms m ()
whenWrite = unsafeWhen WriteP
whenAdmin :: Monad m => AppT (AdminP:perms) m () -> AppT perms m ()
whenAdmin = unsafeWhen AdminP
unsafeWhen :: Monad m => Permission -> AppT perms m () -> AppT perms' m ()
unsafeWhen p act = do
ps <- asks uperms
if allowed p ps
then coerce act
else return ()
-- |An entry point, requiring a list of permissions
newtype EntryT' (reqP :: [Permission]) (checkedP :: [Permission]) m a
= EntryT (ReaderT Env m a)
deriving (Functor, Applicative, Monad, MonadReader Env, MonadIO)
-- |An entry point whose full list of required permission has been (statically) checked).
type EntryT reqP = EntryT' reqP reqP
-- |Run an entry point whose required permissions have been checked.
runEntryT :: MonadIO m => User -> EntryT req m () -> m ()
runEntryT u (EntryT act)
= case lookup u userDB of
Nothing -> say $ "error 401: no such user '" ++ u ++ "'"
Just perms -> runReaderT act (Env perms u)
-- Functions to build the list of required permissions for an entry point.
requireRead :: MonadIO m => EntryT' r c m () -> EntryT' r (ReadP:c) m ()
requireRead = unsafeRequire ReadP
requireMeta :: MonadIO m => EntryT' r c m () -> EntryT' r (MetaP:c) m ()
requireMeta = unsafeRequire MetaP
requireWrite :: MonadIO m => EntryT' r c m () -> EntryT' r (WriteP:c) m ()
requireWrite = unsafeRequire WriteP
requireAdmin :: MonadIO m => EntryT' r c m () -> EntryT' r (AdminP:c) m ()
requireAdmin = unsafeRequire AdminP
unsafeRequire :: MonadIO m => Permission -> EntryT' r c m () -> EntryT' r c' m ()
unsafeRequire p act = do
ps <- asks uperms
if allowed p ps
then coerce act
else say $ "error 403: requires permission " ++ show p
-- Adapt an entry point w/ all static checks to an underlying application action.
toRunAppT :: MonadIO m => AppT r m a -> EntryT' r '[] m a
toRunAppT = coerce
-- Example application actions
readPage :: (Allowed ReadP perms ~ True, MonadIO m) => Int -> AppT perms m ()
readPage n = say $ "Read page " ++ show n
metaPage :: (Allowed ReadP perms ~ True, MonadIO m) => Int -> AppT perms m ()
metaPage n = say $ "Secret metadata " ++ show (n^2)
editPage :: (Allowed ReadP perms ~ True, Allowed WriteP perms ~ True, MonadIO m) => Int -> AppT perms m ()
editPage n = say $ "Edit page " ++ show n
say :: MonadIO m => String -> m ()
say = liftIO . putStrLn
-- Example entry points
entryReadPage :: MonadIO m => Int -> EntryT '[ReadP] m ()
entryReadPage n = requireRead . toRunAppT $ do
readPage n
whenMeta $ metaPage n
entryEditPage :: MonadIO m => Int -> EntryT '[ReadP, WriteP] m ()
entryEditPage n = requireRead . requireWrite . toRunAppT $ do
editPage n
whenMeta $ metaPage n
-- Test harnass
data Req = Read Int
| Edit Int
deriving (Read)
main :: IO ()
main = do
putStr "Username/Req (e.g., \"alice Read 5\"): "
ln <- getLine
case break (==' ') ln of
(user, ' ':rest) -> case read rest of
Read n -> runEntryT user $ entryReadPage n
Edit n -> runEntryT user $ entryEditPage n
main
冒着成为 XY Problem 的风险,是否可以拥有一个具有不同种类环境的 ReaderT
?我正在尝试类似...
type AppM (perms :: [*]) = ReaderT (perms :: [*]) IO
...但是编译器抱怨...
Expected a type, but ‘(perms :: [*])’ has kind ‘[*]’
...大概是因为 ReaderT
被定义为...
newtype ReaderT r (m :: k -> *) (a :: k) = ReaderT {runReaderT :: r -> m a}
...其中 r
属于 *
我正在尝试在类型级别跟踪 permissions/roles,我的最终目标是编写类似...
的函数ensurePermission :: (p :: Permission) -> AppM (p :. ps) ()
... 每次调用 ensurePermission
appends/prepends 对 monad 的权限列表(在类型级别)的新权限。
编辑
我尝试了以下方法,它似乎可以编译,但我不确定发生了什么。从概念上讲,perms
仍然不是那种 [*]
。编译器如何接受此片段,而原始片段却不接受?
data HList (l :: [*]) where
HNil :: HList '[]
HCons :: e -> HList l -> HList (e ': l)
type AppM (perms :: [*]) = ReaderT (HList perms) IO
编辑#2
我尝试改进我的代码片段以进一步匹配我的最终目标,但我又遇到了另一个 "kind" 问题:
编译器不接受以下代码:
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
data Permission = PermissionA
| PermissionB
$(genSingletons [''Permission])
data PList (perms :: [Permission]) where
PNil :: PList '[]
PCons :: p -> PList perms -> PList (p ': perms)
-- • Expected kind ‘[Permission]’, but ‘p : perms’ has kind ‘[*]’
-- • In the first argument of ‘PList’, namely ‘(p : perms)’
-- In the type ‘PList (p : perms)’
-- In the definition of data constructor ‘PCons’
-- |
-- 26 | PCons :: p -> PList perms -> PList (p ': perms)
-- | ^^^^^^^^^^
它也不接受以下变体...
data PList (perms :: [Permission]) where
PNil :: PList '[]
PCons :: (p :: Permission) -> PList perms -> PList (p ': perms)
-- • Expected a type, but ‘(p :: Permission)’ has kind ‘Permission’
-- • In the type ‘(p :: Permission)’
-- In the definition of data constructor ‘PCons’
-- In the data declaration for ‘PList’
-- |
-- 26 | PCons :: (p :: Permission) -> PList perms -> PList (p ': perms)
-- | ^^^^^^^^^^^^^^^^^
是的,我认为我们这里有一个 XY 问题,所以让我们退后一步。
A Reader
是一个 monad,用于携带可以方便读取的 value。您没有值——您有一个要在类型级别强制执行的权限列表——所以我认为您不需要或不想要 reader、异构列表或其他类似的东西那。
相反,给定一个布尔权限列表:
data Permission = PermissionA | PermissionB deriving (Show)
你想定义一个在类型级别参数化的 monad 及其授予的权限列表。围绕底层 IO
monad 的新型包装器将执行:
{-# LANGUAGE DataKinds, KindSignatures, GeneralizedNewtypeDeriving #-}
newtype M (ps :: [Permission]) a = M (IO a) deriving (Functor, Applicative, Monad)
您还需要类型函数(也称为类型族)来确定权限是否在权限列表中:
{-# LANGUAGE TypeFamilies, TypeOperators #-}
type family Allowed (p :: Permission) ps where
Allowed p '[] = False
Allowed p (p:ps) = True
Allowed p (q:ps) = Allowed p ps
现在,如果你想编写需要特定权限的函数,你可以这样写:
deleteA :: (Allowed PermissionA ps ~ True) => M ps ()
deleteA = M $ print "Deleted A"
readB :: (Allowed PermissionB ps ~ True) => M ps ()
readB = M $ print "Read B"
copyBtoA :: ( Allowed PermissionA ps ~ True
, Allowed PermissionB ps ~ True) => M ps ()
copyBtoA = M $ print "Copied B to A"
为了运行一个M
动作,我们引入了一个运行没有权限的函数:
-- runM with no permissions
runM :: M '[] a -> IO a
runM (M act) = act
请注意,如果您尝试 runM readB
,您将收到类型错误(无法将 False
与 True
匹配——这不是最大的错误消息,但是.. .).
要授予权限,我们引入功能:
-- grant permissions
grantA :: M (PermissionA:ps) a -> M ps a
grantA (M act) = M act
grantB :: M (PermissionB:ps) a -> M ps a
grantB (M act) = M act
这些函数本质上是术语级别的恒等函数——它们只是解包和重新包装 M
构造函数。但是,它们在类型级别的操作是为其输入参数添加权限。这意味着:
runM $ grantB $ readB
现在 type-checks。也一样:
runM $ grantA . grantB $ readB
runM $ grantB . grantA $ readB
runM $ grantB . grantA . grantB $ readB
etc.
然后你可以编写如下程序:
program :: IO ()
program = runM $ do
grantA $ do
deleteA
grantB $ do
readB
copyBtoA
同时拒绝以下节目:
program1 :: IO ()
program1 = runM $ do
grantA $ do
deleteA
grantB $ do
readB
copyBtoA -- error, needs PermissionB
这个基础设施可能有点丑陋,但它应该是您 type-based 所需要的全部,完全 compile-time 权限检查。
不妨试用一下这个版本,看看它是否满足您的需求。完整代码为:
{-# LANGUAGE DataKinds, KindSignatures, GeneralizedNewtypeDeriving,
TypeFamilies, TypeOperators #-}
data Permission = PermissionA | PermissionB deriving (Show)
newtype M (ps :: [Permission]) a = M (IO a) deriving (Functor, Applicative, Monad)
type family Allowed (p :: Permission) ps where
Allowed p '[] = False
Allowed p (p:ps) = True
Allowed p (q:ps) = Allowed p ps
-- runM with no permissions
runM :: M '[] a -> IO a
runM (M act) = act
-- grant permissions
grantA :: M (PermissionA:ps) a -> M ps a
grantA (M act) = M act
grantB :: M (PermissionB:ps) a -> M ps a
grantB (M act) = M act
deleteA :: (Allowed PermissionA ps ~ True) => M ps ()
deleteA = M $ print "Deleted A"
readB :: (Allowed PermissionB ps ~ True) => M ps ()
readB = M $ print "Read B"
copyBtoA :: ( Allowed PermissionA ps ~ True
, Allowed PermissionB ps ~ True) => M ps ()
copyBtoA = M $ print "Copied B to A"
program :: IO ()
program = runM $ do
grantA $ do
deleteA
grantB $ do
readB
copyBtoA
两个基于@dfeuer 评论的附加说明。首先,它提醒我 grantA
和 grantB
同样可以使用 Data.Coerce
中的 "safe" coerce
函数编写,如下所示。这个版本和上面的版本生成的代码没有区别,所以看个人喜好吧:
import Data.Coerce
-- grant permissions
grantA :: M (PermissionA:ps) a -> M ps a
grantA = coerce
grantB :: M (PermissionB:ps) a -> M ps a
grantB = coerce
其次,@dfeuer 所说的是这里没有明确区分用于控制权限的可信代码基础和依赖于类型系统来执行权限系统的代码 "rest" .例如,M
构造函数上的模式匹配本质上是危险的,因为您可以从一个权限上下文中提取 IO a
并在另一个权限上下文中重建它。 (这基本上就是 grantA
和 grantB
为无条件提升权限所做的事情。)如果你在受信任的代码库之外这样做 "by accident",你最终可能会绕过权限系统。在许多应用程序中,这没什么大不了的。
但是,如果您试图证明系统安全,您可能需要一个小型可信代码库,该代码库与危险的 M
构造函数一起工作,并且仅导出 "safe" API通过类型系统确保安全性。在这种情况下,您将拥有一个导出类型 M
但不导出其构造函数 M(..)
的模块。相反,您将导出智能构造函数以创建具有适当权限的 M
操作。
此外,由于不明确的技术原因,即使不导出 M
构造函数,"untrusted" 代码仍然可以在不同的权限上下文之间进行强制转换:
stealPermission :: M (PermissionA:ps) a -> M ps a
stealPermission = coerce
因为 M
类型构造函数的第一个参数有一个 so-called "role",默认为 "phantom" 而不是 "nominal"。如果你覆盖这个:
{-# LANGUAGE RoleAnnotations #-}
type role M nominal _
then coerce
只能在构造函数在范围内的地方使用,这就弥补了这个漏洞。不受信任的代码仍然可以使用 unsafeCoerce
,但有一些机制(Google 用于 "Safe Haskell")来防止这种情况。
在单独的 Gist 中,您评论道:
@K.A.Buhr, wow! Thank you for such a detailed reply. You are correct that this is an XY problem, and you've pretty-much nailed the actual problem that I'm trying to solve. Another important piece of context is that, at some point these type-level permissions will have to be "reified" at the value-level. This is because the final check is against the permissions granted to the currently signed-in user, which are stored in the DB.
Taking this into account, I'm planning to have two "general" functions, say:
requiredPermission :: (RequiredPermission p ps) => Proxy p -> AppM ps () optionalPermission :: (OptionalPermission p ps) => Proxy p -> AppM ps ()
Here's the difference:
requiredPermission
will simply add the permission to the type-level list and it will be verified whenrunAppM
is called. If the current user does not have ALL the required permissions, thenrunAppM
will immediately throw a 401 error to the UI.- On the other hand,
optionalPermission
will extract the user from theReader
environment, check the permission, and return a True / False.runAppM
will do nothing withOptionalPermissions
. These will be for cases where the absence of a permission should NOT fail the entire action, but skip a specific step in the action.Given this context, I'm not sure if I would end-up with functions, like grantA or grantB. The "unwrapping" of ALL the RequestPermissions in the AppM constructor will be done by runAppM, which will also ensure that the currently sign-in user actually has these permissions.
请注意,“具体化”类型的方法不止一种。例如,以下程序——通过狡猾的黑魔法诡计——设法在不使用代理或单例的情况下具体化 运行time 类型!
main = do
putStr "Enter \"Int\" or \"String\": "
s <- getLine
putStrLn $ case s of "Int" -> "Here is an integer: " ++ show (42 :: Int)
"String" -> "Here is a string: " ++ show ("hello" :: String)
同样,grantA
的以下变体设法将仅在 运行 时间已知的用户权限提升到 type-level:
whenA :: M (PermissionA:ps) () -> M ps ()
whenA act = do
perms <- asks userPermissions -- get perms from environment
if PermissionA `elem` perms
then act
else notAuthenticated
在这里可以使用单例来避免不同权限的样板,并提高这段受信任代码的类型安全性(即,PermissionA
的两次出现被强制匹配)。同样,约束类型可能会在每次权限检查时保存 5 或 6 个字符。然而,这些改进都不是必需的,并且它们可能会增加大量的复杂性,如果可能的话,应该避免这种情况,直到 after 你得到一个工作原型。换句话说,无法运行的优雅代码并不那么优雅。
本着这种精神,这就是我如何调整我的原始解决方案以支持一组必须在特定“入口点”(例如,特定路由的 Web 请求)满足的“必需”权限,并执行 运行时间权限检查用户数据库。
首先,我们有一组权限:
data Permission
= ReadP -- read content
| MetaP -- view (private) metadata
| WriteP -- write content
| AdminP -- all permissions
deriving (Show, Eq)
和一个用户数据库:
type User = String
userDB :: [(User, [Permission])]
userDB
= [ ("alice", [ReadP, WriteP])
, ("bob", [ReadP])
, ("carl", [AdminP])
]
以及包含用户权限和您想要在 reader 中携带的任何其他内容的环境:
data Env = Env
{ uperms :: [Permission] -- user's actual permissions
, user :: String -- other Env stuff
} deriving (Show)
我们还需要类型和术语级别的函数来检查权限列表:
type family Allowed (p :: Permission) ps where
Allowed p (AdminP:ps) = True -- admins can do anything
Allowed p '[] = False
Allowed p (p:ps) = True
Allowed p (q:ps) = Allowed p ps
allowed :: Permission -> [Permission] -> Bool
allowed p (AdminP:ps) = True
allowed p (q:ps) | p == q = True
| otherwise = allowed p ps
allowed p [] = False
(是的,您可以使用 singletons
库同时定义这两个函数,但现在让我们在没有单例的情况下执行此操作。)
和以前一样,我们将有一个带有权限列表的 monad。您可以将其视为代码中此时已检查和验证的权限列表。我们将使它成为具有 ReaderT Env
组件的通用 m
的 monad 转换器:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
newtype AppT (perms :: [Permission]) m a = AppT (ReaderT Env m a)
deriving (Functor, Applicative, Monad, MonadReader Env, MonadIO)
现在,我们可以在这个 monad 中定义动作,这些动作构成了我们应用程序的构建块:
readPage :: (Allowed ReadP perms ~ True, MonadIO m) => Int -> AppT perms m ()
readPage n = say $ "Read page " ++ show n
metaPage :: (Allowed ReadP perms ~ True, MonadIO m) => Int -> AppT perms m ()
metaPage n = say $ "Secret metadata " ++ show (n^2)
editPage :: (Allowed ReadP perms ~ True, Allowed WriteP perms ~ True, MonadIO m) => Int -> AppT perms m ()
editPage n = say $ "Edit page " ++ show n
say :: MonadIO m => String -> m ()
say = liftIO . putStrLn
在每种情况下,在已检查和验证的权限列表包括类型签名中列出的所需权限的任何上下文中都允许该操作。 (是的,约束种类在这里可以很好地工作,但让我们保持简单。)
我们可以用这些构建更复杂的动作,就像我们在另一个答案中所做的那样:
readPageWithMeta :: ( Allowed 'ReadP perms ~ 'True, Allowed 'MetaP perms ~ 'True
, MonadIO m) => Int -> AppT perms m ()
readPageWithMeta n = do
readPage n
metaPage n
请注意,GHC 实际上可以自动推断此类型签名,确定需要 ReadP
和 MetaP
权限。如果我们想让 MetaP
权限可选,我们可以这样写:
readPageWithOptionalMeta :: ( Allowed 'ReadP perms ~ 'True
, MonadIO m) => Int -> AppT perms m ()
readPageWithOptionalMeta n = do
readPage n
whenMeta $ metaPage n
其中 whenMeta
允许根据可用权限执行可选操作。 (见下文。)同样,可以自动推断出这个签名。
到目前为止,虽然我们允许可选权限,但我们还没有明确处理“必需”权限。这些将在 入口点 指定,这将使用单独的 monad 定义:
newtype EntryT' (reqP :: [Permission]) (checkedP :: [Permission]) m a
= EntryT (ReaderT Env m a)
deriving (Functor, Applicative, Monad, MonadReader Env, MonadIO)
type EntryT reqP = EntryT' reqP reqP
这需要一些解释。 EntryT'
(带勾号)有两个权限列表。第一个是入口点所需权限的完整列表,每个特定入口点都有一个固定值。第二个是已“检查”的那些权限的子集(在静态意义上,函数调用已到位以检查和验证用户是否具有所需的权限)。当我们定义入口点时,它将从空列表构建到所需权限的完整列表。我们将把它用作 type-level 机制来确保正确的权限检查函数调用集就位。 EntryT
(无勾号)的(静态)检查权限等于其所需权限,这就是我们知道 运行 是安全的(针对特定用户动态确定的权限集,这将全部根据类型进行检查。
runEntryT :: MonadIO m => User -> EntryT req m () -> m ()
runEntryT u (EntryT act)
= case lookup u userDB of
Nothing -> say $ "error 401: no such user '" ++ u ++ "'"
Just perms -> runReaderT act (Env perms u)
要定义一个入口点,我们将使用这样的东西:
entryReadPage :: MonadIO m => Int -> EntryT '[ReadP] m ()
entryReadPage n = _somethingspecial_ $ do
readPage n
whenMeta $ metaPage n
请注意,我们这里有一个 do
块,由 AppT
个积木构成。事实上,它等同于上面的 readPageWithOptionalMeta
类型也是如此:
(Allowed 'ReadP perms ~ 'True, MonadIO m) => Int -> AppT perms m ()
这里的_somethingspecial_
需要适配这个AppT
(其权限列表需要ReadP
在运行之前检查和验证)到一个入口点其所需和(静态)检查权限列表为 [ReadP]
。我们将使用一组函数来检查实际的 运行 时间权限:
requireRead :: MonadIO m => EntryT' r c m () -> EntryT' r (ReadP:c) m ()
requireRead = unsafeRequire ReadP
requireWrite :: MonadIO m => EntryT' r c m () -> EntryT' r (WriteP:c) m ()
requireWrite = unsafeRequire WriteP
-- plus functions for the rest of the permissions
全部根据以下定义:
unsafeRequire :: MonadIO m => Permission -> EntryT' r c m () -> EntryT' r c' m ()
unsafeRequire p act = do
ps <- asks uperms
if allowed p ps
then coerce act
else say $ "error 403: requires permission " ++ show p
现在,当我们写:
entryReadPage :: MonadIO m => Int -> EntryT '[ReadP] m ()
entryReadPage n = requireRead . _ $ do
readPage n
whenMeta $ metaPage n
外部类型是正确的,反映了 requireXXX
函数列表与类型签名中所需权限列表匹配的事实。剩余的孔具有类型:
AppT perms0 m0 () -> EntryT' '[ReadP] '[] m ()
由于我们构造权限检查的方式,这是 t 的特例e 安全转换:
toRunAppT :: MonadIO m => AppT r m a -> EntryT' r '[] m a
toRunAppT = coerce
换句话说,我们可以使用一个相当不错的语法来编写我们最终的入口点定义,它的字面意思是我们“需要 Read
到 运行 这个 AppT
”:
entryReadPage :: MonadIO m => Int -> EntryT '[ReadP] m ()
entryReadPage n = requireRead . toRunAppT $ do
readPage n
whenMeta $ metaPage n
类似地:
entryEditPage :: MonadIO m => Int -> EntryT '[ReadP, WriteP] m ()
entryEditPage n = requireRead . requireWrite . toRunAppT $ do
editPage n
whenMeta $ metaPage n
观察到所需权限的列表明确包含在入口点的类型中,并且执行 运行 对这些权限进行时间检查的 requireXXX
函数的组成列表必须与这些相同的权限完全匹配,以相同的顺序,对其进行类型检查。
最后一块拼图是 whenMeta
的实现,它执行 运行time 权限检查并在权限可用时执行可选操作。
whenMeta :: Monad m => AppT (MetaP:perms) m () -> AppT perms m ()
whenMeta = unsafeWhen MetaP
-- and similar functions for other permissions
unsafeWhen :: Monad m => Permission -> AppT perms m () -> AppT perms' m ()
unsafeWhen p act = do
ps <- asks uperms
if allowed p ps
then coerce act
else return ()
这是带有测试工具的完整程序。你可以看到:
Username/Req (e.g., "alice Read 5"): alice Read 5 -- Alice...
Read page 5
Username/Req (e.g., "alice Read 5"): bob Read 5 -- and Bob can read.
Read page 5
Username/Req (e.g., "alice Read 5"): carl Read 5 -- Carl gets the metadata, too
Read page 5
Secret metadata 25
Username/Req (e.g., "alice Read 5"): bob Edit 3 -- Bob can't edit...
error 403: requires permission WriteP
Username/Req (e.g., "alice Read 5"): alice Edit 3 -- but Alice can.
Edit page 3
Username/Req (e.g., "alice Read 5"):
来源:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Realistic where
import Control.Monad.Reader
import Data.Coerce
-- |Set of permissions
data Permission
= ReadP -- read content
| MetaP -- view (private) metadata
| WriteP -- write content
| AdminP -- all permissions
deriving (Show, Eq)
type User = String
-- |User database
userDB :: [(User, [Permission])]
userDB
= [ ("alice", [ReadP, WriteP])
, ("bob", [ReadP])
, ("carl", [AdminP])
]
-- |Environment with 'uperms' and whatever else is needed
data Env = Env
{ uperms :: [Permission] -- user's actual permissions
, user :: String -- other Env stuff
} deriving (Show)
-- |Check for permission in type-level and term-level lists
type family Allowed (p :: Permission) ps where
Allowed p (AdminP:ps) = True -- admins can do anything
Allowed p '[] = False
Allowed p (p:ps) = True
Allowed p (q:ps) = Allowed p ps
allowed :: Permission -> [Permission] -> Bool
allowed p (AdminP:ps) = True
allowed p (q:ps) | p == q = True
| otherwise = allowed p ps
allowed p [] = False
-- |An application action running with a given list of checked permissions.
newtype AppT (perms :: [Permission]) m a = AppT (ReaderT Env m a)
deriving (Functor, Applicative, Monad, MonadReader Env, MonadIO)
-- Optional actions run if permissions are available at runtime.
whenRead :: Monad m => AppT (ReadP:perms) m () -> AppT perms m ()
whenRead = unsafeWhen ReadP
whenMeta :: Monad m => AppT (MetaP:perms) m () -> AppT perms m ()
whenMeta = unsafeWhen MetaP
whenWrite :: Monad m => AppT (WriteP:perms) m () -> AppT perms m ()
whenWrite = unsafeWhen WriteP
whenAdmin :: Monad m => AppT (AdminP:perms) m () -> AppT perms m ()
whenAdmin = unsafeWhen AdminP
unsafeWhen :: Monad m => Permission -> AppT perms m () -> AppT perms' m ()
unsafeWhen p act = do
ps <- asks uperms
if allowed p ps
then coerce act
else return ()
-- |An entry point, requiring a list of permissions
newtype EntryT' (reqP :: [Permission]) (checkedP :: [Permission]) m a
= EntryT (ReaderT Env m a)
deriving (Functor, Applicative, Monad, MonadReader Env, MonadIO)
-- |An entry point whose full list of required permission has been (statically) checked).
type EntryT reqP = EntryT' reqP reqP
-- |Run an entry point whose required permissions have been checked.
runEntryT :: MonadIO m => User -> EntryT req m () -> m ()
runEntryT u (EntryT act)
= case lookup u userDB of
Nothing -> say $ "error 401: no such user '" ++ u ++ "'"
Just perms -> runReaderT act (Env perms u)
-- Functions to build the list of required permissions for an entry point.
requireRead :: MonadIO m => EntryT' r c m () -> EntryT' r (ReadP:c) m ()
requireRead = unsafeRequire ReadP
requireMeta :: MonadIO m => EntryT' r c m () -> EntryT' r (MetaP:c) m ()
requireMeta = unsafeRequire MetaP
requireWrite :: MonadIO m => EntryT' r c m () -> EntryT' r (WriteP:c) m ()
requireWrite = unsafeRequire WriteP
requireAdmin :: MonadIO m => EntryT' r c m () -> EntryT' r (AdminP:c) m ()
requireAdmin = unsafeRequire AdminP
unsafeRequire :: MonadIO m => Permission -> EntryT' r c m () -> EntryT' r c' m ()
unsafeRequire p act = do
ps <- asks uperms
if allowed p ps
then coerce act
else say $ "error 403: requires permission " ++ show p
-- Adapt an entry point w/ all static checks to an underlying application action.
toRunAppT :: MonadIO m => AppT r m a -> EntryT' r '[] m a
toRunAppT = coerce
-- Example application actions
readPage :: (Allowed ReadP perms ~ True, MonadIO m) => Int -> AppT perms m ()
readPage n = say $ "Read page " ++ show n
metaPage :: (Allowed ReadP perms ~ True, MonadIO m) => Int -> AppT perms m ()
metaPage n = say $ "Secret metadata " ++ show (n^2)
editPage :: (Allowed ReadP perms ~ True, Allowed WriteP perms ~ True, MonadIO m) => Int -> AppT perms m ()
editPage n = say $ "Edit page " ++ show n
say :: MonadIO m => String -> m ()
say = liftIO . putStrLn
-- Example entry points
entryReadPage :: MonadIO m => Int -> EntryT '[ReadP] m ()
entryReadPage n = requireRead . toRunAppT $ do
readPage n
whenMeta $ metaPage n
entryEditPage :: MonadIO m => Int -> EntryT '[ReadP, WriteP] m ()
entryEditPage n = requireRead . requireWrite . toRunAppT $ do
editPage n
whenMeta $ metaPage n
-- Test harnass
data Req = Read Int
| Edit Int
deriving (Read)
main :: IO ()
main = do
putStr "Username/Req (e.g., \"alice Read 5\"): "
ln <- getLine
case break (==' ') ln of
(user, ' ':rest) -> case read rest of
Read n -> runEntryT user $ entryReadPage n
Edit n -> runEntryT user $ entryEditPage n
main