{-# LANGUAGE Unsafe #-}{-# LANGUAGE DeriveDataTypeable #-}{-# LANGUAGE ExistentialQuantification #-}{- |
This module exports symbols that must be accessible only to trusted
code. By convention, the names of such symbols always end
\"@...TCB@\" (short for \"trusted computing base\"). In many cases, a
type is safe to export while its constructor is not. Hence, only the
constructor ends \"@TCB@\", while the type is re-exported to safe code
(without constructors) to from "LIO.Core".
Security rests on the fact that untrusted code must be compiled with
@-XSafe@. Because this module is flagged unsafe, it cannot be
imported from safe modules.
-}moduleLIO.TCB(-- * LIO monadLIOState(..),LIO(..)-- ** Accessing internal state,getLIOStateTCB,putLIOStateTCB,modifyLIOStateTCB-- * Executing IO actions,ioTCB-- * Privileged constructors,Priv(..),Labeled(..),LabelOf(..)-- * Uncatchable exception type,UncatchableTCB(..),makeCatchable-- * Trusted 'Show',ShowTCB(..)-- * 'LabeledResult's,LabeledResult(..),LResStatus(..))whereimportsafeControl.ApplicativeimportsafeControl.Exception(Exception(..),SomeException(..))importsafequalifiedControl.ConcurrentasIOimportsafeControl.MonadimportsafeData.MonoidimportsafeData.IORefimportsafeData.Typeable---- LIO Monad---- | Internal state of an 'LIO' computation.dataLIOStatel=LIOState{lioLabel::!l-- ^ Current label.,lioClearance::!l-- ^ Current clearance.}deriving(Eq,Show,Read)-- | The @LIO@ monad is a wrapper around 'IO' that keeps track of a-- /current label/ and /current clearance/. Safe code cannot execute-- arbitrary 'IO' actions from the 'LIO' monad. However, trusted-- runtime functions can use 'ioTCB' to perform 'IO' actions (which-- they should only do after appropriately checking labels).newtypeLIOla=LIOTCB(IORef(LIOStatel)->IOa)deriving(Typeable)instanceMonad(LIOl)where{-# INLINE return #-}return=LIOTCB.const.return{-# INLINE (>>=) #-}(LIOTCBma)>>=k=LIOTCB$\s->doa<-mascasekaofLIOTCBmb->mbsfail=LIOTCB.const.failinstanceFunctor(LIOl)wherefmapf(LIOTCBa)=LIOTCB$\s->as>>=return.f-- fmap typically isn't inlined, so we don't inline our definition,-- but we do define it in terms of >>= and return (which are inlined)instanceApplicative(LIOl)where{-# INLINE pure #-}pure=return{-# INLINE (<*>) #-}(<*>)=ap---- Internal state---- | Get internal state. This function is not actually unsafe, but-- to avoid future security bugs we leave all direct access to the-- internal state to trusted code.getLIOStateTCB::LIOl(LIOStatel){-# INLINE getLIOStateTCB #-}getLIOStateTCB=LIOTCBreadIORef-- | Set internal state.putLIOStateTCB::LIOStatel->LIOl(){-# INLINE putLIOStateTCB #-}putLIOStateTCBs=LIOTCB$\sp->writeIORefsp$!s-- | Update the internal state given some function.modifyLIOStateTCB::(LIOStatel->LIOStatel)->LIOl(){-# INLINE modifyLIOStateTCB #-}modifyLIOStateTCBf=dos<-getLIOStateTCBputLIOStateTCB(fs)---- Executing IO actions---- | Lifts an 'IO' computation into the 'LIO' monad. This function is-- dangerous and should only be called after appropriate checks ensure-- the 'IO' computation will not violate IFC policy.ioTCB::IOa->LIOla{-# INLINE ioTCB #-}ioTCB=LIOTCB.const---- Exception handling---- | An uncatchable exception hierarchy is used to terminate an-- untrusted thread. Wrap the uncatchable exception in-- 'UncatchableTCB' before throwing it to the thread. 'runLIO' will-- subsequently unwrap the 'UncatchableTCB' constructor.---- Note this can be circumvented by 'IO.mapException', which should be-- made unsafe. In the interim, auditing untrusted code for this is-- necessary.dataUncatchableTCB=foralle.(Exceptione)=>UncatchableTCBederiving(Typeable)instanceShowUncatchableTCBwhereshowsPrecp(UncatchableTCBe)=showsPrecpeinstanceExceptionUncatchableTCBwheretoException=SomeExceptionfromException(SomeExceptione)=caste-- | Simple utility function that strips 'UncatchableTCB' from around an-- exception.makeCatchable::SomeException->SomeExceptionmakeCatchablee@(SomeExceptioneinner)=casecasteinnerofJust(UncatchableTCBenew)->SomeExceptionenewNothing->e---- Privileges---- | A newtype wrapper that can be used by trusted code to transform a-- powerless description of privileges into actual privileges. The-- constructor, 'PrivTCB', is dangerous as it allows creation of-- arbitrary privileges. Hence it is only exported by the unsafe-- module "LIO.TCB". A safe way to create arbitrary privileges is to-- call 'privInit' (see "LIO.Run#v:privInit") from the 'IO' monad-- before running your 'LIO' computation.newtypePriva=PrivTCBaderiving(Show,Eq,Typeable)instanceMonoidp=>Monoid(Privp)wheremempty=PrivTCBmempty{-# INLINE mappend #-}mappend(PrivTCBm1)(PrivTCBm2)=PrivTCB$m1`mappend`m2{-# INLINE mconcat #-}mconcatps=PrivTCB$mconcat$map(\(PrivTCBp)->p)ps---- Pure labeled values---- | @Labeled l a@ is a value that associates a label of type @l@ with-- a pure value of type @a@. Labeled values allow users to label data-- with a label other than the current label. Note that 'Labeled' is-- an instance of 'LabelOf', which means that only the /contents/ of a-- labeled value (the type @t@) is kept secret, not the label. Of-- course, if you have a @Labeled@ within a @Labeled@, then the label-- on the inner value will be protected by the outer label.dataLabeledlt=LabeledTCB!ltderivingTypeable-- Note: t cannot be strict if we want things like lFmap.-- | Trusted 'Show' instance.instance(Showl,Showa)=>ShowTCB(Labeledla)whereshowTCB(LabeledTCBla)=showa++" {"++showl++"}"-- | Generic class used to get the type of labeled objects. For,-- instance, if you wish to associate a label with a pure value (as in-- "LIO.Labeled"), you may create a data type:-- -- > newtype LVal l a = LValTCB (l, a)-- -- Then, you may wish to allow untrusted code to read the label of any-- @LVal@s but not necessarily the actual value. To do so, simply-- provide an instance for @LabelOf@:-- -- > instance LabelOf LVal where-- > labelOf (LValTCB lv) = fst lvclassLabelOftwhere-- | Get the label of a labeled value or object. Note the label-- must be the second to last type constructor argument.labelOf::tla->linstanceLabelOfLabeledwhere{-# INLINE labelOf #-}labelOf(LabeledTCBl_)=l---- Trusted 'Show'---- | It would be a security issue to make certain objects members of-- the 'Show' class. Nonetheless it is useful to be able to examine-- such objects when debugging. The 'showTCB' method can be used to-- examine such objects.classShowTCBawhereshowTCB::a->String---- LabeledResult---- | Status of a 'LabeledResult'.dataLResStatusla=LResEmpty|LResLabelTooHigh!l|LResResultaderiving(Show)-- | A @LabeledResult@ encapsulates a future result from a computation-- spawned by 'lFork' or 'lForkP'. See "LIO.Concurrent" for a-- description of the concurrency abstractions of LIO.dataLabeledResultla=LabeledResultTCB{lresThreadIdTCB::!IO.ThreadId-- ^ Thread executing the computation,lresLabelTCB::!l-- ^ Label of the tresult,lresBlockTCB::!(IO.MVar()),lresStatusTCB::!(IORef(LResStatusla))-- ^ Result (when it is ready), or the label at which the thread-- terminated, if that label could not flow to 'lresLabelTCB'.}instanceLabelOfLabeledResultwherelabelOf=lresLabelTCB