冒着成为XY Problem的风险,是否可能使public class MyClass
{
public class MyStuff
{
string foo { get; set; }
}
private ObservableCollection<MyStuff> _collection;
public ObservableCollection<MyStuff> Items { get { return _collection; } }
public MyClass()
{
_collection = new ObservableCollection<MyStuff>();
this.LoadMyCollectionByRef<MyStuff>(ref _collection);
}
public void LoadMyCollectionByRef<T>(ref ObservableCollection<T> objects_collection)
{
// Load refered collection
}
}
的环境有所不同?我正在尝试类似...
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
类
我正在尝试在类型级别上跟踪权限/角色,我的最终目标是编写类似...的功能
*
...,其中每个对ensurePermission :: (p :: Permission) -> AppM (p :. ps) ()
的调用都会在monad的权限列表(类型级别)上追加/添加新的权限。
我尝试了以下操作,并且似乎可以编译,但是我不确定发生了什么。从概念上讲,ensurePermission
仍然不是perms
类型。这段代码如何被编译器接受,但原始代码却不可接受?
[*]
我试图发展自己的代码段以进一步匹配最终目标,但是我又遇到了另一个“种类”问题:
编译器不接受以下代码:
data HList (l :: [*]) where
HNil :: HList '[]
HCons :: e -> HList l -> HList (e ': l)
type AppM (perms :: [*]) = ReaderT (HList perms) IO
它也不接受以下变化...
{-# 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)
-- | ^^^^^^^^^^
答案 0 :(得分:4)
是的,我认为我们这里有一个XY问题,所以让我们退后一步。
Reader
是一个单字,用于携带可以方便阅读的值。您没有价值-您有要在类型级别强制执行的权限列表-因此我认为您不需要或不需要读者,异构列表或类似的东西。>
相反,给出一个布尔权限列表:
data Permission = PermissionA | PermissionB deriving (Show)
您要使用其授予的权限列表定义在类型级别参数化的monad。围绕基础IO
单子的新型包装器将执行以下操作:
{-# LANGUAGE DataKinds, KindSignatures, GeneralizedNewtypeDeriving #-}
newtype M (ps :: [Permission]) a = M (IO a) deriving (Functor, Applicative, Monad)
您还需要一个类型函数(AKA类型族)来确定权限是否在权限列表中:
{-# 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
现在进行类型检查。也是这样:
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
此基础架构可能有点丑陋,但这应该是基于类型的完全编译时权限检查所需的全部。
也许可以尝试一下这个版本,看看它是否满足您的需求。完整的代码是:
{-# 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
同样可以使用coerce
中的“安全” Data.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所说的是,用于控制权限的可信任代码库与依赖类型系统来执行权限系统的代码“其余”部分之间没有明显的区别。例如,在M
构造函数上进行模式匹配本质上是危险的,因为您可以从一个权限上下文中提取IO a
并在另一个权限上下文中进行重构。 (基本上,这是grantA
和grantB
用来无条件提升特权的方法。)如果您在受信任的代码库之外“偶然”执行此操作,则最终可能会绕过权限系统。在许多应用程序中,这没什么大不了的。
但是,如果您想证明系统的安全性,则可能需要一个小的受信任的代码库,该代码库可与危险的M
构造函数一起使用,并且仅导出“安全” API,以确保通过类型系统的安全性。在这种情况下,您将有一个模块导出类型M
,但不导出其构造函数M(..)
。相反,您将导出智能构造函数以使用适当的权限创建M
操作。
出于种种技术原因,即使不导出M
构造函数,“不可信”代码仍然有可能在不同的权限上下文之间强制运行:
stealPermission :: M (PermissionA:ps) a -> M ps a
stealPermission = coerce
因为类型M
的构造函数的第一个参数具有一个所谓的“角色”,默认为“幻像”而不是“标称”。如果您覆盖此内容:
{-# LANGUAGE RoleAnnotations #-}
type role M nominal _
然后coerce
仅可在构造函数位于范围内的地方使用,这将弥补此漏洞。不受信任的代码仍可以使用unsafeCoerce
,但是有防止这种情况发生的机制(Google用于“ Safe Haskell”)。
答案 1 :(得分:2)
在另一个要点中,您评论了:
@ K.A.Buhr,哇!感谢您的详细答复。您是正确的,这是一个XY问题,并且您已经非常确定了我要解决的实际问题。另一个重要的上下文是,在某些时候,这些类型级别的权限将必须在值级别上“确定”。这是因为最终检查违反了存储在数据库中的授予当前登录用户的权限。
考虑到这一点,我计划具有两个“常规”功能,例如:
requiredPermission :: (RequiredPermission p ps) => Proxy p -> AppM ps () optionalPermission :: (OptionalPermission p ps) => Proxy p -> AppM ps ()
区别在于:
requiredPermission
只会将权限添加到类型级别列表中,并且在调用runAppM
时将得到验证。如果当前用户没有所有必需的权限,那么runAppM
将立即向用户界面抛出401错误。- 另一方面,
optionalPermission
将从Reader
环境中提取用户,检查权限,并返回True / False。runAppM
对OptionalPermissions
无效。这些情况适用于在没有权限的情况下不应使整个操作失败的情况,而应跳过操作中的特定步骤。在这种情况下,我不确定是否最终会使用GrantA或GrantB之类的函数。 AppM构造函数中所有RequestPermissions的“解包”将由runAppM完成,这还将确保当前登录的用户实际上具有这些权限。
请注意,有多种方法可以“验证”类型。例如,以下程序-通过狡猾的黑魔术-设法在不使用代理或单例的情况下,对运行时类型进行了验证!
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
的以下变体设法将仅在运行时已知的用户权限提升为类型级别:
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个字符。但是,这些改进都不是必需的,并且它们可能会增加相当大的复杂性,在之后获得可行的原型之前,应尽可能避免这种复杂性。换句话说,优雅的代码行不通。
本着这种精神,这就是我如何调整原始解决方案以支持一组在特定“入口点”(例如,特定的路由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])
]
以及包含用户权限以及您希望在阅读器中携带的其他内容的环境:
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,其中包含权限列表。您可以将其视为代码中此时已检查和验证的权限列表。我们将其作为具有m
组件的常规ReaderT Env
的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'
(带有勾号)具有两个权限列表。第一个是入口点所需权限的完整列表,并且对于每个特定入口点都有固定值。第二个是已“检查”的那些权限的子集(从静态的意义上说,有一个函数调用来检查和验证用户是否具有所需的权限)。当我们定义入口点时,它将从空白列表到所需权限的完整列表。我们将其用作类型级别的机制,以确保正确设置了一组权限检查函数调用。 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 ()
由于我们构造权限检查的方式,这是安全转换的一种特殊情况:
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
的实现,该实现执行运行时权限检查,并在权限可用时执行可选操作。
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 ()
这里是带有测试harnass的完整程序。您可以看到:
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