blob: 50497dd64011be9753ebfb14ccf4feba8c66c8b3 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,
TypeSynonymInstances, FlexibleInstances #-}
-- This bizarre program failed because TcSimplify built a loop of
-- dictionaries, due to an obscure bug in the way in which superclasses
-- were added
module Main where
import Data.List
import Data.Map
class (Ord oid) => Object o oid | o -> oid where
data Access oid
class (Object o oid) => SecurityModel model o oid | model -> o
class (SecurityModel model o oid) => SecurityPolicy policy model o oid where
checkAccess :: policy -> model -> Access oid -> Bool
checkAccess _ _ _ = True
checkModel :: policy -> model -> Bool
checkModel _ _ = True
------------------------------------------------------------
-- The Linux instance
------------------------------------------------------------
type LinuxObjectId = Either [String] String
data LinuxObject = File [String] deriving (Eq, Show)
instance Object LinuxObject LinuxObjectId
data LinuxSecurityModel =
LinuxSecurityModel { lsmObjectSet :: Map LinuxObjectId LinuxObject }
-- Now defined in Data.Map, don't think this affects the bug:
-- instance (Show a, Show b) => Show (Map a b) where
-- show fm = show (fmToList fm)
instance Show LinuxSecurityModel where
show lsm = "LSM:" ++ "\tObjects: " ++ show (lsmObjectSet lsm)
instance SecurityModel LinuxSecurityModel LinuxObject LinuxObjectId
data LinuxSecurityPolicy = LinuxSecurityPolicy
instance SecurityPolicy LinuxSecurityPolicy LinuxSecurityModel LinuxObject LinuxObjectId
model :: Map LinuxObjectId LinuxObject
model = fromList [ (Left [], File []), (Left ["home"], File ["home"]) ]
-- works
-- model :: (LinuxObjectId, LinuxObject)
-- model = (Left [], File [])
main :: IO ()
main = do { putStrLn (show model) }
|
