module Nettle.FRPControl.SwitchInterface
(
SwitchMessage
, SockAddr
, switchJoinE
, switchLeaveE
, switchHelloE
, switchEchoRequestE
, switchEchoReplyE
, packetInE
, switchFeaturesE
, portUpdateE
, switchErrorE
, flowRemovalE
, statsReplyE
, portStatsReplyE
, flowStatsReplyE
#if OPENFLOW_VERSION==152 || OPENFLOW_VERSION==1
, barrierReplyE
#endif
, filterPacketIns
, SwitchOutput
, switchCommand
, noOp
, (<+>)
, switchInterfaceDriver
, openFlowController
) where
import Nettle.Ethernet.EthernetAddress
import Nettle.OpenFlow.Messages as M
import Nettle.OpenFlow.Switch
import Nettle.OpenFlow.Port
import Nettle.OpenFlow.Action
import Nettle.OpenFlow.Match
import Nettle.OpenFlow.FlowTable
import Nettle.OpenFlow.Statistics
import Nettle.OpenFlow.Error
import Nettle.OpenFlow.Packet
import Nettle.OpenFlow.MessagesBinary as M
import Nettle.Servers.TCPServer
import Nettle.Servers.MultiplexedTCPServer
import Nettle.FRPControl.AFRP
import Data.Word
import Data.Monoid
import Control.Exception
type SwitchMessage = TCPMessage (TransactionID, SCMessage)
switchJoinE :: Event SwitchMessage -> Event SockAddr
switchJoinE = mapFilterE f
where f (ConnectionEstablished addr) = Just addr
f _ = Nothing
switchLeaveE :: Event SwitchMessage -> Event (SockAddr, IOException)
switchLeaveE = mapFilterE f
where f (ConnectionTerminated addr e) = Just (addr, e)
f _ = Nothing
switchHelloE :: Event SwitchMessage -> Event (SockAddr, TransactionID)
switchHelloE = mapFilterE f
where f (PeerMessage sw (msgID, SCHello)) = Just (sw, msgID)
f _ = Nothing
switchEchoRequestE :: Event SwitchMessage -> Event (SockAddr, TransactionID, [Word8])
switchEchoRequestE = mapFilterE f
where f (PeerMessage sw (msgID, SCEchoRequest bytes)) = Just (sw, msgID, bytes)
f _ = Nothing
switchEchoReplyE :: Event SwitchMessage -> Event (SockAddr, TransactionID, [Word8])
switchEchoReplyE = mapFilterE f
where f (PeerMessage sw (msgID, SCEchoReply bytes)) = Just (sw, msgID, bytes)
f _ = Nothing
packetInE :: Event SwitchMessage -> Event (SockAddr, TransactionID, PacketInfo)
packetInE = mapFilterE f
where f (PeerMessage sw (msgID, PacketIn pktRecord)) = Just (sw, msgID, pktRecord)
f _ = Nothing
switchFeaturesE :: Event SwitchMessage -> Event (SockAddr, TransactionID, SwitchFeatures)
switchFeaturesE = mapFilterE f
where f (PeerMessage sw (msgID, Features x)) = Just (sw, msgID, x)
f _ = Nothing
portUpdateE :: Event SwitchMessage -> Event (SockAddr, TransactionID, PortStatus)
portUpdateE = mapFilterE f
where f (PeerMessage sw (msgID, M.PortStatus x)) = Just (sw, msgID, x)
f _ = Nothing
switchErrorE :: Event SwitchMessage -> Event (SockAddr, TransactionID, SwitchError)
switchErrorE = mapFilterE f
where f (PeerMessage sw (msgID, Error x)) = Just (sw, msgID, x)
f _ = Nothing
flowRemovalE :: Event SwitchMessage -> Event (SockAddr, TransactionID, FlowRemoved)
flowRemovalE = mapFilterE f
where f (PeerMessage sw (msgID, M.FlowRemoved x)) = Just (sw, msgID, x)
f _ = Nothing
#if OPENFLOW_VERSION==152 || OPENFLOW_VERSION==1
barrierReplyE :: Event SwitchMessage -> Event (SockAddr, TransactionID)
barrierReplyE = mapFilterE f
where f (PeerMessage sw (msgID, BarrierReply)) = Just (sw, msgID)
f _ = Nothing
#endif
statsReplyE ::Event SwitchMessage -> Event (SockAddr, TransactionID, StatsReply)
statsReplyE = mapFilterE f
where f (PeerMessage sw (msgID, StatsReply reply)) = Just (sw, msgID, reply)
f _ = Nothing
portStatsReplyE :: Event SwitchMessage -> Event (SockAddr, TransactionID, MoreToFollowFlag, [(PortID, PortStats)])
portStatsReplyE = statsReplyE >>> arr (mapFilterE f)
where f (addr, xid, PortStatsReply moreComing ports) = Just (addr, xid, moreComing, ports)
f _ = Nothing
flowStatsReplyE :: Event SwitchMessage -> Event (SockAddr, TransactionID, MoreToFollowFlag, [FlowStats])
flowStatsReplyE = statsReplyE >>> arr (mapFilterE f)
where f (addr, xid, FlowStatsReply moreComing stats) = Just (addr, xid, moreComing, stats)
f _ = Nothing
filterPacketIns :: (PacketInfo -> Bool) -> Event SwitchMessage -> Event SwitchMessage
filterPacketIns p = mapFilterE p'
where p' m = case m of
PeerMessage switch (xid, PacketIn pktIn) -> if p pktIn then Just m else Nothing
_ -> Just m
type SwitchOutput = [(SockAddr, (TransactionID, CSMessage))]
switchCommand :: SockAddr -> TransactionID -> CSMessage -> SwitchOutput
switchCommand addr xid msg = [(addr, (xid, msg))]
noOp :: Monoid o => o
noOp = mempty
(<+>) :: Monoid o => o -> o -> o
(<+>) = mappend
instance Monoid a => Monoid (Event a) where
mempty = NoEvent
mappend = mergeBy mappend
switchInterfaceDriver :: ServerPortNumber -> IO (IO SwitchMessage, SwitchOutput -> IO ())
switchInterfaceDriver portNumber =
do process <- openFlowServer portNumber
let actuator csMsgs = writeAll process csMsgs
return (readP process, actuator)
openFlowController :: SF (Event SwitchMessage) (Event SwitchOutput)
openFlowController =
proc i -> do
o1E <- greeter -< i
o2E <- echoHandler -< i
returnA -< mergeBy (<+>) o1E o2E
echoHandler :: SF (Event SwitchMessage) (Event SwitchOutput)
echoHandler = arr (fmap (\(addr, xid, bytes) -> switchCommand addr xid (CSEchoReply bytes)) . switchEchoRequestE)
greeter :: SF (Event SwitchMessage) (Event SwitchOutput)
greeter =
proc i -> do
returnA -< liftE (\(addr, msgID) -> switchCommand addr msgID CSHello) (switchHelloE i)