module Frenetic.Slices.VlanAssignment
( sequential
, edge
) where
import Data.Maybe
import Data.Word
import qualified Data.Map as Map
import qualified Data.Set as Set
import Frenetic.NetCore.Short
import Frenetic.NetCore.Types
import Frenetic.Slices.Slice
import Frenetic.Topo
maxVlan :: Vlan
maxVlan = 2^12
sequential :: [(Slice, Policy)] -> [(Vlan, (Slice, Policy))]
sequential combined =
if length combined > fromIntegral maxVlan
then error (show (length combined) ++
" is too many VLANs to compile sequentially.")
else zip [1..maxVlan] combined
type Edge = (Loc, Loc)
edge :: Topo -> [(Slice, Policy)] -> [(Map.Map Loc Vlan, (Slice, Policy))]
edge topo combined = paired where
locUse :: Map.Map Loc (Set.Set (Slice, Policy))
locUse = foldr addEdges Map.empty combined
edgeUse :: Map.Map Edge (Set.Set (Slice, Policy))
edgeUse = Map.mapKeysWith Set.union (getEdge topo) locUse
vlanEdges :: Map.Map Edge (Map.Map (Slice, Policy) Vlan)
vlanEdges = Map.map assign edgeUse
vlans :: Map.Map Loc (Map.Map (Slice, Policy) Vlan)
vlans = Map.fromList .
concatMap (\ ((l1, l2), v) -> [(l1, v), (l2, v)]) .
Map.toList $
vlanEdges
bySlice :: Map.Map (Slice, Policy) (Map.Map Loc Vlan)
bySlice = invert vlans
paired = [ (lookup, both) | (both, lookup) <- Map.toList bySlice]
addEdges :: (Slice, Policy) -> Map.Map Loc (Set.Set (Slice, Policy)) ->
Map.Map Loc (Set.Set (Slice, Policy))
addEdges (slice, policy) m = Map.unionWith Set.union (Map.fromList locations) m where
locations = map (\l -> (l, Set.singleton (slice, policy))) .
Set.toList $ internal slice
assign :: Set.Set (Slice, Policy) -> Map.Map (Slice, Policy) Vlan
assign slices =
if Set.size slices > fromIntegral maxVlan
then error (show (Set.size slices) ++
" is too many VLANs to compile sequentially.")
else Map.fromList $ zip (Set.toList slices) [1..maxVlan]
invert :: (Ord a, Ord b) => Map.Map a (Map.Map b v) -> Map.Map b (Map.Map a v)
invert m = m' where
associations = map (\(k, submap) -> (k, Map.toList submap)) . Map.toList $ m
m' = Map.fromListWith Map.union
[(b, Map.singleton a v) | (a, bs) <- associations, (b, v) <- bs]