{-# LANGUAGE CPP, DisambiguateRecordFields #-}
-- | A switch has some number of flow tables. Each flow table is a 
-- prioritized list of entries containing a @Match@, a list of 
-- @Action@s, and other options affecting the behavior of the switch.
-- This module represents the OpenFlow messages that can be used
-- to modify flow tables.
module Nettle.OpenFlow.FlowTable ( 
  FlowTableID
  , FlowMod (..)
#if OPENFLOW_VERSION==1
  , Cookie
#endif
  , Priority
  , TimeOut (..)
  , FlowRemoved (..)
  , FlowRemovalReason (..)
  ) where

import Nettle.OpenFlow.Switch
import Nettle.OpenFlow.Action
import Nettle.OpenFlow.Match
import Nettle.OpenFlow.Packet
import Data.Word
import Data.List as List

type FlowTableID = Word8

data FlowMod = AddFlow { match             :: Match     
                       , priority          :: Priority  
                       , actions           :: ActionSequence
#if OPENFLOW_VERSION==1
                       , cookie            :: Cookie
#endif
                       , idleTimeOut       :: TimeOut 
                       , hardTimeOut       :: TimeOut 
#if OPENFLOW_VERSION==152 || OPENFLOW_VERSION==1
                       , notifyWhenRemoved :: Bool
#endif
                       , applyToPacket     :: Maybe BufferID
#if OPENFLOW_VERSION==152 || OPENFLOW_VERSION==1
                       , overlapAllowed    :: Bool
#endif                                                 
                       } 
             | AddEmergencyFlow { match          :: Match
                                , priority       :: Priority
                                , actions        :: ActionSequence
#if OPENFLOW_VERSION==1
                                , cookie         :: Cookie                                       
#endif
#if OPENFLOW_VERSION==152 || OPENFLOW_VERSION==1
                                , overlapAllowed :: Bool
#endif                                                          
                                }
                                        
             | ModifyFlows { match                      :: Match
                           , newActions                 :: ActionSequence
                           , ifMissingPriority          :: Priority 
#if OPENFLOW_VERSION==1
                           , ifMissingCookie            :: Cookie                                
#endif
                           , ifMissingIdleTimeOut       :: TimeOut 
                           , ifMissingHardTimeOut       :: TimeOut
#if OPENFLOW_VERSION==152 || OPENFLOW_VERSION==1
                           , ifMissingNotifyWhenRemoved :: Bool 
                           , ifMissingOverlapAllowed    :: Bool
#endif
                           }
             | ModifyExactFlow { match                      :: Match 
                               , priority                   :: Priority
                               , newActions                 :: ActionSequence
#if OPENFLOW_VERSION==1
                               , ifMissingCookie            :: Cookie                                       
#endif
                               , ifMissingIdleTimeOut       :: TimeOut
                               , ifMissingHardTimeOut       :: TimeOut
#if OPENFLOW_VERSION==152 || OPENFLOW_VERSION==1 
                               , ifMissingNotifyWhenRemoved :: Bool 
                               , ifMissingOverlapAllowed    :: Bool                                      
#endif
                               }
             | DeleteFlows { match   :: Match, 
                             outPort :: Maybe PseudoPort 
                           } 
             | DeleteExactFlow { match    :: Match, 
                                 outPort  :: Maybe PseudoPort, 
                                 priority :: Priority
                               } 
                     
                     deriving (Show, Eq)


#if OPENFLOW_VERSION==1
type Cookie = Word64
#endif 

-- |The priority of a flow entry is a 16-bit integer. Flow entries with higher numeric priorities match before lower ones.
type Priority = Word16

-- | Each flow entry has idle and hard timeout values
-- associated with it.
data TimeOut  = Permanent 
              | ExpireAfter Word16
                deriving (Show,Eq)


-- | When a switch removes a flow, it may send a message containing the information
-- in @FlowRemovedRecord@ to the controller.
#if OPENFLOW_VERSION==151
data FlowRemoved = FlowRemoved { flowRemovedMatch       :: Match, 
                                 flowRemovedPriority    :: Priority, 
                                 flowRemovedReason      :: FlowRemovalReason,
                                 flowRemovedDuration    :: Integer,
                                 flowRemovedPacketCount :: Integer, 
                                 flowRemovedByteCount   :: Integer }
                 deriving (Show,Eq)
#endif
#if OPENFLOW_VERSION==152 
data FlowRemoved = FlowRemoved { flowRemovedMatch       :: Match, 
                                 flowRemovedPriority    :: Priority, 
                                 flowRemovedReason      :: FlowRemovalReason,
                                 flowRemovedDuration    :: Integer,
                                 flowRemovedIdleTimeout :: Integer, 
                                 flowRemovedPacketCount :: Integer, 
                                 flowRemovedByteCount   :: Integer }
                 deriving (Show,Eq)
#endif
#if OPENFLOW_VERSION==1
data FlowRemoved = FlowRemoved { flowRemovedMatch         :: Match, 
                                 flowRemovedCookie        :: Word64,
                                 flowRemovedPriority      :: Priority, 
                                 flowRemovedReason        :: FlowRemovalReason,
                                 flowRemovedDuration      :: Integer,
                                 flowRemovedDurationNSecs :: Integer,
                                 flowRemovedIdleTimeout   :: Integer, 
                                 flowRemovedPacketCount   :: Integer, 
                                 flowRemovedByteCount     :: Integer }
                 deriving (Show,Eq)
#endif

data FlowRemovalReason = IdleTimerExpired
                       | HardTimerExpired 
#if OPENFLOW_VERSION==152 || OPENFLOW_VERSION==1
                       | DeletedByController
#endif
                         deriving (Show,Eq,Ord,Enum)