Safe Haskell | None |
---|---|
Language | Haskell2010 |
Defines the basic model of execution for Yggdrasil. This is modelled after, but not directly equal to, the Universal Composability framework by Ran Canetti.
Usage typically involves constructing a complex Action
, and then run
ning
it.
Synopsis
- type Operation s c a b = Ref s -> a -> StateT c (Action s) b
- data RealRef s a
- data Ref s = External
- data Action s b where
- Abort :: Action s b
- SecParam :: Action s Int
- Sample :: Distribution b -> Action s b
- Create :: InterfaceMap s c ops => Functionality s c (ops :: [(*, *)]) -> Action s (HList (Interfaces s ops))
- type family Operations s c (xs :: [(*, *)]) = (ys :: [*]) | ys -> xs where ...
- type family Interfaces s (xs :: [(*, *)]) = (ys :: [*]) | ys -> xs where ...
- data Functionality s c ops = Functionality c (HList (Operations s c ops))
- class InterfaceMap s c (ts :: [(*, *)]) where
- class ForceSample t where
- run :: (forall s. Action s b) -> DistributionT Maybe b
Documentation
type Operation s c a b = Ref s -> a -> StateT c (Action s) b Source #
Describes what a node with internal state of type c
does when passed an
input of type a
by Ref s
.
A reference to a node, either RealRef
, or external to the system.
data Action s b where Source #
Abort :: Action s b | Fail. This should be used over actual errors! |
SecParam :: Action s Int | Retrieves the security parameter of the running system. |
Sample :: Distribution b -> Action s b | Samples from a distribution. |
Create :: InterfaceMap s c ops => Functionality s c (ops :: [(*, *)]) -> Action s (HList (Interfaces s ops)) | Creates a new node from a functionality specification. |
type family Operations s c (xs :: [(*, *)]) = (ys :: [*]) | ys -> xs where ... Source #
Given a list of tuples of input and output types, construct a
corresponding list of Operation
types.
Operations s c '[] = '[] | |
Operations s c ('(a, b) ': xs) = Operation s c a b ': Operations s c xs |
type family Interfaces s (xs :: [(*, *)]) = (ys :: [*]) | ys -> xs where ... Source #
Given a list of tuples of input and output types, construct a
corresponding list of Interface
types.
Interfaces s '[] = '[] | |
Interfaces s ('(a, b) ': xs) = (a -> Action s b) ': Interfaces s xs |
data Functionality s c ops Source #
A functionality is a stateful node, with an initial state, and an
interface typed by a list of input/output type tuples, and defined through a
HList
of Operation
s.
Functionality c (HList (Operations s c ops)) |
Instances
CreateAdversarial s c as bs (WithAdversary' s c bs cs) (Functionality s c cs) Source # | |
Defined in Yggdrasil.Adversarial createAdversarial :: Adversary s c as bs -> WithAdversary' s c bs cs -> Action s (HList (Interfaces s as), Functionality s c cs) Source # |
class InterfaceMap s c (ts :: [(*, *)]) where Source #
States we can create interfaces from operations. Implemented for all ts
.
ifmap :: RealRef s c -> HList (Operations s c ts) -> HList (Interfaces s ts) Source #
Instances
InterfaceMap s c ([] :: [(*, *)]) Source # | |
Defined in Yggdrasil.ExecutionModel ifmap :: RealRef s c -> HList (Operations s c []) -> HList (Interfaces s []) Source # | |
InterfaceMap s c as => InterfaceMap s c ((,) a b ': as) Source # | |
Defined in Yggdrasil.ExecutionModel ifmap :: RealRef s c -> HList (Operations s c ((a, b) ': as)) -> HList (Interfaces s ((a, b) ': as)) Source # |
class ForceSample t where Source #
States that we can forcibly sample from a type, such that with negligible probabily there is a collision between samples.
forceSample :: Action s t Source #
Instances
ForceSample [Bool] Source # | |
Defined in Yggdrasil.ExecutionModel forceSample :: Action s [Bool] Source # |