module Frenetic.NetCore.Short
(
inport
, (<||>)
, (<&&>)
, matchAll
, matchNone
, neg
, prSubtract
, prOr
, prAnd
, dropPkt
, allPorts
, forward
, modify
, (==>)
, (<%>)
, (<+>)
, onSwitch
, dlSrc
, dlDst
, dlTyp
, dlVlan
, dlNoVlan
, dlVlanPcp
, nwSrc
, nwDst
, nwSrcPrefix
, nwDstPrefix
, nwProto
, nwTos
, tpSrc
, tpDst
, inPort
, Modification (..)
, unmodified
, modDlSrc
, modDlDst
, modDlVlan
, modDlVlanPcp
, modNwSrc
, modNwDst
, modNwTos
, modTpSrc
, modTpDst
) where
import Data.Word
import qualified Data.List as List
import qualified Data.MultiSet as MS
import Frenetic.Pattern
import Frenetic.NetCore.Types
import Data.Monoid
matchAll :: Predicate
matchAll = top
matchNone :: Predicate
matchNone = PrNegate top
inport :: Switch -> Port -> Predicate
inport switch port = PrIntersect (PrTo switch)
(PrPattern (top {ptrnInPort = Exact port}))
prSubtract :: Predicate -> Predicate -> Predicate
prSubtract p1 p2 = PrIntersect p1 (PrNegate p2)
prOr :: [Predicate] -> Predicate
prOr [] = neg top
prOr ps = List.foldr1 (\ p1 p2 -> PrUnion p1 p2) ps
prAnd :: [Predicate] -> Predicate
prAnd [] = top
prAnd ps = List.foldr1 (\ p1 p2 -> PrIntersect p1 p2) ps
dropPkt :: Action
dropPkt = Action MS.empty MS.empty
allPorts :: Modification
-> Action
allPorts mod = Action (MS.singleton (AllPorts, mod)) MS.empty
forward :: [Port] -> Action
forward ports = Action (MS.fromList lst) MS.empty
where lst = [ (Physical p, unmodified) | p <- ports ]
modify :: [(Port, Modification)] -> Action
modify mods = Action (MS.fromList lst) MS.empty
where lst = [ (Physical p, mod) | (p, mod) <- mods ]
onSwitch = PrTo
instance Monoid Action where
mappend (Action fwd1 q1) (Action fwd2 q2) =
Action (fwd1 `MS.union` fwd2) (q1 `MS.union` q2)
mempty = dropPkt
(<+>) :: Monoid a => a -> a -> a
(<+>) = mappend
(<||>) = PrUnion
(<&&>) = PrIntersect
neg = PrNegate
(==>) = PoBasic
policy <%> pred = case policy of
PoBottom -> PoBottom
PoBasic predicate act -> PoBasic (PrIntersect predicate pred) act
PoUnion p1 p2 -> PoUnion (p1 <%> pred) (p2 <%> pred)
instance Monoid Policy where
mappend = PoUnion
mempty = PoBottom
dlSrc :: Word48 -> Predicate
dlSrc value = PrPattern (top {ptrnDlSrc = Exact value})
dlDst :: Word48 -> Predicate
dlDst value = PrPattern (top {ptrnDlDst = Exact value})
dlTyp :: Word16 -> Predicate
dlTyp value = PrPattern (top {ptrnDlTyp = Exact value})
dlVlan :: Word16 -> Predicate
dlVlan value = PrPattern (top {ptrnDlVlan = Exact (Just value)})
dlNoVlan :: Predicate
dlNoVlan = PrPattern (top {ptrnDlVlan = Exact Nothing})
dlVlanPcp :: Word8 -> Predicate
dlVlanPcp value = PrPattern (top {ptrnDlVlanPcp = Exact value})
nwSrc :: Word32 -> Predicate
nwSrc value = PrPattern (top {ptrnNwSrc = Prefix value 32})
nwDst :: Word32 -> Predicate
nwDst value = PrPattern (top {ptrnNwDst = Prefix value 32})
nwSrcPrefix :: Word32 -> Int -> Predicate
nwSrcPrefix value prefix = PrPattern (top {ptrnNwSrc = Prefix value prefix})
nwDstPrefix :: Word32 -> Int -> Predicate
nwDstPrefix value prefix = PrPattern (top {ptrnNwDst = Prefix value prefix})
nwProto :: Word8 -> Predicate
nwProto value = PrPattern (top {ptrnNwProto = Exact value})
nwTos :: Word8 -> Predicate
nwTos value = PrPattern (top {ptrnNwTos = Exact value})
tpSrc :: Word16 -> Predicate
tpSrc value = PrPattern (top {ptrnTpSrc = Exact value})
tpDst :: Word16 -> Predicate
tpDst value = PrPattern (top {ptrnTpDst = Exact value})
inPort :: Port -> Predicate
inPort value = PrPattern (top {ptrnInPort = Exact value})
modDlSrc value = unmodified {modifyDlSrc = Just value}
modDlDst value = unmodified {modifyDlDst = Just value}
modDlVlan value = unmodified {modifyDlVlan = Just value}
modDlVlanPcp value = unmodified {modifyDlVlanPcp = Just value}
modNwSrc value = unmodified {modifyNwSrc = Just value}
modNwDst value = unmodified {modifyNwDst = Just value}
modNwTos value = unmodified {modifyNwTos = Just value}
modTpSrc value = unmodified {modifyTpSrc = Just value}
modTpDst value = unmodified {modifyTpDst = Just value}