-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | The NetCore compiler and runtime system for OpenFlow networks. -- -- NetCore is a high-level network programming language. This package -- provides a NetCore compiler and runtime system for OpenFlow networks. -- See the Frenetic.NetCore module for commonly used functions. We -- have several example programs available online at -- https://github.com/frenetic-lang/netcore/tree/master/examples @package netcore @version 1.0.0 module Frenetic.EthernetAddress data EthernetAddress EthernetAddress :: Word64 -> EthernetAddress unpackEth64 :: EthernetAddress -> Word64 ethernetAddress :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> EthernetAddress broadcastAddress :: EthernetAddress ethernetAddress64 :: Word64 -> EthernetAddress unpackEthernetAddress :: EthernetAddress -> (Word8, Word8, Word8, Word8, Word8, Word8) instance Eq EthernetAddress instance Ord EthernetAddress instance Binary EthernetAddress instance Enum EthernetAddress instance Show EthernetAddress module Frenetic.Pattern -- | A class for types that compose similar to wildcards. -- -- All instances must satisfy the following: -- -- -- -- Minimal complete definition: top and intersect. class Eq a => Matchable a where match x y = intersect x y == Just x overlap x y = isJust $ intersect x y disjoint x y = isNothing $ intersect x y top :: Matchable a => a intersect :: Matchable a => a -> a -> Maybe a match :: Matchable a => a -> a -> Bool overlap :: Matchable a => a -> a -> Bool disjoint :: Matchable a => a -> a -> Bool data Wildcard a Exact :: a -> Wildcard a Wildcard :: Wildcard a data Prefix a Prefix :: a -> Int -> Prefix a wMatch :: Eq a => a -> Wildcard a -> Bool instance Ord a => Ord (Wildcard a) instance Eq a => Eq (Wildcard a) instance Ord a => Ord (Prefix a) instance Eq a => Eq (Prefix a) instance Eq a => Matchable (Wildcard a) instance Bits a => Matchable (Prefix a) instance (Bits a, Show a) => Show (Prefix a) instance Functor Wildcard instance Show a => Show (Wildcard a) -- | Functions and types that heavily used by the Frenetic implementation. module Frenetic.Common -- | A set of values a. data Set a :: * -> * -- | A Map from keys k to values a. data Map k a :: * -> * -> * -- | A multiset of values a. The same value can occur multiple -- times. data MultiSet a :: * -> * -- | A space-efficient representation of a Word8 vector, supporting many -- efficient operations. A ByteString contains 8-bit characters -- only. -- -- Instances of Eq, Ord, Read, Show, Data, Typeable data ByteString :: * -- | Produce a new channel that carries updates from both of the input -- channels, but does not wait for both to be ready. Analogous to Unix -- SELECT(2) followed by READ(2) on the ready file descriptor. select :: Chan a -> Chan b -> IO (Chan (Either a b)) -- | Produce a new channel that waits for both input channels to produce a -- value, and then yields the latest version of both values. If one -- channel produces multiple values before the other produces any, then -- the early values are discarded. Afterwards, whenever one channel -- updates, the output channel yields that update along with whatever the -- current version of the other channel is. both :: Chan a -> Chan b -> IO (Chan (a, b)) -- | The catMaybes function takes a list of Maybes and -- returns a list of all the Just values. catMaybes :: [Maybe a] -> [a] module Frenetic.NetCore.Types -- | A switch's unique identifier. type Switch = Word64 -- | The number of a physical port. type Port = Word16 -- | VLAN tags. Only the lower 12-bits are used. type Vlan = Word16 -- | Loc uniquely identifies a port at a switch. data Loc Loc :: Switch -> Port -> Loc -- | Logical ports. data PseudoPort Physical :: Port -> PseudoPort AllPorts :: PseudoPort -- | Ethernet addresses are 48-bits wide. type Word48 = EthernetAddress -- | Actions to perform on packets. data Action Action :: MultiSet (PseudoPort, Modification) -> MultiSet Query -> Action actionForwards :: Action -> MultiSet (PseudoPort, Modification) actionQueries :: Action -> MultiSet Query data Query NumPktQuery :: QueryID -> Chan (Switch, Integer) -> Int -> Counter -> IORef Integer -> IORef Integer -> Query idOfQuery :: Query -> QueryID numPktQueryChan :: Query -> Chan (Switch, Integer) queryInterval :: Query -> Int countField :: Query -> Counter totalVal :: Query -> IORef Integer lastVal :: Query -> IORef Integer PktQuery :: Chan (Switch, Packet) -> QueryID -> Query pktQueryChan :: Query -> Chan (Switch, Packet) idOfQuery :: Query -> QueryID data Counter CountPackets :: Counter CountBytes :: Counter -- | For each fields with a value Just v, modify that field to be v. If the -- field is Nothing then there is no modification of that field. data Modification Modification :: Maybe Word48 -> Maybe Word48 -> Maybe (Maybe Vlan) -> Maybe Word8 -> Maybe Word32 -> Maybe Word32 -> Maybe Word8 -> Maybe Word16 -> Maybe Word16 -> Modification modifyDlSrc :: Modification -> Maybe Word48 modifyDlDst :: Modification -> Maybe Word48 modifyDlVlan :: Modification -> Maybe (Maybe Vlan) modifyDlVlanPcp :: Modification -> Maybe Word8 modifyNwSrc :: Modification -> Maybe Word32 modifyNwDst :: Modification -> Maybe Word32 modifyNwTos :: Modification -> Maybe Word8 modifyTpSrc :: Modification -> Maybe Word16 modifyTpDst :: Modification -> Maybe Word16 unmodified :: Modification isPktQuery :: Query -> Bool -- | Periodically polls the network to counts the number of bytes received. -- -- Returns an Action and a channel. When the Action is used -- in the active Policy, the controller periodically reads the -- packet counters on the network. The controller returns the number of -- matching packets on each switch. countPkts :: Int -> IO (Chan (Switch, Integer), Action) -- | Sends packets to the controller. -- -- Returns an Action and a channel. When the Action is used -- in the active Policy, all matching packets are sent to the -- controller. These packets are written into the channel. countBytes :: Int -> IO (Chan (Switch, Integer), Action) getPkts :: IO (Chan (Switch, Packet), Action) actionForwardsTo :: Action -> MultiSet PseudoPort -- | Patterns to match packets. Patterns translate directly to a single -- OpenFlow match rule. data Pattern Pattern :: Wildcard Word48 -> Wildcard Word48 -> Wildcard Word16 -> Wildcard (Maybe Vlan) -> Wildcard Word8 -> Prefix Word32 -> Prefix Word32 -> Wildcard Word8 -> Wildcard Word8 -> Wildcard Word16 -> Wildcard Word16 -> Wildcard Port -> Pattern ptrnDlSrc :: Pattern -> Wildcard Word48 ptrnDlDst :: Pattern -> Wildcard Word48 ptrnDlTyp :: Pattern -> Wildcard Word16 ptrnDlVlan :: Pattern -> Wildcard (Maybe Vlan) ptrnDlVlanPcp :: Pattern -> Wildcard Word8 ptrnNwSrc :: Pattern -> Prefix Word32 ptrnNwDst :: Pattern -> Prefix Word32 ptrnNwProto :: Pattern -> Wildcard Word8 ptrnNwTos :: Pattern -> Wildcard Word8 ptrnTpSrc :: Pattern -> Wildcard Word16 ptrnTpDst :: Pattern -> Wildcard Word16 ptrnInPort :: Pattern -> Wildcard Port -- | Predicates to match packets. data Predicate -- | Match with a simple pattern. PrPattern :: Pattern -> Predicate -- | Match only at this switch. PrTo :: Switch -> Predicate -- | Match either predicates. PrUnion :: Predicate -> Predicate -> Predicate -- | Match both predicates. PrIntersect :: Predicate -> Predicate -> Predicate -- | PrNegate P matches packets that do not match P. PrNegate :: Predicate -> Predicate -- | A predicate that exactly matches a packet's headers. exactMatch :: Packet -> Predicate -- | Packets' headers. data Packet Packet :: Word48 -> Word48 -> Word16 -> Maybe Vlan -> Word8 -> Maybe Word32 -> Maybe Word32 -> Word8 -> Word8 -> Maybe Word16 -> Maybe Word16 -> Port -> Packet -- | source ethernet address pktDlSrc :: Packet -> Word48 -- | destination ethernet address pktDlDst :: Packet -> Word48 -- | ethernet type code (e.g., 0x800 for IP packets) pktDlTyp :: Packet -> Word16 -- | VLAN tag pktDlVlan :: Packet -> Maybe Vlan -- | VLAN priority code pktDlVlanPcp :: Packet -> Word8 -- | source IP address for IP packets pktNwSrc :: Packet -> Maybe Word32 -- | destination IP address for IP packets pktNwDst :: Packet -> Maybe Word32 -- | IP protocol number (e.g., 6 for TCP segments) pktNwProto :: Packet -> Word8 -- | IP TOS field pktNwTos :: Packet -> Word8 -- | source port for IP packets pktTpSrc :: Packet -> Maybe Word16 -- | destination port for IP packets pktTpDst :: Packet -> Maybe Word16 -- | ingress port on the switch where the packet was received pktInPort :: Packet -> Port -- | Policies denote functions from (switch, packet) to packets. data Policy -- | Performs no actions. PoBottom :: Policy -- | Performs the given action on packets matching the given predicate. PoBasic :: Predicate -> Action -> Policy -- | Performs the actions of both P1 and P2. PoUnion :: Policy -> Policy -> Policy -- | Build a list of the non-wildcarded patterns with sep between field and -- value interesting :: String -> Pattern -> [String] modifiedFields :: Modification -> Set Field -- | Get back all predicates in the intersection. Does not return any naked -- intersections. prUnIntersect :: Predicate -> [Predicate] -- | Get back all predicates in the union. Does not return any naked -- unions. prUnUnion :: Predicate -> [Predicate] -- | Get back all basic policies in the union. Does not return any unions. poUnUnion :: Policy -> [Policy] -- | Returns a predicate that matches the domain of the policy. poDom :: Policy -> Predicate -- | Returns the approximate size of the policy size :: Policy -> Int instance Eq Loc instance Ord Loc instance Show Loc instance Eq PseudoPort instance Ord PseudoPort instance Show PseudoPort instance Show Packet instance Eq Packet instance Ord Packet instance Ord Pattern instance Eq Pattern instance Eq Predicate instance Ord Predicate instance Eq Field instance Ord Field instance Show Field instance Ord Modification instance Eq Modification instance Show Modification instance Eq Counter instance Ord Counter instance Eq Query instance Eq Action instance Ord Action instance Eq Policy instance Ord Policy instance Show Policy instance Show Query instance Show Action instance Ord Query instance Matchable Predicate instance Show Predicate instance Show Pattern instance Matchable Pattern module Frenetic.Compat -- | Packets' headers. data Packet Packet :: Word48 -> Word48 -> Word16 -> Maybe Vlan -> Word8 -> Maybe Word32 -> Maybe Word32 -> Word8 -> Word8 -> Maybe Word16 -> Maybe Word16 -> Port -> Packet -- | source ethernet address pktDlSrc :: Packet -> Word48 -- | destination ethernet address pktDlDst :: Packet -> Word48 -- | ethernet type code (e.g., 0x800 for IP packets) pktDlTyp :: Packet -> Word16 -- | VLAN tag pktDlVlan :: Packet -> Maybe Vlan -- | VLAN priority code pktDlVlanPcp :: Packet -> Word8 -- | source IP address for IP packets pktNwSrc :: Packet -> Maybe Word32 -- | destination IP address for IP packets pktNwDst :: Packet -> Maybe Word32 -- | IP protocol number (e.g., 6 for TCP segments) pktNwProto :: Packet -> Word8 -- | IP TOS field pktNwTos :: Packet -> Word8 -- | source port for IP packets pktTpSrc :: Packet -> Maybe Word16 -- | destination port for IP packets pktTpDst :: Packet -> Maybe Word16 -- | ingress port on the switch where the packet was received pktInPort :: Packet -> Port -- | Data that was sent. data Transmission ptrn pkt Transmission :: ptrn -> Switch -> pkt -> Transmission ptrn pkt trPattern :: Transmission ptrn pkt -> ptrn trSwitch :: Transmission ptrn pkt -> Switch trPkt :: Transmission ptrn pkt -> pkt -- | 'FreneticImpl a' is a family of related abstract types that define a -- back-end for Frenetic. class (Show (PatternImpl a), Show (ActionImpl a), Matchable (PatternImpl a), Eq (PacketImpl a), Eq (ActionImpl a), Eq (PatternImpl a)) => FreneticImpl a where data family PacketImpl a data family PatternImpl a data family ActionImpl a ptrnMatchPkt :: FreneticImpl a => PacketImpl a -> PatternImpl a -> Bool toPacket :: FreneticImpl a => PacketImpl a -> Maybe Packet updatePacket :: FreneticImpl a => PacketImpl a -> Packet -> PacketImpl a fromPattern :: FreneticImpl a => Pattern -> PatternImpl a toPattern :: FreneticImpl a => PatternImpl a -> Pattern actnDefault :: FreneticImpl a => ActionImpl a actnController :: FreneticImpl a => ActionImpl a actnTranslate :: FreneticImpl a => Action -> ActionImpl a actnControllerPart :: FreneticImpl a => ActionImpl a -> Switch -> PacketImpl a -> IO () instance (Eq ptrn, Eq pkt) => Eq (Transmission ptrn pkt) module Frenetic.NetCore.Short -- | Construct the predicate matching packets on this switch and port inport :: Switch -> Port -> Predicate -- | Abbreviation for predicate union. (<||>) :: Predicate -> Predicate -> Predicate -- | Abbreviation for predicate intersection. (<&&>) :: Predicate -> Predicate -> Predicate -- | Matches all packets. matchAll :: Predicate -- | Matches no packets. matchNone :: Predicate -- | Abbreviation for predicate negation. neg :: Predicate -> Predicate -- | Construct the set difference between p1 and p2 prSubtract :: Predicate -> Predicate -> Predicate -- | Construct nary union of a list of predicates prOr :: [Predicate] -> Predicate -- | Construct nary intersection of a list of predicates prAnd :: [Predicate] -> Predicate dropPkt :: Action -- | Forward the packet out of all physical ports, except the packet's -- ingress port. allPorts :: Modification -> Action -- | Forward the packet out of the specified physical ports. forward :: [Port] -> Action -- | Forward the packet out of the specified physical ports with -- modifications. -- -- Each port has its own record of modifications, so modifications at one -- port do not interfere with modifications at another port. modify :: [(Port, Modification)] -> Action -- | Abbreviation for constructing a basic policy from a predicate and an -- action. (==>) :: Predicate -> Action -> Policy -- | Restrict a policy to act over packets matching the predicate. (<%>) :: Policy -> Predicate -> Policy -- | Join: overloaded to find the union of policies and the join of -- actions. (<+>) :: Monoid a => a -> a -> a -- | Match switch identifier. onSwitch :: Switch -> Predicate -- | Match ethernet source address. dlSrc :: Word48 -> Predicate -- | Match ethernet destination address. dlDst :: Word48 -> Predicate -- | Match ethernet type code (e.g., 0x0800 for IP packets). dlTyp :: Word16 -> Predicate -- | Match VLAN tag. dlVlan :: Word16 -> Predicate -- | Match Vlan untagged dlNoVlan :: Predicate -- | Match VLAN priority dlVlanPcp :: Word8 -> Predicate -- | Match source IP address. -- -- This is only meaningful in combination with 'dlTyp 0x0800'. nwSrc :: Word32 -> Predicate -- | Match destination IP address. nwDst :: Word32 -> Predicate -- | Match a prefix of the source IP address. nwSrcPrefix :: Word32 -> Int -> Predicate -- | Match a prefix of the destination IP address. nwDstPrefix :: Word32 -> Int -> Predicate -- | Match IP protocol code (e.g., 0x6 indicates TCP segments). nwProto :: Word8 -> Predicate -- | Match IP TOS field. nwTos :: Word8 -> Predicate -- | Match IP source port. tpSrc :: Word16 -> Predicate -- | Match IP destination port. tpDst :: Word16 -> Predicate -- | Match the ingress port on which packets arrive. inPort :: Port -> Predicate -- | For each fields with a value Just v, modify that field to be v. If the -- field is Nothing then there is no modification of that field. data Modification Modification :: Maybe Word48 -> Maybe Word48 -> Maybe (Maybe Vlan) -> Maybe Word8 -> Maybe Word32 -> Maybe Word32 -> Maybe Word8 -> Maybe Word16 -> Maybe Word16 -> Modification modifyDlSrc :: Modification -> Maybe Word48 modifyDlDst :: Modification -> Maybe Word48 modifyDlVlan :: Modification -> Maybe (Maybe Vlan) modifyDlVlanPcp :: Modification -> Maybe Word8 modifyNwSrc :: Modification -> Maybe Word32 modifyNwDst :: Modification -> Maybe Word32 modifyNwTos :: Modification -> Maybe Word8 modifyTpSrc :: Modification -> Maybe Word16 modifyTpDst :: Modification -> Maybe Word16 unmodified :: Modification modDlSrc :: Word48 -> Modification modDlDst :: Word48 -> Modification modDlVlan :: Maybe Vlan -> Modification modDlVlanPcp :: Word8 -> Modification modNwSrc :: Word32 -> Modification modNwDst :: Word32 -> Modification modNwTos :: Word8 -> Modification modTpSrc :: Word16 -> Modification modTpDst :: Word16 -> Modification instance Monoid Policy instance Monoid Action -- | Composes NetCore policies and predicates, and defines how these -- policies interpret abstract packets. module Frenetic.NetCore.Semantics -- | Implements the denotation function for predicates. interpretPredicate :: FreneticImpl a => Predicate -> Transmission (PatternImpl a) (PacketImpl a) -> Bool -- | Implements the denotation function for policies. interpretPolicy :: FreneticImpl a => Policy -> Transmission (PatternImpl a) (PacketImpl a) -> Action instance Show (PacketImpl ()) instance Eq (PacketImpl ()) instance Show (PatternImpl ()) instance Eq (PatternImpl ()) instance Show (ActionImpl ()) instance Eq (ActionImpl ()) instance FreneticImpl () instance Matchable (PatternImpl ()) module Frenetic.NetworkFrames arpReply :: Word48 -> Word32 -> Word48 -> Word32 -> ByteString module Frenetic.Server -- | Starts an OpenFlow controller that runs a static NetCore program. controller :: Policy -> IO () -- | Starts an OpenFlow controller that runs dynamic NetCore programs. -- -- The controller reads NetCore programs from the given channel. When the -- controller receives a program on the channel, it compiles it and -- reconfigures the network to run it. dynController :: Chan Policy -> Chan (Loc, ByteString) -> IO () -- | Everything necessary to build a controller atop NetCore, using Nettle -- as a backend. module Frenetic.NetCore -- | Starts an OpenFlow controller that runs a static NetCore program. controller :: Policy -> IO () -- | Starts an OpenFlow controller that runs dynamic NetCore programs. -- -- The controller reads NetCore programs from the given channel. When the -- controller receives a program on the channel, it compiles it and -- reconfigures the network to run it. dynController :: Chan Policy -> Chan (Loc, ByteString) -> IO () -- | Policies denote functions from (switch, packet) to packets. data Policy -- | Performs no actions. PoBottom :: Policy -- | Performs the given action on packets matching the given predicate. PoBasic :: Predicate -> Action -> Policy -- | Performs the actions of both P1 and P2. PoUnion :: Policy -> Policy -> Policy -- | Abbreviation for constructing a basic policy from a predicate and an -- action. (==>) :: Predicate -> Action -> Policy -- | Restrict a policy to act over packets matching the predicate. (<%>) :: Policy -> Predicate -> Policy -- | Join: overloaded to find the union of policies and the join of -- actions. (<+>) :: Monoid a => a -> a -> a -- | Predicates to match packets. data Predicate -- | A predicate that exactly matches a packet's headers. exactMatch :: Packet -> Predicate -- | Construct the predicate matching packets on this switch and port inport :: Switch -> Port -> Predicate -- | Abbreviation for predicate union. (<||>) :: Predicate -> Predicate -> Predicate -- | Abbreviation for predicate intersection. (<&&>) :: Predicate -> Predicate -> Predicate -- | Matches all packets. matchAll :: Predicate -- | Matches no packets. matchNone :: Predicate -- | Abbreviation for predicate negation. neg :: Predicate -> Predicate -- | Construct the set difference between p1 and p2 prSubtract :: Predicate -> Predicate -> Predicate -- | Construct nary union of a list of predicates prOr :: [Predicate] -> Predicate -- | Construct nary intersection of a list of predicates prAnd :: [Predicate] -> Predicate -- | Match switch identifier. onSwitch :: Switch -> Predicate -- | Match ethernet source address. dlSrc :: Word48 -> Predicate -- | Match ethernet destination address. dlDst :: Word48 -> Predicate -- | Match ethernet type code (e.g., 0x0800 for IP packets). dlTyp :: Word16 -> Predicate -- | Match VLAN tag. dlVlan :: Word16 -> Predicate -- | Match Vlan untagged dlNoVlan :: Predicate -- | Match VLAN priority dlVlanPcp :: Word8 -> Predicate -- | Match source IP address. -- -- This is only meaningful in combination with 'dlTyp 0x0800'. nwSrc :: Word32 -> Predicate -- | Match destination IP address. nwDst :: Word32 -> Predicate -- | Match a prefix of the source IP address. nwSrcPrefix :: Word32 -> Int -> Predicate -- | Match a prefix of the destination IP address. nwDstPrefix :: Word32 -> Int -> Predicate -- | Match IP protocol code (e.g., 0x6 indicates TCP segments). nwProto :: Word8 -> Predicate -- | Match IP TOS field. nwTos :: Word8 -> Predicate -- | Match IP source port. tpSrc :: Word16 -> Predicate -- | Match IP destination port. tpDst :: Word16 -> Predicate -- | Match the ingress port on which packets arrive. inPort :: Port -> Predicate -- | Actions to perform on packets. data Action dropPkt :: Action -- | Forward the packet out of the specified physical ports. forward :: [Port] -> Action -- | Forward the packet out of all physical ports, except the packet's -- ingress port. allPorts :: Modification -> Action -- | Forward the packet out of the specified physical ports with -- modifications. -- -- Each port has its own record of modifications, so modifications at one -- port do not interfere with modifications at another port. modify :: [(Port, Modification)] -> Action -- | Sends packets to the controller. -- -- Returns an Action and a channel. When the Action is used -- in the active Policy, all matching packets are sent to the -- controller. These packets are written into the channel. countBytes :: Int -> IO (Chan (Switch, Integer), Action) -- | Periodically polls the network to counts the number of bytes received. -- -- Returns an Action and a channel. When the Action is used -- in the active Policy, the controller periodically reads the -- packet counters on the network. The controller returns the number of -- matching packets on each switch. countPkts :: Int -> IO (Chan (Switch, Integer), Action) getPkts :: IO (Chan (Switch, Packet), Action) -- | For each fields with a value Just v, modify that field to be v. If the -- field is Nothing then there is no modification of that field. data Modification unmodified :: Modification -- | A switch's unique identifier. type Switch = Word64 -- | The number of a physical port. type Port = Word16 -- | VLAN tags. Only the lower 12-bits are used. type Vlan = Word16 -- | Loc uniquely identifies a port at a switch. data Loc Loc :: Switch -> Port -> Loc -- | Ethernet addresses are 48-bits wide. type Word48 = EthernetAddress broadcastAddress :: EthernetAddress data EthernetAddress -- | Packets' headers. data Packet Packet :: Word48 -> Word48 -> Word16 -> Maybe Vlan -> Word8 -> Maybe Word32 -> Maybe Word32 -> Word8 -> Word8 -> Maybe Word16 -> Maybe Word16 -> Port -> Packet -- | source ethernet address pktDlSrc :: Packet -> Word48 -- | destination ethernet address pktDlDst :: Packet -> Word48 -- | ethernet type code (e.g., 0x800 for IP packets) pktDlTyp :: Packet -> Word16 -- | VLAN tag pktDlVlan :: Packet -> Maybe Vlan -- | VLAN priority code pktDlVlanPcp :: Packet -> Word8 -- | source IP address for IP packets pktNwSrc :: Packet -> Maybe Word32 -- | destination IP address for IP packets pktNwDst :: Packet -> Maybe Word32 -- | IP protocol number (e.g., 6 for TCP segments) pktNwProto :: Packet -> Word8 -- | IP TOS field pktNwTos :: Packet -> Word8 -- | source port for IP packets pktTpSrc :: Packet -> Maybe Word16 -- | destination port for IP packets pktTpDst :: Packet -> Maybe Word16 -- | ingress port on the switch where the packet was received pktInPort :: Packet -> Port modDlSrc :: Word48 -> Modification modDlDst :: Word48 -> Modification modDlVlan :: Maybe Vlan -> Modification modDlVlanPcp :: Word8 -> Modification modNwSrc :: Word32 -> Modification modNwDst :: Word32 -> Modification modNwTos :: Word8 -> Modification modTpSrc :: Word16 -> Modification modTpDst :: Word16 -> Modification -- | Produce a new channel that carries updates from both of the input -- channels, but does not wait for both to be ready. Analogous to Unix -- SELECT(2) followed by READ(2) on the ready file descriptor. select :: Chan a -> Chan b -> IO (Chan (Either a b)) -- | Produce a new channel that waits for both input channels to produce a -- value, and then yields the latest version of both values. If one -- channel produces multiple values before the other produces any, then -- the early values are discarded. Afterwards, whenever one channel -- updates, the output channel yields that update along with whatever the -- current version of the other channel is. both :: Chan a -> Chan b -> IO (Chan (a, b)) -- | A slice represents a subgraph of the network for the purposes of -- isolating programs from each other. -- -- The interface to a slice has two components: a topology comprising -- switches, ports, and links; and a collection of predicates, one for -- each outward-facing edge port. -- -- We represent the topology as a collection of locations in the network, -- and the predicates as a mapping from locations to predicates. -- -- Intuitively, packets may travel freely between internal locations, but -- must satisfy the associated predicate to enter the slice at an ingress -- location, or leave the slice at an egress location. If an external -- port is not listed in the ingress or egress set, then no packets may -- enter or leave (respectively) on that port. data Slice Slice :: Set Loc -> Map Loc Predicate -> Map Loc Predicate -> Slice -- | Ports internal to the slice. internal :: Slice -> Set Loc -- | External ports, and restrictions on inbound packets. ingress :: Slice -> Map Loc Predicate -- | External ports, and restrictions on outbound packets. egress :: Slice -> Map Loc Predicate type Topo = Gr () Port -- | Build a graph from list of undirected edges labeled with their ports -- Ensures that the resulting graph is undirected-equivalent, and labels -- each directed edge with the appropriate port to send a packet -- over that edge from the source switch. -- -- By convention, hosts have a single port 0, and non-hosts have any -- number of non-zero ports. If 0 is in the ports of a node, it is -- considered to be a host regardless of other ports that may be present. buildGraph :: [((Node, Port), (Node, Port))] -> Topo -- | Produce a slice that exactly covers the given topology, with no -- ingress or egress ports. internalSlice :: Topo -> Slice -- | Produce a slice with all the switches in topo, and predicate applied -- to all in- and out-bound connections to hosts simpleSlice :: Topo -> Predicate -> Slice -- | Produce the combined policy by compiling a list of slices and policies -- with the vanilla compiler transform :: [(Slice, Policy)] -> Policy -- | Produce the combined policy by compiling a list of slices and policies -- with the edge compiler transformEdge :: Topo -> [(Slice, Policy)] -> Policy -- | Compile a list of slices and dynamic policies as they change. dynTransform :: [(Slice, Chan Policy)] -> IO (Chan Policy)