-- | This module implements a data structure that can be -- used to maintain information about the topology of an OpenFlow -- network. It maintains a graph whose nodes are switches and whose edges are links connect -- switches and attaching to switches at particular ports. module Nettle.Topology.Topology ( LinkID , Topology , Weight -- * Construction , empty , addLink , adjustLinkWeight , deleteLink , addSwitch , deleteSwitch , addEdgePort , addEdgePorts -- * Query , lookupLink , links , lGraph , edgePorts -- * Shortest paths , ShortestPathMatrix , shortestPathMatrix , pathBetween -- * Utilities to create topologies , completeTopology , makeTopology ) where import Nettle.Topology.LabelledGraph hiding (empty) import qualified Nettle.Topology.LabelledGraph as LG import Nettle.Topology.FloydWarshall import Nettle.Topology.ExtendedDouble import Data.Array.IArray hiding ((!)) import qualified Data.Set as Set import Data.Set (Set) import qualified Data.Map as Map import Data.Map (Map, (!)) import Data.List (minimumBy, sort) import Nettle.OpenFlow type LinkID = ((SwitchID,PortID), (SwitchID, PortID)) data Topology = Topology { lGraph :: LabelledGraph SwitchID LinkID , edgePorts :: Set (SwitchID, PortID) } links :: Topology -> [LinkID] links topo = map fst $ edges $ lGraph topo data ShortestPathMatrix = ShortestPathMatrix { matrix :: Array (Int, Int) (ExtendedDouble, Maybe (Int, LinkID)) , num2switch :: Map Int SwitchID , switch2num :: Map SwitchID Int } shortestPathMatrix :: Topology -> ShortestPathMatrix shortestPathMatrix topology = ShortestPathMatrix { matrix = floydWarshall (array ((1,1), (r,r)) assocs) , num2switch = Map.fromList numberedNodes , switch2num = Map.fromList (map twist numberedNodes)} where r = numberOfNodes $ lGraph topology assocs = [ ((m,n), if m==n then (Finite 0, Nothing) else case edgesFromTo u v (lGraph topology) of [] -> (Infinity, Nothing) links -> let (l,w) = minimumBy (\x y -> compare (snd x) (snd y)) links in (Finite w, Just (m, l)) ) | (m,u) <- numberedNodes, (n,v) <- numberedNodes ] numberedNodes = zip [1..] (nodes (lGraph topology)) twist (a,b) = (b,a) pathBetween :: ShortestPathMatrix -> SwitchID -> SwitchID -> Maybe [LinkID] pathBetween spm source dest = fmap (map (\(n,link) -> link)) $ shortestPath (matrix spm) (switch2num spm ! source, switch2num spm ! dest) lookupLink :: Topology -> SwitchID -> PortID -> (LinkID, Weight) lookupLink topo sid pid = let [lw] = filter p (edges $ lGraph topo) in lw where p (((x,y),(z,u)), _) = (x==sid && y==pid) || (z==sid && u==pid) adjustLinkWeight :: LinkID -> (Weight -> Weight) -> Topology -> Topology adjustLinkWeight linkid f topo = topo { lGraph = adjustEdgeWeight linkid f (lGraph topo) } -- ensure invariant that no two links have same (switch,port) pairs. addLink :: LinkID -> Weight -> Topology -> Topology addLink e@((u,p),(v,q)) w topo = topo { lGraph = addEdge e (u,v) w (lGraph topo) } deleteLink :: LinkID -> Topology -> Topology deleteLink lid topo = topo { lGraph = deleteEdge lid (lGraph topo ) } addSwitch :: SwitchID -> Topology -> Topology addSwitch sid topo = topo { lGraph = addNode sid (lGraph topo) } deleteSwitch :: SwitchID -> Topology -> Topology deleteSwitch sid topo = topo { lGraph = deleteNode sid (lGraph topo) } empty :: Topology empty = Topology { lGraph = LG.empty, edgePorts = Set.empty } addEdgePort :: SwitchID -> PortID -> Topology -> Topology addEdgePort sid pid topo = topo { edgePorts = Set.insert (sid,pid) (edgePorts topo) } addEdgePorts :: [(SwitchID, PortID)] -> Topology -> Topology addEdgePorts sps topo = topo { edgePorts = foldr Set.insert (edgePorts topo) sps } -- builds complete graph of n switches with the high ports (ports numbered n+1 or higher) are edge ports, with one directed edge per pair of switches. completeTopology :: Int -> Int -> Weight -> Topology completeTopology n portsPerSwitch weight = foldr f topo0 links where links = concat [ [ ((s, d-1), (d,s)), ((d,s),(s,d-1)) ] | s <- [1..n], d <- [s+1..n]] eps = [ (fromIntegral s, fromIntegral p) | s <- [1..n], p <- [n..portsPerSwitch]] f ((x,y),(z,u)) = addLink ((fromIntegral x, fromIntegral y), (fromIntegral z, fromIntegral u)) weight topo0 = addEdgePorts eps empty makeTopology :: Int -> Int -> [(Int,Int,Weight)] -> Topology makeTopology n numEdgePorts edges = foldr f topo0 links where topo0 = addEdgePorts eps empty eps = [ (fromIntegral s, fromIntegral (nextPort + p)) | s <- [1..n], let nextPort = dict ! s, p <- [0..(numEdgePorts-1)] ] f ((x,y),(z,u),weight) = addLink ((fromIntegral x, fromIntegral y), (fromIntegral z, fromIntegral u)) weight (dict, links) = foldl step base (sort edges) where step (dict,edges) (u,v,weight) = let pu = dict ! u pv = dict ! v dict' = Map.adjust (+1) u (Map.adjust (+1) v dict) edges' = ((u,pu),(v,pv),weight) : ((v,pv),(u,pu),weight) : edges in (dict', edges') base = (dict0, edges0) dict0 = Map.fromList [(u,1) | u <- [1..n]] edges0 = []