module Nettle.Topology.Topology (
LinkID
, Topology
, Weight
, empty
, addLink
, adjustLinkWeight
, deleteLink
, addSwitch
, deleteSwitch
, addEdgePort
, addEdgePorts
, lookupLink
, links
, lGraph
, edgePorts
, ShortestPathMatrix
, shortestPathMatrix
, pathBetween
, 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) }
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 }
completeTopology :: Int -> Int -> Weight -> Topology
completeTopology n portsPerSwitch weight
= foldr f topo0 links
where links = concat [ [ ((s, d1), (d,s)), ((d,s),(s,d1)) ] | 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..(numEdgePorts1)]
]
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 = []