faceted 0.0.1.0 → 0.0.2.0

raw patch · 11 files changed

+203/−203 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Data/Faceted.hs +10/−0
• Data/Faceted/FHandle.hs +32/−0
• Data/Faceted/FIORef.hs +34/−0
• Data/Faceted/Internal.hs +95/−0
• Data/Faceted/Pure.hs +29/−0
• Faceted.hs +0/−10
• Faceted/FHandle.hs +0/−32
• Faceted/FIORef.hs +0/−34
• Faceted/Internal.hs +0/−95
• Faceted/Pure.hs +0/−29
• faceted.cabal +3/−3

@@ -0,0 +1,10 @@+module Data.Faceted (+  module Data.Faceted.Pure,+  module Data.Faceted.FIORef,+  module Data.Faceted.FHandle+  ) where++import Data.Faceted.Pure+import Data.Faceted.FIORef+import Data.Faceted.FHandle+

@@ -0,0 +1,32 @@+{-# LANGUAGE GADTs,RankNTypes,DeriveFunctor #-}++module Data.Faceted.FHandle (+  View,+  FHandle,+  openFileF,+  hPutCharF,+  hGetCharF,+  ) where++import Data.Faceted.Internal++import System.IO++-- | Facet-aware file handles+data FHandle = FHandle View Handle+ +openFileF :: View -> FilePath -> IOMode -> FIO FHandle+openFileF view path mode = FIO $ \pc ->+  do handle <- openFile path mode+     return (FHandle view handle)++hGetCharF :: FHandle -> FIO (Faceted Char)+hGetCharF (FHandle view handle) = FIO hGetCharForPC+  where hGetCharForPC pc =+          do ch <- hGetChar handle+             return (pcF (map Private view) (Raw ch) (Raw undefined))++hPutCharF :: FHandle -> Faceted Char -> FIO ()+hPutCharF (FHandle view handle) ch = FIO hPutCharForPC+  where hPutCharForPC pc | pc `visibleTo` view = hPutChar handle (project view ch)+                         | otherwise = return ()

@@ -0,0 +1,34 @@+{-# LANGUAGE GADTs,RankNTypes,DeriveFunctor #-}++module Data.Faceted.FIORef (+  FIORef,+  newFIORef,+  readFIORef,+  writeFIORef,+  ) where++import Data.Faceted.Internal++import Data.IORef++-- | Variables of type 'FIORef a' are faceted 'IORef's+data FIORef a = FIORef (IORef (Faceted a))++-- | Allocate a new 'FIORef'+newFIORef :: Faceted a -> FIO (FIORef a)+newFIORef init = FIO newFIORefForPC+  where newFIORefForPC pc = do var <- newIORef (pcF pc init undefined)+                               return (FIORef var)++-- | Read an 'FIORef'+readFIORef :: FIORef a -> FIO (Faceted a)+readFIORef (FIORef var) = FIO readFIORefForPC+  where readFIORefForPC pc = do faceted <- readIORef var+                                return faceted ++-- | Write an 'FIORef'+writeFIORef :: FIORef a -> Faceted a -> FIO ()+writeFIORef (FIORef var) newValue = FIO writeFIORefForPC+  where writeFIORefForPC pc = do oldValue <- readIORef var+                                 writeIORef var (pcF pc newValue oldValue)+

@@ -0,0 +1,95 @@+{-# LANGUAGE GADTs,RankNTypes,DeriveFunctor,DeriveDataTypeable #-}++module Data.Faceted.Internal(+  Label,+  Faceted(Raw,Faceted),+  PC,+  Branch(Private,Public),+  View,+  FIO(FIO),+  pcF,+  project,+  visibleTo+  ) where++import Control.Applicative+import Control.Monad+import Data.IORef+import Data.List+import System.IO+import Data.Dynamic++-- | A security label is any string.+-- Labels need not be secrets; they+-- may be readable strings. Information flow security is ensured by a+-- combination of the type system and dynamic checks.+type Label = String++-- | A _view_ is any set of labels. +-- In enforcing information flow security Each view may see a different value.+type View = [Label]++-- | Type 'Faceted a' represents (possibly) faceted values.+--+-- <k ? x : y>   ====>  Faceted k x y + +data Faceted a =+    Raw a+  | Faceted Label (Faceted a) (Faceted a)+  deriving (Show, Eq, Typeable)++-- | Functor: For when the function is pure but the argument has facets.+instance Functor Faceted where+  fmap f (Raw v)              = Raw (f v)+  fmap f (Faceted k priv pub) = Faceted k (fmap f priv) (fmap f pub)++-- | Applicative: For when the function and argument both have facets.+instance Applicative Faceted where+  pure x  = Raw x+  (Raw f) <*> x  =  fmap f x+  (Faceted k priv pub) <*> x  =  Faceted k (priv <*> x) (pub <*> x)++-- | Monad: Like applicative, but even more powerful. 'Faceted' the free monad+-- over the function 'Facets a = F Label a a'. +instance Monad Faceted where+  return x = Raw x+  (Raw x)              >>= f  = f x+  (Faceted k priv pub) >>= f  = Faceted k (priv >>= f) (pub >>= f)++++-- | A Branch is a principal or its negatives, and a pc is a set of branches.++data Branch = Public Label | Private Label deriving (Eq, Show)+type PC = [Branch]++-- | << pc ? x : y >>  =====>   pcF pc x y++pcF :: PC -> Faceted a -> Faceted a -> Faceted a+pcF []                      x _ = x+pcF (Private k : branches) x y = Faceted k (pcF branches x y) y+pcF (Public k  : branches) x y = Faceted k y (pcF branches x y)++-- Private+project :: View -> Faceted a -> a+project view (Raw v) = v+project view (Faceted k priv pub)+  | k `elem`    view = project view priv+  | k `notElem` view = project view pub++-- Private+visibleTo :: PC -> View -> Bool+visibleTo pc view = all consistent pc+  where consistent (Private k)  = k `elem` view+        consistent (Public k) = k `notElem` view+++-- | Faceted IO+data FIO a = FIO { runFIO :: PC -> IO a }++-- | Monad is straightforward+instance Monad FIO where+  return x = FIO (\pc -> return x)+  x >>= f  = FIO (\pc -> do v <- runFIO x pc+                            runFIO (f v) pc)+

@@ -0,0 +1,29 @@+{-# LANGUAGE GADTs,RankNTypes,DeriveFunctor #-}++module Data.Faceted.Pure (+  Label,+  Faceted,+  makePrivate,+  makeFaceted,+  makePublic,+  bottom+  ) where++import Data.Faceted.Internal++import Control.Applicative++bottom = Raw undefined++-- | < k ? x : bottom >   ====>  makePrivate k x++makePrivate :: Label -> a -> Faceted a+makePrivate k x = Faceted k (Raw x) (bottom)++-- | x ==> Raw x ===> makePublic x++makePublic :: a -> Faceted a+makePublic x = Raw x++makeFaceted = Faceted+

@@ -1,10 +0,0 @@-module Faceted (-  module Faceted.Pure,-  module Faceted.FIORef,-  module Faceted.FHandle-  ) where--import Faceted.Pure-import Faceted.FIORef-import Faceted.FHandle-

@@ -1,32 +0,0 @@-{-# LANGUAGE GADTs,RankNTypes,DeriveFunctor #-}--module Faceted.FHandle (-  View,-  FHandle,-  openFileF,-  hPutCharF,-  hGetCharF,-  ) where--import Faceted.Internal--import System.IO---- | Facet-aware file handles-data FHandle = FHandle View Handle- -openFileF :: View -> FilePath -> IOMode -> FIO FHandle-openFileF view path mode = FIO $ \pc ->-  do handle <- openFile path mode-     return (FHandle view handle)--hGetCharF :: FHandle -> FIO (Faceted Char)-hGetCharF (FHandle view handle) = FIO hGetCharForPC-  where hGetCharForPC pc =-          do ch <- hGetChar handle-             return (pcF (map Private view) (Raw ch) (Raw undefined))--hPutCharF :: FHandle -> Faceted Char -> FIO ()-hPutCharF (FHandle view handle) ch = FIO hPutCharForPC-  where hPutCharForPC pc | pc `visibleTo` view = hPutChar handle (project view ch)-                         | otherwise = return ()

@@ -1,34 +0,0 @@-{-# LANGUAGE GADTs,RankNTypes,DeriveFunctor #-}--module Faceted.FIORef (-  FIORef,-  newFIORef,-  readFIORef,-  writeFIORef,-  ) where--import Faceted.Internal--import Data.IORef---- | Variables of type 'FIORef a' are faceted 'IORef's-data FIORef a = FIORef (IORef (Faceted a))---- | Allocate a new 'FIORef'-newFIORef :: Faceted a -> FIO (FIORef a)-newFIORef init = FIO newFIORefForPC-  where newFIORefForPC pc = do var <- newIORef (pcF pc init undefined)-                               return (FIORef var)---- | Read an 'FIORef'-readFIORef :: FIORef a -> FIO (Faceted a)-readFIORef (FIORef var) = FIO readFIORefForPC-  where readFIORefForPC pc = do faceted <- readIORef var-                                return faceted ---- | Write an 'FIORef'-writeFIORef :: FIORef a -> Faceted a -> FIO ()-writeFIORef (FIORef var) newValue = FIO writeFIORefForPC-  where writeFIORefForPC pc = do oldValue <- readIORef var-                                 writeIORef var (pcF pc newValue oldValue)-

@@ -1,95 +0,0 @@-{-# LANGUAGE GADTs,RankNTypes,DeriveFunctor,DeriveDataTypeable #-}--module Faceted.Internal(-  Label,-  Faceted(Raw,Faceted),-  PC,-  Branch(Private,Public),-  View,-  FIO(FIO),-  pcF,-  project,-  visibleTo-  ) where--import Control.Applicative-import Control.Monad-import Data.IORef-import Data.List-import System.IO-import Data.Dynamic---- | A security label is any string.--- Labels need not be secrets; they--- may be readable strings. Information flow security is ensured by a--- combination of the type system and dynamic checks.-type Label = String---- | A _view_ is any set of labels. --- In enforcing information flow security Each view may see a different value.-type View = [Label]---- | Type 'Faceted a' represents (possibly) faceted values.------ <k ? x : y>   ====>  Faceted k x y - -data Faceted a =-    Raw a-  | Faceted Label (Faceted a) (Faceted a)-  deriving (Show, Eq, Typeable)---- | Functor: For when the function is pure but the argument has facets.-instance Functor Faceted where-  fmap f (Raw v)              = Raw (f v)-  fmap f (Faceted k priv pub) = Faceted k (fmap f priv) (fmap f pub)---- | Applicative: For when the function and argument both have facets.-instance Applicative Faceted where-  pure x  = Raw x-  (Raw f) <*> x  =  fmap f x-  (Faceted k priv pub) <*> x  =  Faceted k (priv <*> x) (pub <*> x)---- | Monad: Like applicative, but even more powerful. 'Faceted' the free monad--- over the function 'Facets a = F Label a a'. -instance Monad Faceted where-  return x = Raw x-  (Raw x)              >>= f  = f x-  (Faceted k priv pub) >>= f  = Faceted k (priv >>= f) (pub >>= f)------ | A Branch is a principal or its negatives, and a pc is a set of branches.--data Branch = Public Label | Private Label deriving (Eq, Show)-type PC = [Branch]---- | << pc ? x : y >>  =====>   pcF pc x y--pcF :: PC -> Faceted a -> Faceted a -> Faceted a-pcF []                      x _ = x-pcF (Private k : branches) x y = Faceted k (pcF branches x y) y-pcF (Public k  : branches) x y = Faceted k y (pcF branches x y)---- Private-project :: View -> Faceted a -> a-project view (Raw v) = v-project view (Faceted k priv pub)-  | k `elem`    view = project view priv-  | k `notElem` view = project view pub---- Private-visibleTo :: PC -> View -> Bool-visibleTo pc view = all consistent pc-  where consistent (Private k)  = k `elem` view-        consistent (Public k) = k `notElem` view----- | Faceted IO-data FIO a = FIO { runFIO :: PC -> IO a }---- | Monad is straightforward-instance Monad FIO where-  return x = FIO (\pc -> return x)-  x >>= f  = FIO (\pc -> do v <- runFIO x pc-                            runFIO (f v) pc)-

@@ -1,29 +0,0 @@-{-# LANGUAGE GADTs,RankNTypes,DeriveFunctor #-}--module Faceted.Pure (-  Label,-  Faceted,-  makePrivate,-  makeFaceted,-  makePublic,-  bottom-  ) where--import Faceted.Internal--import Control.Applicative--bottom = Raw undefined---- | < k ? x : bottom >   ====>  makePrivate k x--makePrivate :: Label -> a -> Faceted a-makePrivate k x = Faceted k (Raw x) (bottom)---- | x ==> Raw x ===> makePublic x--makePublic :: a -> Faceted a-makePublic x = Raw x--makeFaceted = Faceted-

@@ -1,5 +1,5 @@ name:                faceted-version:             0.0.1.0+version:             0.0.2.0 synopsis:            Faceted computation for dynamic information flow security homepage:            http://github.com/haskell-faceted/haskell-faceted license:             Apache-2.0@@ -23,8 +23,8 @@   location: git://github.com/haskell-faceted/haskell-faceted.git  library-  exposed-modules: Faceted-  other-modules: Faceted.Internal, Faceted.FIORef, Faceted.FHandle, Faceted.Pure+  exposed-modules: Data.Faceted+  other-modules: Data.Faceted.Internal, Data.Faceted.FIORef, Data.Faceted.FHandle, Data.Faceted.Pure   hs-source-dirs: .   build-depends: base ==4.6.*,                  free >=4.6