SwitchInterface.hs

{-# LANGUAGE Arrows, CPP #-}

-- | This module defines type classes for input types carrying
-- switch messages and output types carrying switch commands. It defines
-- a few basic instances of these classes. In addition it defines
-- some signal functions that implement the most basic functionality to maintain  
-- switch-controller connections.
module Nettle.FRPControl.SwitchInterface
    (
     -- * Switch input 
     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

     -- * Switch output
     , SwitchOutput
     , switchCommand
     , noOp
     , (<+>)

     -- * Driver
     , switchInterfaceDriver

     -- * Basic OpenFlow controller
     , 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 

-- | A switch message is a TCP message where normal messages
-- contain a @TransactionID@ and an @SCMessage@
type SwitchMessage = TCPMessage (TransactionID, SCMessage)

-- | Projects out the @SockAddr@ associated with the switch from a @ConnectionEstablished@ @TCPMessage@.
switchJoinE :: Event SwitchMessage -> Event SockAddr
switchJoinE = mapFilterE f 
    where f (ConnectionEstablished addr) = Just addr
          f _ = Nothing

-- | Outputs an event whenever the switch disconnects from the controller. 
-- The event carries the @SockAddr@ used to communicate with the switch and 
-- an @IOException@ value indicating the reason for the disconnection.
switchLeaveE :: Event SwitchMessage -> Event (SockAddr, IOException)
switchLeaveE = mapFilterE f
    where f (ConnectionTerminated addr e) = Just (addr, e)
          f _ = Nothing

-- | Outputs an event whenever a switch sends a hello message.
switchHelloE :: Event SwitchMessage -> Event (SockAddr, TransactionID)
switchHelloE = mapFilterE f 
    where f (PeerMessage sw (msgID, SCHello)) = Just (sw, msgID)
          f _             = Nothing

-- | Outputs an event whenever a switch sends an echo request; carries 
-- the @SockAddr@ of the switch, the @TransactionID@ of the echo request, 
-- and the data included in the echo request.
switchEchoRequestE :: Event SwitchMessage -> Event (SockAddr, TransactionID, [Word8])
switchEchoRequestE = mapFilterE f
    where f (PeerMessage sw (msgID, SCEchoRequest bytes)) = Just (sw, msgID, bytes)
          f _                                                = Nothing

-- | Outputs an event whenever a switch sends an echo reply; carries 
-- the @SockAddr@ of the switch, the @TransactionID@ of the echo reply, 
-- and the data included in the echo reply.
switchEchoReplyE :: Event SwitchMessage -> Event (SockAddr, TransactionID, [Word8])
switchEchoReplyE = mapFilterE f
    where f (PeerMessage sw (msgID, SCEchoReply bytes)) = Just (sw, msgID, bytes)
          f _                                              = Nothing

-- | Outputs an event whenever a switch sends a packet in message.
-- The event carries the @SockAddr@ of the switch, the @TransactionID@ of the
-- message, and the @PacketInfo@ message itself.
packetInE ::  Event SwitchMessage -> Event (SockAddr, TransactionID, PacketInfo)
packetInE = mapFilterE f
    where f (PeerMessage sw (msgID, PacketIn pktRecord)) = Just (sw, msgID, pktRecord)
          f _ = Nothing

-- | Outputs an event whenever a switch sends a switch features message.
-- The event carries the @SockAddr@ of the switch, the @TransactionID@ of the
-- message, and the @SwitchFeatures@ message itself.
switchFeaturesE :: Event SwitchMessage -> Event (SockAddr, TransactionID, SwitchFeatures)
switchFeaturesE = mapFilterE f 
    where f (PeerMessage sw (msgID, Features x)) = Just (sw, msgID, x)
          f _ = Nothing

-- | Outputs an event whenever a switch sends a port update message.
-- The event carries the @SockAddr@ of the switch, the @TransactionID@ of the
-- message, and the @PortStatus@ message itself.
portUpdateE :: Event SwitchMessage -> Event (SockAddr, TransactionID, PortStatus)
portUpdateE = mapFilterE f
    where f (PeerMessage sw (msgID, M.PortStatus x)) = Just (sw, msgID, x)
          f _ = Nothing

-- | Outputs an event whenever a switch sends an error message.
-- The event carries the @SockAddr@ of the switch, the @TransactionID@ of the
-- message, and the @SwitchError@ message itself.
switchErrorE :: Event SwitchMessage -> Event (SockAddr, TransactionID, SwitchError)
switchErrorE = mapFilterE f
    where f (PeerMessage sw (msgID, Error x)) = Just (sw, msgID, x)
          f _ = Nothing

-- | Outputs an event whenever a switch sends an flow removed message.
-- The event carries the @SockAddr@ of the switch, the @TransactionID@ of the
-- message, and the @FlowRemoved@ message itself.
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
-- | Outputs an event whenever a switch sends a barrier reply.
-- The event carries the @SockAddr@ of the switch and the @TransactionID@ of the
-- message.
barrierReplyE :: Event SwitchMessage -> Event (SockAddr, TransactionID)
barrierReplyE = mapFilterE f
    where f (PeerMessage sw (msgID, BarrierReply)) = Just (sw, msgID)
          f _                      = Nothing
#endif

-- | Outputs an event whenever a switch sends statistics reply.
-- The event carries the @SockAddr@ of the switch, the @TransactionID@ of the
-- message, and the @StatsReply@ message itself.
statsReplyE ::Event SwitchMessage -> Event (SockAddr, TransactionID, StatsReply)
statsReplyE = mapFilterE f
    where f (PeerMessage sw (msgID, StatsReply reply)) = Just (sw, msgID, reply)
          f _ = Nothing

-- | Outputs an event whenever a switch sends port statistics reply.
-- The event carries the @SockAddr@ of the switch, the @TransactionID@ of the
-- message, a flag indicating whether more statistics for this reply will follow 
-- in a separate message and the port statistics included in this message itself.
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

-- | Outputs an event whenever a switch sends flow statistics reply.
-- The event carries the @SockAddr@ of the switch, the @TransactionID@ of the
-- message, a flag indicating whether more statistics for this reply will follow 
-- in a separate message and the flow statistics included in this message itself.
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

-- | Remove packet in messages not satisfying the given predicate.
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

-----------------------------------------------------
-- Switch output commands
-----------------------------------------------------
-- An implementation of HasSwitchCommands
type SwitchOutput       = [(SockAddr, (TransactionID, CSMessage))]
                          
switchCommand :: SockAddr -> TransactionID -> CSMessage -> SwitchOutput 
switchCommand addr xid msg = [(addr, (xid, msg))]

-- | Another name for the unit element of a Monoid, specialized to the HasSwitchCommands class.
noOp :: Monoid o => o
noOp = mempty

-- | Infix binary operator for mappend.
(<+>) :: Monoid o => o -> o -> o 
(<+>) = mappend

-- | Monoid instance for a Monoid embedded inside an Event.
instance Monoid a => Monoid (Event a) where
    mempty  = NoEvent
    mappend = mergeBy mappend

-------------------------------------

-- | Runs an OpenFlow server at the specified port number, and return the driver IO actions.
switchInterfaceDriver :: ServerPortNumber -> IO (IO SwitchMessage, SwitchOutput -> IO ())
switchInterfaceDriver portNumber = 
    do process <- openFlowServer portNumber
       let actuator csMsgs = writeAll process csMsgs
       return (readP process, actuator)

-- | @openFlowController@ implements the basic aspects of the OpenFlow
-- protocol, such as the initial version negotiation and responding to 
-- echo requests.
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)