diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,8 +2,29 @@ OpenFlow is a Haskell library that implements OpenFlow protocols 1.0 and 1.3. It defines data types that model the logical content of the various OpenFlow protocol messages and provides serialization and deserialization methods using the [binary package](http://hackage.haskell.org/package/binary). It also provides basic functions to start servers that use these representations. -# Contributors +# Installation -* Andreas Voellmy -* Ashish Agarwal -* John Launchbury +To build a controller using this library, you need to install GHC and install this library. For information on how to install Haskell, head over to https://www.haskell.org. To install this library, clone this repository, enter the cloned directory, and then run `cabal install`. + +# Getting Started + +To write an OpenFlow 1.3 controller, start with the following template, and then fill in the `messageHandler` function: +```haskell +import Network.Data.OF13.Message +import Network.Data.OF13.Server + +main :: IO () +main = runServerOne 6633 factory + where factory sw = handshake sw >> return (messageHandler sw) + +handshake :: Switch -> IO () +handshake sw = sendMessage sw [Hello { xid = 0, len = 8 }] + +messageHandler :: Switch -> Maybe Message -> IO () +messageHandler _ Nothing = putStrLn "Disconnecting" +messageHandler sw (Just msg) = print msg >> sendMessage sw [FeatureRequest 1] +``` + +Place the above source into a file, for example, `Main.hs`. Assuming you have installed `ghc` and this library, you can then run `ghc --make Main.hs` to build an executable from `Main.hs`. You can then run it as `Main`. + +The above `main` program calls `runServerOne` which will wait for a single OpenFlow 1.3 server to connect on port 6633 and then will run the given `factory` function. The `factory` function performs an initial `handshake`, which, in this bare bones example, consists of sending a `Hello` message to the switch, and then returns a message handler function `messageHandler` that will be used to interact with that switch until the connection is terminated. When the server receives an OpenFlow 1.3 message `m`, it will run `messageHandler (Just m)` and when the connection is terminated, the server runs `messageHandler Nothing`. The message handler can do anything, but typically it sends messages to the switch. To do this, use the `sendMessage` function. diff --git a/openflow.cabal b/openflow.cabal --- a/openflow.cabal +++ b/openflow.cabal @@ -1,5 +1,5 @@ Name: openflow -Version: 0.3.0 +Version: 0.3.1 Synopsis: OpenFlow Cabal-Version: >=1.10 Build-Type: Simple @@ -8,9 +8,9 @@ License: OtherLicense License-file: LICENSE Author: Andreas Voellmy -Maintainer: Andreas Voellmy +Maintainer: Andreas Voellmy homepage: https://github.com/AndreasVoellmy/openflow -Description: +Description: This package implements the OpenFlow 1.0 and a large part of the OpenFlow 1.3 protocols. It defines a collection of data types representing the logical contents of OpenFlow messages, defines serialization and deserialization methods using the binary package, and provides some simple @@ -25,7 +25,7 @@ library - exposed-modules: + exposed-modules: Network.Data.Util Network.Data.Ethernet Network.Data.Ethernet.EthernetAddress @@ -33,7 +33,7 @@ Network.Data.Ethernet.AddressResolutionProtocol Network.Data.Ethernet.LLDP Network.Data.IPv4 - Network.Data.IPv4.IPAddress + Network.Data.IPv4.IPAddress Network.Data.IPv4.IPPacket Network.Data.IPv4.DHCP Network.Data.IPv4.UDP @@ -57,12 +57,13 @@ hs-source-dirs: src default-language: Haskell2010 build-depends: - aeson >= 0.7.0.6 && <= 0.9.0.1, + aeson >= 0.7.0.6, base >= 4.4.0.0 && <= 5, - bimap >= 0.2.4 && <= 0.3, + bimap >= 0.2.4, binary >= 0.7.0, bytestring, containers, + deepseq, deepseq-generics >= 0.1.1.2, hashable >= 1.2.1.0, network >= 2.6.0.2 diff --git a/src/Network/Data/Ethernet/AddressResolutionProtocol.hs b/src/Network/Data/Ethernet/AddressResolutionProtocol.hs --- a/src/Network/Data/Ethernet/AddressResolutionProtocol.hs +++ b/src/Network/Data/Ethernet/AddressResolutionProtocol.hs @@ -1,4 +1,5 @@ {-# LANGUAGE MultiParamTypeClasses, RecordWildCards, TypeOperators #-} +{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} module Network.Data.Ethernet.AddressResolutionProtocol ( ARPPacket (..) @@ -14,16 +15,18 @@ import Data.Word import qualified Data.Binary.Get as Strict import qualified Data.Binary.Put as Strict +import Control.DeepSeq (NFData) +import GHC.Generics (Generic) data ARPPacket = ARPQuery ARPQueryPacket | ARPReply ARPReplyPacket - deriving (Show, Eq) + deriving (Show, Eq, Generic, NFData) data ARPQueryPacket = ARPQueryPacket { querySenderEthernetAddress :: EthernetAddress , querySenderIPAddress :: IPAddress , queryTargetIPAddress :: IPAddress - } deriving (Show,Eq) + } deriving (Show,Eq, Generic, NFData) data ARPReplyPacket = @@ -32,7 +35,7 @@ , replyTargetEthernetAddress :: EthernetAddress , replyTargetIPAddress :: IPAddress } - deriving (Show, Eq) + deriving (Show, Eq, Generic, NFData) arpOpCode :: ARPPacket -> Word16 arpOpCode (ARPQuery _) = queryOpCode diff --git a/src/Network/Data/Ethernet/EthernetAddress.hs b/src/Network/Data/Ethernet/EthernetAddress.hs --- a/src/Network/Data/Ethernet/EthernetAddress.hs +++ b/src/Network/Data/Ethernet/EthernetAddress.hs @@ -32,6 +32,7 @@ import GHC.Generics (Generic) import Data.Hashable import Data.Typeable +import Control.DeepSeq import Control.DeepSeq.Generics -- | An Ethernet address consists of 6 bytes. It is stored in a single 64-bit value. diff --git a/src/Network/Data/Ethernet/EthernetFrame.hs b/src/Network/Data/Ethernet/EthernetFrame.hs --- a/src/Network/Data/Ethernet/EthernetFrame.hs +++ b/src/Network/Data/Ethernet/EthernetFrame.hs @@ -2,6 +2,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} -- | This module provides data structures for Ethernet frames -- as well as parsers and unparsers for Ethernet frames. @@ -51,6 +52,8 @@ import Network.Data.IPv4.IPAddress import Network.Data.IPv4.IPPacket import Text.Printf (printf) +import Control.DeepSeq (NFData) +import GHC.Generics (Generic) -- | An Ethernet frame is either an IP packet, an ARP packet, or an uninterpreted @ByteString@. -- Based on http://en.wikipedia.org/wiki/File:Ethernet_Type_II_Frame_format.svg @@ -63,7 +66,7 @@ priorityCodePoint :: !VLANPriority, canonicalFormatIndicator :: !Bool, vlanId :: !VLANID } - deriving (Read,Show,Eq) + deriving (Read,Show,Eq,Generic,NFData) -- | Ethernet type code, determines the type of payload carried by an Ethernet frame. type EthernetTypeCode = Word16 @@ -76,18 +79,18 @@ | LLDPInEthernet !LLDPDU | MagellanP4Packet MagellanP4Packet | OtherEthernetBody UnknownFrame - deriving (Show,Eq) + deriving (Show,Eq,Generic,NFData) class IsEthernetBody a where etherTypeCode :: a -> EthernetTypeCode putEtherBody :: a -> Put data UnknownFrame = UnknownFrame !EthernetTypeCode !S.ByteString - deriving (Show,Read,Eq) + deriving (Show,Read,Eq,Generic,NFData) data MagellanP4Packet = MagellanP4PacketIn Word8 EthernetFrame | MagellanP4PacketOut (Either Word8 Word16) EthernetFrame - deriving (Show,Eq) + deriving (Show,Eq,Generic,NFData) instance IsEthernetBody UnknownFrame where etherTypeCode (UnknownFrame c _) = c diff --git a/src/Network/Data/Ethernet/LLDP.hs b/src/Network/Data/Ethernet/LLDP.hs --- a/src/Network/Data/Ethernet/LLDP.hs +++ b/src/Network/Data/Ethernet/LLDP.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} -- | This module defines the data type of LLDP messages and defines LLDP parser -- and serialization functions. This module is very, very far from complete. @@ -27,14 +28,18 @@ import Control.Exception (assert) import Data.Bits (shiftR, shiftL, (.&.), (.|.)) import Text.Printf (printf) +import Control.DeepSeq (NFData) +import GHC.Generics (Generic) -- | An LLDP Data Unit (LLDP) consists of three values: chassis id, port id, -- and time-to-live. data LLDPDU = LLDPDU { chassisIDTLV :: !ChassisID , portIDTLV :: !(PortIDSubType, TLVPortID) , timeToLiveTLV :: !TTL - } deriving (Eq, Show) + } deriving (Eq, Show, Generic) +instance NFData LLDPDU + type TLVType = Word8 type TLVLength = Word16 @@ -93,7 +98,7 @@ | AgentCircuitID | LocallyAssigned | Reserved - deriving (Show,Read,Eq,Ord,Enum) + deriving (Show,Read,Eq,Ord,Enum,Generic,NFData) portIDSubTypeCode_2_type :: PortIDSubTypeCode -> PortIDSubType portIDSubTypeCode_2_type c diff --git a/src/Network/Data/IPv4/IPAddress.hs b/src/Network/Data/IPv4/IPAddress.hs --- a/src/Network/Data/IPv4/IPAddress.hs +++ b/src/Network/Data/IPv4/IPAddress.hs @@ -41,6 +41,7 @@ import Network.Data.Util import GHC.Generics (Generic) import Data.Hashable +import Control.DeepSeq import Control.DeepSeq.Generics import Data.Aeson.TH @@ -82,8 +83,8 @@ ipAddress :: Word8 -> Word8 -> Word8 -> Word8 -> IPAddress ipAddress b1 b2 b3 b4 = - IPAddress $ - foldl (\a b -> shift a 8 + fromIntegral b) (0 :: Word32) [b1,b2,b3,b4] + IPAddress $ + foldl (\a b -> shift a 8 + fromIntegral b) (0 :: Word32) [b1,b2,b3,b4] getIPAddress :: Get IPAddress getIPAddress = getWord32be >>= return . IPAddress diff --git a/src/Network/Data/IPv4/IPPacket.hs b/src/Network/Data/IPv4/IPPacket.hs --- a/src/Network/Data/IPv4/IPPacket.hs +++ b/src/Network/Data/IPv4/IPPacket.hs @@ -1,5 +1,6 @@ {-# LANGUAGE TypeSynonymInstances, TypeOperators, MultiParamTypeClasses, FunctionalDependencies, RecordWildCards #-} {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} {-| @@ -66,6 +67,8 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Control.Exception (assert) +import Control.DeepSeq (NFData) +import GHC.Generics (Generic) -- | An IP packet consists of a header and a body. type IPPacket = (IPHeader, IPBody) @@ -83,7 +86,7 @@ , ident :: !Word16 , flags :: !Word16 } - deriving (Read,Show,Eq) + deriving (Read,Show,Eq,Generic,NFData) type DifferentiatedServicesCodePoint = Word8 type FragOffset = Word16 @@ -115,7 +118,7 @@ | UDPInIP !UDPPortNumber !UDPPortNumber | ICMPInIP !ICMPHeader B.ByteString Word16 | UninterpretedIPBody !IPProtocol - deriving (Show,Eq) + deriving (Show,Eq,Generic,NFData) getIPHeader :: Get (IPHeader, IPProtocol) diff --git a/src/Network/Data/OF13/Message.hs b/src/Network/Data/OF13/Message.hs --- a/src/Network/Data/OF13/Message.hs +++ b/src/Network/Data/OF13/Message.hs @@ -1,5 +1,6 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} module Network.Data.OF13.Message ( Message(..) @@ -63,7 +64,6 @@ (getEthernetAddress, putEthernetAddress) import Network.Data.IPv4.IPAddress hiding (getIPAddress, putIPAddress) -import Control.Applicative import Control.Exception hiding (mask) import Control.Monad import Data.Bimap (Bimap) @@ -80,6 +80,8 @@ import Data.Map (Map) import qualified Data.Map as Map -- import qualified Debug.Trace as Debug +import Control.DeepSeq (NFData) +import GHC.Generics (Generic) data Message = Hello { xid :: XID, len :: Len } @@ -220,7 +222,7 @@ | BarrierRequest { xid :: XID } | BarrierReply { xid :: XID } | Undefined Header - deriving (Show,Eq) + deriving (Show,Eq,Generic,NFData) type MultipartTypeCode = Word16 @@ -233,10 +235,10 @@ , metadataWrite :: Word64 , maxEntries :: Int , tableProperties :: [TableProperty] - } deriving (Eq,Show,Ord) + } deriving (Eq,Show,Ord,Generic,NFData) data TableProperty = NoTableProperty --InstructionsProperty { } - deriving (Show,Eq,Ord) + deriving (Show,Eq,Ord,Generic,NFData) type Timeout = Word16 type TableID = Word8 @@ -248,7 +250,7 @@ | ApplyActions [Action] | ClearActions | Meter MeterID - deriving (Show,Eq) + deriving (Show,Eq,Generic,NFData) type MeterID = Word32 @@ -268,14 +270,14 @@ | Select { weightedBuckets :: [(BucketWeight, ActionList)] } | Indirect { bucket :: ActionList } | FastFailover { failoverBuckets :: [FailoverBucket] } - deriving (Eq,Show,Ord) + deriving (Eq,Show,Ord,Generic,NFData) type BucketWeight = Word16 data FailoverBucket = FailoverBucket { bucketActions :: ActionList , watchPort :: PortID , watchGroup :: GroupID } - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Generic,NFData) type GenericBucket = (BucketWeight, PortID, GroupID, ActionList) @@ -334,7 +336,7 @@ | DecNetworkTTL | SetNiciraRegister Int Word32 | SetField OXM - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Generic,NFData) type QueueID = Word32 type GroupID = Word32 @@ -349,7 +351,7 @@ | AllTableStats [TableStats] | AllPortStats [PortStats] | GroupDesc [(GroupID, Group)] - deriving (Eq, Show) + deriving (Eq, Show,Generic,NFData) data PortStats = PortStats { statsPortID :: PortID @@ -367,14 +369,14 @@ , collisions :: Int , portDurationSec :: Int , portDurationNanoSec :: Int - } deriving (Eq,Ord,Show) + } deriving (Eq,Ord,Show,Generic,NFData) data TableStats = TableStats { statsTableID :: Word8 , activeCount :: Int , lookupCount :: Int , matchedCount :: Int } - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Generic,NFData) type Header = (Word8, Word8, Len, XID) type XID = Word32 @@ -387,7 +389,7 @@ data PortStateChangeReason = PortAdd | PortDelete | PortModify - deriving (Show,Eq,Ord,Enum) + deriving (Show,Eq,Ord,Enum,Generic,NFData) data Port = Port { portNumber :: PortID , hwAddress :: EthernetAddress @@ -400,7 +402,7 @@ , peerFeatures :: Set PortFeature , currentSpeed :: KiloBitsPerSecond , maxSpeed :: KiloBitsPerSecond - } deriving (Show,Eq,Ord) + } deriving (Show,Eq,Ord,Generic,NFData) isPortDown :: Port -> Bool isPortDown = Set.member PortDown . portConfig @@ -426,27 +428,27 @@ | AutoNeg | Pause | PauseAsym - deriving (Eq,Ord,Enum,Show) + deriving (Eq,Ord,Enum,Show,Generic,NFData) data PortConfigFlag = PortDown | NoRecv | NoFwd | NoPacketIn - deriving (Eq,Ord,Enum,Show) + deriving (Eq,Ord,Enum,Show,Generic,NFData) data PortStateFlag = LinkDown | Blocked | Live - deriving (Eq,Ord,Enum,Show) + deriving (Eq,Ord,Enum,Show,Generic,NFData) data FlowRemovedReason = IdleTimeout | HardTimeout | FlowDelete | GroupDelete - deriving (Eq,Ord,Enum,Show) + deriving (Eq,Ord,Enum,Show,Generic,NFData) data Match = MatchOXM { oxms :: [OXM] } - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Generic,NFData) data OXM = OXMOther { oxmClass :: Word16 , oxmField :: Word8 @@ -468,7 +470,7 @@ | OXM { oxmOFField :: OXMOFField , oxmHasMask :: Bool } - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Generic,NFData) oxmHasMask' :: OXM -> Bool oxmHasMask' (InPort {}) = False @@ -515,7 +517,7 @@ | PBB_ISID Word32 Word32 | TunnelID Word64 Word64 | IPv6_EXTHDR Word16 - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Generic,NFData) type TCPPort = Word16 type UDPPort = Word16 @@ -526,12 +528,12 @@ data VLANMatch = Absent | Present (Maybe Word16) - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Generic,NFData) data PacketInReason = NoMatch | MatchedAction | InvalidTTL - deriving (Eq,Ord,Enum,Show) + deriving (Eq,Ord,Enum,Show,Generic,NFData) packetInReasonCodeMap :: Bimap PacketInReason Word8 packetInReasonCodeMap = @@ -555,7 +557,7 @@ | MeterModFailed | TableFeaturesFailed | ExperimenterError - deriving (Eq,Ord,Show) + deriving (Eq,Ord,Show,Generic,NFData) data BadRequestError = BadVersion | BadType @@ -571,7 +573,7 @@ | BadPort | BadPacket | MultipartBufferOverflow - deriving (Eq,Ord,Enum,Show) + deriving (Eq,Ord,Enum,Show,Generic,NFData) badRequestCodeMap :: Bimap BadRequestError Word16 badRequestCodeMap = @@ -603,7 +605,7 @@ | BadMatchPrereq | BadMatchDupField | BadMatchPermissions - deriving (Eq,Ord,Enum,Show) + deriving (Eq,Ord,Enum,Show,Generic,NFData) badMatchCodeMap :: Bimap BadMatchError Word16 badMatchCodeMap = @@ -630,7 +632,7 @@ | BadExperimenterType | BadInstructionLength | BadInstructionPermission - deriving (Eq,Ord,Enum,Show) + deriving (Eq,Ord,Enum,Show,Generic,NFData) badInstructionCodeMap :: Bimap BadInstructionError Word16 badInstructionCodeMap = @@ -660,7 +662,7 @@ | GroupBadBucket | GroupBadWatch | GroupPermissionError - deriving (Eq,Ord,Enum,Show) + deriving (Eq,Ord,Enum,Show,Generic,NFData) badGroupModCodeMap :: Bimap BadGroupModError Word16 badGroupModCodeMap = @@ -685,7 +687,7 @@ | FragDrop | FragReasm -- What is this? | FragMask - deriving (Eq,Ord,Enum,Show) + deriving (Eq,Ord,Enum,Show,Generic,NFData) data SwitchCapability = FlowStats | HasTableStats @@ -694,7 +696,7 @@ | IPReassembly | QueueStats | PortBlocked - deriving (Eq,Ord,Enum,Show) + deriving (Eq,Ord,Enum,Show,Generic,NFData) configFlagsFields :: [(Int, ConfigFlag)] diff --git a/src/Network/Data/OF13/Server.hs b/src/Network/Data/OF13/Server.hs --- a/src/Network/Data/OF13/Server.hs +++ b/src/Network/Data/OF13/Server.hs @@ -1,11 +1,15 @@ +{-| +Provides functions to establish connections, both passively and actively, with Openflow switches. +-} module Network.Data.OF13.Server - ( Switch + ( Switch(..) , Factory , runServer , runServerOne , sendMessage , talk , talk2 + , connectToSwitch ) where import Control.Concurrent @@ -21,6 +25,8 @@ type Factory a = Switch -> IO (Maybe a -> IO ()) newtype Switch = Switch Socket +-- |Listen (at the specified port) for any number of Openflow switches to connect to this given server. Uses the given +-- factory to instantiate Openflow session handlers for these swithes. runServer :: Binary a => Int -> Factory a -> IO () runServer portNum mkHandler = runServer_ portNum $ \(conn, _) -> @@ -28,41 +34,52 @@ forkIO $ bracket (mkHandler (Switch conn)) - (\handler -> handler Nothing >> sClose conn) + (\handler -> handler Nothing >> close conn) (talk conn) +-- |Listen (at the specified port) for a single Openflow switch to connect to this given server (possibly repeatedly). +-- Uses the given factory to instantiate Openflow session handlers for these swithes. runServerOne :: Binary a => Int -> Factory a -> IO () runServerOne portNum mkHandler = runServer_ portNum $ \(conn, _) -> void $ bracket (mkHandler (Switch conn)) - (\handler -> handler Nothing >> sClose conn) + (\handler -> handler Nothing >> close conn) (talk conn) runServer_ :: Int -> ((Socket, SockAddr) -> IO ()) -> IO () runServer_ portNum f = withSocketsDo $ do addrinfos <- getAddrInfo (Just (defaultHints {addrFlags = [AI_PASSIVE]})) - Nothing + Nothing (Just $ show portNum) let serveraddr = head addrinfos bracket (socket (addrFamily serveraddr) Stream defaultProtocol) - sClose + close (\sock -> do setSocketOption sock ReuseAddr 1 - bindSocket sock $ addrAddress serveraddr + bind sock $ addrAddress serveraddr listen sock 1 forever $ accept sock >>= f ) +-- |Establishes an Openflow connection to the given server and port, using the specified handler on the connection. +connectToSwitch :: Binary a => String -> String -> (Switch -> Maybe a -> IO ()) -> IO () +connectToSwitch hostNameOrIp port handler = do + addrinfos <- getAddrInfo Nothing (Just hostNameOrIp) (Just port) + let serveraddr = head addrinfos + sock <- socket (addrFamily serveraddr) Stream defaultProtocol + connect sock (addrAddress serveraddr) + talk sock $ handler $ Switch sock + talk :: Binary a => Socket -> (Maybe a -> IO ()) -> IO () talk = talk2 get talk2 :: Get a -> Socket -> (Maybe a -> IO ()) -> IO () talk2 getter conn handler = go $ runGetIncremental getter - where + where go (Fail _ _ err) = error err go (Partial f) = do msg <- recv conn bATCH_SIZE @@ -75,7 +92,7 @@ bATCH_SIZE :: Int bATCH_SIZE = 1024 - + sendMessage :: Binary a => Switch -> [a] -> IO () sendMessage (Switch s) = mapM_ (sendMessage' s) diff --git a/src/Network/Data/OpenFlow/Action.hs b/src/Network/Data/OpenFlow/Action.hs --- a/src/Network/Data/OpenFlow/Action.hs +++ b/src/Network/Data/OpenFlow/Action.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} module Network.Data.OpenFlow.Action ( -- * Actions @@ -22,6 +23,8 @@ , vendorAction ) where +import Control.DeepSeq (NFData) +import GHC.Generics (Generic) import Prelude hiding (drop) import Network.Data.OpenFlow.Port import Network.Data.Ethernet.EthernetAddress @@ -29,7 +32,6 @@ import Network.Data.IPv4.IPAddress import Network.Data.IPv4.IPPacket import Data.Word -import Data.Monoid -- |The supported switch actions are denoted with these symbols. data ActionType = OutputToPortType @@ -45,7 +47,7 @@ | SetTransportDstPortType | EnqueueType | VendorActionType - deriving (Show,Read,Eq,Ord,Enum) + deriving (Show,Read,Eq,Ord,Enum,Generic,NFData) -- | Each flow table entry contains a list of actions that will -- be executed when a packet matches the entry. @@ -67,7 +69,7 @@ queueID :: QueueID -- ^where to enqueue the packets } -- ^output to queue | VendorAction VendorID [Word8] - deriving (Show,Eq,Ord) + deriving (Show,Eq,Ord,Generic,NFData) -- | A @PseudoPort@ denotes the target of a forwarding @@ -79,7 +81,7 @@ | ToController MaxLenToSendController -- ^send to controller | NormalSwitching -- ^process with normal L2/L3 switching | WithTable -- ^process packet with flow table - deriving (Show,Read, Eq, Ord) + deriving (Show,Read, Eq, Ord, Generic, NFData) -- | A send to controller action includes the maximum -- number of bytes that a switch will send to the @@ -93,7 +95,7 @@ -- lists provides methods for denoting the do-nothing action (@mempty@) and for concatenating action sequences @mconcat@. -- type ActionSequence = [Action] data ActionSequence = ActionSequence !Int ![Action] - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Generic, NFData) instance Monoid ActionSequence where mempty = drop diff --git a/src/Network/Data/OpenFlow/Error.hs b/src/Network/Data/OpenFlow/Error.hs --- a/src/Network/Data/OpenFlow/Error.hs +++ b/src/Network/Data/OpenFlow/Error.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} + module Network.Data.OpenFlow.Error ( SwitchError (..) , HelloFailure (..) @@ -9,6 +11,8 @@ ) where import Data.Word +import Control.DeepSeq (NFData) +import GHC.Generics (Generic) -- | When a switch encounters an error condition, it sends the controller -- a message containing the information in @SwitchErrorRecord@. @@ -18,11 +22,15 @@ | FlowModFailed FlowModError [Word8] | PortModFailed PortModError [Word8] | QueueOperationFailed QueueOpError [Word8] - deriving (Show, Eq) - + deriving (Generic, Show, Eq) + +instance NFData SwitchError + data HelloFailure = IncompatibleVersions | HelloPermissionsError - deriving (Show, Eq, Ord, Enum) + deriving (Generic, Show, Eq, Ord, Enum) + +instance NFData HelloFailure data RequestError = VersionNotSupported | MessageTypeNotSupported @@ -33,8 +41,9 @@ | BadRequestLength | BufferEmpty | UnknownBuffer - deriving (Show, Eq, Ord, Enum) + deriving (Generic, Show, Eq, Ord, Enum) +instance NFData RequestError data ActionError = UnknownActionType | BadActionLength @@ -45,22 +54,29 @@ | ActionPermissionsError | TooManyActions | InvalidQueue - deriving (Show, Eq, Ord, Enum) + deriving (Generic, Show, Eq, Ord, Enum) +instance NFData ActionError + data FlowModError = TablesFull | OverlappingFlow | FlowModPermissionsError | EmergencyModHasTimeouts | BadCommand | UnsupportedActionList - deriving (Show, Eq, Ord, Enum) + deriving (Generic, Show, Eq, Ord, Enum) +instance NFData FlowModError + data PortModError = BadPort | BadHardwareAddress - deriving (Show, Eq, Ord, Enum) + deriving (Generic, Show, Eq, Ord, Enum) +instance NFData PortModError + data QueueOpError = QueueOpBadPort | QueueDoesNotExist | QueueOpPermissionsError - deriving (Show, Eq, Ord, Enum) + deriving (Generic, Show, Eq, Ord, Enum) +instance NFData QueueOpError diff --git a/src/Network/Data/OpenFlow/FlowTable.hs b/src/Network/Data/OpenFlow/FlowTable.hs --- a/src/Network/Data/OpenFlow/FlowTable.hs +++ b/src/Network/Data/OpenFlow/FlowTable.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} -- | A switch has some number of flow tables. Each flow table is a -- prioritized list of entries containing a @Match@, a list of @@ -20,6 +21,8 @@ import Network.Data.OpenFlow.Match import Network.Data.OpenFlow.Packet import Data.Word +import Control.DeepSeq (NFData) +import GHC.Generics (Generic) type FlowTableID = Word8 @@ -65,7 +68,7 @@ outPort :: !(Maybe PseudoPort), priority :: !Priority } - deriving (Show, Eq) + deriving (Show, Eq,Generic,NFData) type Cookie = Word64 @@ -76,7 +79,7 @@ -- associated with it. data TimeOut = Permanent | ExpireAfter !Word16 - deriving (Show,Eq) + deriving (Show,Eq,Generic,NFData) -- | When a switch removes a flow, it may send a message containing the information @@ -90,10 +93,10 @@ flowRemovedIdleTimeout :: !Integer, flowRemovedPacketCount :: !Integer, flowRemovedByteCount :: !Integer } - deriving (Show,Eq) + deriving (Show,Eq,Generic,NFData) data FlowRemovalReason = IdleTimerExpired | HardTimerExpired | DeletedByController - deriving (Show,Eq,Ord,Enum) + deriving (Show,Eq,Ord,Enum,Generic,NFData) diff --git a/src/Network/Data/OpenFlow/Match.hs b/src/Network/Data/OpenFlow/Match.hs --- a/src/Network/Data/OpenFlow/Match.hs +++ b/src/Network/Data/OpenFlow/Match.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DisambiguateRecordFields, RecordWildCards, NamedFieldPuns #-} {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} + module Network.Data.OpenFlow.Match ( Match (..) , MatchHeader(..) @@ -31,13 +32,14 @@ import Data.Aeson import qualified Data.List as List import Data.Maybe (isJust, catMaybes) -import GHC.Generics +import Control.DeepSeq (NFData) +import GHC.Generics (Generic) -- | Each flow entry includes a match, which essentially defines packet-matching condition. -- Fields that are left Nothing are "wildcards". data Match = Match !(Maybe PortID) !MatchHeader !MatchBody - deriving (Show,Read,Eq,Ord,Generic) + deriving (Show,Read,Eq,Ord,Generic,NFData) instance ToJSON Match instance FromJSON Match @@ -46,7 +48,7 @@ vLANID :: !(Maybe VLANID), vLANPriority :: !(Maybe VLANPriority), ethFrameType :: !(Maybe EthernetTypeCode) } - deriving (Show,Read,Eq,Ord, Generic) + deriving (Show,Read,Eq,Ord, Generic,NFData) instance ToJSON MatchHeader instance FromJSON MatchHeader @@ -55,7 +57,7 @@ srcIPAddress, dstIPAddress :: !IPAddressPrefix, srcTransportPort, dstTransportPort :: !(Maybe IP.TransportPort) } - deriving (Show,Read,Eq,Ord, Generic) + deriving (Show,Read,Eq,Ord, Generic,NFData) instance ToJSON MatchBody instance FromJSON MatchBody diff --git a/src/Network/Data/OpenFlow/MatchBuilder.hs b/src/Network/Data/OpenFlow/MatchBuilder.hs --- a/src/Network/Data/OpenFlow/MatchBuilder.hs +++ b/src/Network/Data/OpenFlow/MatchBuilder.hs @@ -40,7 +40,6 @@ import Network.Data.OpenFlow.Match import Network.Data.OpenFlow.Port import Data.Bits -import Data.Monoid import Text.Printf (printf) {- diff --git a/src/Network/Data/OpenFlow/Messages.hs b/src/Network/Data/OpenFlow/Messages.hs --- a/src/Network/Data/OpenFlow/Messages.hs +++ b/src/Network/Data/OpenFlow/Messages.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveGeneric #-} + {-| This module provides a logical representation of OpenFlow switches and protocol messages. An OpenFlow message is either a switch-to-controller message or controller-to-switch message. @@ -9,8 +11,9 @@ , CSMessage (..) ) where -import Control.DeepSeq.Generics +import Control.DeepSeq (NFData) import Data.Word +import GHC.Generics import qualified Network.Data.OpenFlow.Port as Port import qualified Network.Data.OpenFlow.Packet as Packet import Network.Data.OpenFlow.Switch @@ -18,13 +21,12 @@ import Network.Data.OpenFlow.Statistics import Network.Data.OpenFlow.Error - -- | Every OpenFlow message is tagged with a MessageID value. type TransactionID = Word32 -- | The Switch can send the following messages to -- the controller. -data SCMessage = SCHello TransactionID -- ^ Sent after a switch establishes a TCP connection to the controller +data SCMessage = SCHello TransactionID -- ^ Sent after a switch establishes a TCP connection to the controller | SCEchoRequest TransactionID ![Word8] -- ^ Switch requests an echo reply | SCEchoReply TransactionID ![Word8] -- ^ Switch responds to an echo request | Features TransactionID !SwitchFeatures -- ^ Switch reports its features @@ -35,7 +37,7 @@ | Error TransactionID !SwitchError -- ^ Switch reports an error | BarrierReply TransactionID -- ^ Switch responds that a barrier has been processed | QueueConfigReply TransactionID !QueueConfigReply - deriving (Show,Eq) + deriving (Generic,Show,Eq) instance NFData SCMessage diff --git a/src/Network/Data/OpenFlow/MessagesBinary.hs b/src/Network/Data/OpenFlow/MessagesBinary.hs --- a/src/Network/Data/OpenFlow/MessagesBinary.hs +++ b/src/Network/Data/OpenFlow/MessagesBinary.hs @@ -1,5 +1,7 @@ {-# LANGUAGE CPP, DisambiguateRecordFields, RecordWildCards, NamedFieldPuns #-} {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} -- | This module implements parsing and unparsing functions for -- OpenFlow messages. It exports a driver that can be used to read messages @@ -12,6 +14,7 @@ , putSCMessage ) where +import Prelude hiding (mconcat) import Network.Data.Ethernet.EthernetAddress import Network.Data.Ethernet.EthernetFrame import Network.Data.IPv4.IPAddress @@ -24,10 +27,7 @@ import Network.Data.OpenFlow.FlowTable import Network.Data.OpenFlow.Statistics import Network.Data.OpenFlow.Error -import Control.Applicative -import Control.DeepSeq.Generics import Control.Monad (when) -import Data.Monoid hiding ((<>), mconcat) import Data.Word import Data.Bits import Data.Binary @@ -40,6 +40,8 @@ import Data.Bimap (Bimap, (!), (!>)) import qualified Data.Bimap as Bimap import Data.Char (ord) +import Control.DeepSeq (NFData) +import GHC.Generics (Generic) @@ -178,9 +180,7 @@ , msgType :: !MessageTypeCode , msgLength :: !Word16 , msgTransactionID :: !M.TransactionID - } deriving (Show,Eq) - -instance NFData OFPHeader + } deriving (Show,Eq,Generic,NFData) headerSize :: Int headerSize = 8 @@ -1125,7 +1125,7 @@ , bufferID' :: !(Maybe BufferID) , outPort' :: !(Maybe PseudoPort) , cookie' :: !Cookie - } deriving (Eq,Show) + } deriving (Eq,Show,Generic,NFData) -- | Specification: @ofp_flow_mod_command@. @@ -1135,10 +1135,10 @@ | FlowModifyStrictType | FlowDeleteType | FlowDeleteStrictType - deriving (Show,Eq,Ord) + deriving (Show,Eq,Ord,Generic,NFData) -- | A set of flow mod attributes can be added to a flow modification command. -data FlowModFlag = SendFlowRemoved | CheckOverlap | Emergency deriving (Show,Eq,Ord,Enum) +data FlowModFlag = SendFlowRemoved | CheckOverlap | Emergency deriving (Show,Eq,Ord,Enum,Generic,NFData) {-# INLINE putFlowModMain #-} putFlowModMain :: M.TransactionID -> FlowMod -> Put @@ -1679,7 +1679,7 @@ ofpm_nw_proto :: !Word8, ofpm_nw_src, ofpm_nw_dst :: !Word32, ofpm_tp_src, ofpm_tp_dst :: !Word16 - } deriving (Show,Eq) + } deriving (Show,Eq,Generic,NFData) ofpMatch2Match :: OFPMatch -> Match ofpMatch2Match ofpm = Match diff --git a/src/Network/Data/OpenFlow/Packet.hs b/src/Network/Data/OpenFlow/Packet.hs --- a/src/Network/Data/OpenFlow/Packet.hs +++ b/src/Network/Data/OpenFlow/Packet.hs @@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DisambiguateRecordFields, RecordWildCards #-} +{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} module Network.Data.OpenFlow.Packet ( -- * Sending packets @@ -22,6 +23,8 @@ import Network.Data.Ethernet.EthernetFrame import Data.Maybe (isJust, fromJust) import Data.Word +import Control.DeepSeq (NFData) +import GHC.Generics (Generic) -- | A switch can be remotely commanded to send a packet. The packet -- can either be a packet buffered at the switch, in which case the @@ -32,7 +35,7 @@ bufferIDData :: !(Either BufferID B.ByteString), -- ^either a buffer ID or the data itself packetInPort :: !(Maybe PortID), -- ^the port at which the packet received, for the purposes of processing this command packetActions :: !ActionSequence -- ^actions to apply to the packet - } deriving (Eq,Show) + } deriving (Eq,Show,Generic,NFData) -- |A switch may buffer a packet that it receives. -- When it does so, the packet is assigned a bufferID @@ -75,14 +78,13 @@ reasonSent :: !PacketInReason, -- ^reason packet is being sent enclosedFrame :: EthernetFrame, -- ^result of parsing packetData field. rawBytes :: !B.ByteString - } deriving (Show,Eq) - + } deriving (Show,Eq,Generic,NFData) -- |A PacketInfo message includes the reason that the message -- was sent, namely either there was no match, or there was -- a match, and that match's actions included a Sent-To-Controller -- action. -data PacketInReason = NotMatched | ExplicitSend deriving (Show,Read,Eq,Ord,Enum) +data PacketInReason = NotMatched | ExplicitSend deriving (Show,Read,Eq,Ord,Enum,Generic,NFData) -- | The number of bytes in a packet. type NumBytes = Int diff --git a/src/Network/Data/OpenFlow/Port.hs b/src/Network/Data/OpenFlow/Port.hs --- a/src/Network/Data/OpenFlow/Port.hs +++ b/src/Network/Data/OpenFlow/Port.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} module Network.Data.OpenFlow.Port ( Port (..) @@ -19,6 +19,7 @@ import Data.Word import Data.Map (Map) +import Control.DeepSeq (NFData) import qualified Data.Map as Map import Network.Data.Ethernet.EthernetAddress @@ -38,10 +39,11 @@ portAdvertisedFeatures :: Maybe PortFeatures, -- ^features advertised by port portSupportedFeatures :: Maybe PortFeatures, -- ^features supported by port portPeerFeatures :: Maybe PortFeatures -- ^features advertised by peer - } deriving (Show,Read,Eq, Ord, Generic) + } deriving (Show, Read, Eq, Ord, Generic) instance ToJSON Port instance FromJSON Port +instance NFData Port type PortID = Word16 @@ -50,8 +52,10 @@ | STPForwarding | STPBlocking deriving (Show,Read,Eq,Ord,Enum, Generic) + instance ToJSON SpanningTreePortState instance FromJSON SpanningTreePortState +instance NFData SpanningTreePortState -- | Possible behaviors of a physical port. Specification: -- @ofp_port_config@. @@ -63,9 +67,11 @@ | NoFlooding -- ^do not include this port when flooding | DropForwarded -- ^drop packets forwarded to port | NoPacketInMsg -- ^do not send packet-in messages for this port - deriving (Show,Read,Eq,Ord,Enum, Generic) + deriving (Show, Read, Eq, Ord, Enum, Generic) + instance ToJSON PortConfigAttribute instance FromJSON PortConfigAttribute +instance NFData PortConfigAttribute -- | Possible port features. Specification @ofp_port_features@. data PortFeature @@ -82,8 +88,10 @@ | Pause | AsymmetricPause deriving (Show,Read,Eq, Ord, Generic) + instance ToJSON PortFeature instance FromJSON PortFeature +instance NFData PortFeature -- | Set of 'PortFeature's. Specification: bitmap of members in @enum -- ofp_port_features@. @@ -123,7 +131,9 @@ data PortStatusUpdateReason = PortAdded | PortDeleted | PortModified - deriving (Show,Read,Eq,Ord,Enum) + deriving (Generic,Show,Read,Eq,Ord,Enum) + +instance NFData PortStatusUpdateReason portAttributeOn :: PortID -> EthernetAddress -> PortConfigAttribute -> PortMod portAttributeOn pid addr attr = PortModRecord pid addr (Map.singleton attr True) diff --git a/src/Network/Data/OpenFlow/Statistics.hs b/src/Network/Data/OpenFlow/Statistics.hs --- a/src/Network/Data/OpenFlow/Statistics.hs +++ b/src/Network/Data/OpenFlow/Statistics.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} module Network.Data.OpenFlow.Statistics ( StatsRequest (..) @@ -26,6 +27,8 @@ import Control.Monad (liftM,liftM2) import Data.Aeson.TH import Data.Int +import Control.DeepSeq (NFData) +import GHC.Generics (Generic) data StatsRequest = FlowStatsRequest { @@ -44,15 +47,15 @@ portStatsQuery :: PortQuery } | QueueStatsRequest { queueStatsPort :: PortQuery, queueStatsQuery:: QueueQuery } - deriving (Show,Eq) + deriving (Show,Eq,Generic,NFData) -data PortQuery = AllPorts | SinglePort PortID deriving (Show,Eq,Ord) -data QueueQuery = AllQueues | SingleQueue QueueID deriving (Show,Eq,Ord) +data PortQuery = AllPorts | SinglePort PortID deriving (Show,Eq,Ord,Generic,NFData) +data QueueQuery = AllQueues | SingleQueue QueueID deriving (Show,Eq,Ord,Generic,NFData) data TableQuery = AllTables | EmergencyTable | Table FlowTableID - deriving (Show,Eq) + deriving (Show,Eq,Generic,NFData) @@ -63,7 +66,7 @@ | TableStatsReply !MoreToFollowFlag [TableStats] | PortStatsReply !MoreToFollowFlag [(PortID,PortStats)] | QueueStatsReply !MoreToFollowFlag [QueueStats] - deriving (Show,Eq) + deriving (Show,Eq,Generic,NFData) type MoreToFollowFlag = Bool @@ -72,13 +75,13 @@ , softwareDesc :: String , serialNumber :: String , datapathDesc :: String - } deriving (Show,Eq) + } deriving (Show,Eq,Generic,NFData) data AggregateFlowStats = AggregateFlowStats { aggregateFlowStatsPacketCount :: Integer, aggregateFlowStatsByteCount :: Integer, aggregateFlowStatsFlowCount :: Integer - } deriving (Show, Eq) + } deriving (Show, Eq,Generic,NFData) data FlowStats = FlowStats { @@ -94,7 +97,7 @@ flowStatsPacketCount :: !Int64, flowStatsByteCount :: !Int64 } - deriving (Show,Eq) + deriving (Show,Eq,Generic,NFData) data TableStats = TableStats { @@ -103,7 +106,7 @@ tableStatsMaxEntries :: Integer, tableStatsActiveCount :: Integer, tableStatsLookupCount :: Integer, - tableStatsMatchedCount :: Integer } deriving (Show,Eq) + tableStatsMatchedCount :: Integer } deriving (Show,Eq,Generic,NFData) data PortStats = PortStats { @@ -119,7 +122,7 @@ portStatsReceiverOverrunError :: Maybe Double, portStatsReceiverCRCError :: Maybe Double, portStatsCollisions :: Maybe Double - } deriving (Show,Eq) + } deriving (Show,Eq,Generic,NFData) -- | A port stats value with all fields missing. nullPortStats :: PortStats @@ -198,7 +201,7 @@ queueStatsQueueID :: QueueID, queueStatsTransmittedBytes :: Integer, queueStatsTransmittedPackets :: Integer, - queueStatsTransmittedErrors :: Integer } deriving (Show,Eq) + queueStatsTransmittedErrors :: Integer } deriving (Show,Eq,Generic,NFData) $(deriveJSON defaultOptions ''PortStats) diff --git a/src/Network/Data/OpenFlow/Switch.hs b/src/Network/Data/OpenFlow/Switch.hs --- a/src/Network/Data/OpenFlow/Switch.hs +++ b/src/Network/Data/OpenFlow/Switch.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} + module Network.Data.OpenFlow.Switch ( SwitchFeatures (..) , SwitchID @@ -13,6 +15,8 @@ ) where import Data.Word +import Control.DeepSeq (NFData) +import GHC.Generics (Generic) import Network.Data.OpenFlow.Port import Network.Data.OpenFlow.Action import Numeric (showHex) @@ -26,7 +30,7 @@ capabilities :: [SwitchCapability], -- ^switch's capabilities supportedActions :: [ActionType], -- ^switch's supported actions ports :: [Port] -- ^description of each port on switch - } deriving (Show,Read,Eq) + } deriving (Show,Read,Eq,Generic,NFData) -- |A unique identifier for a switch, also known as DataPathID. type SwitchID = Word64 @@ -48,23 +52,22 @@ | HasQueueStatistics -- ^can provide queue statistics | CanMatchIPAddressesInARPPackets -- ^match IP addresses in ARP packets | CanReassembleIPFragments -- ^can reassemble IP fragments - deriving (Show,Read,Eq,Ord,Enum) - + deriving (Show,Read,Eq,Ord,Enum,Generic,NFData) data QueueConfigRequest = QueueConfigRequest PortID - deriving (Show,Read,Eq) + deriving (Show,Read,Eq,Generic,NFData) data QueueConfigReply = PortQueueConfig PortID [QueueConfig] - deriving (Show,Read,Eq) + deriving (Show,Read,Eq,Generic,NFData) data QueueConfig = QueueConfig QueueID [QueueProperty] - deriving (Show,Read,Eq) + deriving (Show,Read,Eq,Generic,NFData) type QueueLength = Word16 data QueueProperty = MinRateQueue QueueRate - deriving (Show,Read,Eq) + deriving (Show,Read,Eq,Generic,NFData) data QueueRate = Disabled | Enabled Word16 - deriving (Show, Read, Eq) + deriving (Show, Read, Eq, Generic, NFData)