<commit_before>-- |Nettle with additional features. None of this code is Frenetic-specific.
module Frenetic.NettleEx
  ( Nettle
  , module Nettle.OpenFlow
  , module Nettle.Servers.Server
  , closeServer
  , acceptSwitch
  , makeSwitchChan
  , sendToSwitch
  , sendToSwitchWithID
  , startOpenFlowServerEx
  , ethVLANId
  , ethVLANPcp
  , ethSrcIP
  , ethDstIP
  , ethProto
  , ethTOS
  , srcPort
  , dstPort
  ) where

import Frenetic.Common
import qualified Data.Map as Map
import Nettle.OpenFlow hiding (intersect)
import qualified Nettle.Servers.Server as Server
import Nettle.Servers.Server hiding (acceptSwitch, closeServer, sendToSwitch,
  sendToSwitchWithID)
import Nettle.Ethernet.EthernetFrame
import Nettle.Ethernet.AddressResolutionProtocol
import Prelude hiding (catch)
import Control.Exception

data Nettle = Nettle {
  server :: OpenFlowServer,
  switches :: IORef (Map SwitchID SwitchHandle)
}

startOpenFlowServerEx :: Maybe HostName -> ServerPortNumber -> IO Nettle
startOpenFlowServerEx host port = do
  server <- Server.startOpenFlowServer Nothing -- bind to this address
                                6633    -- port to listen on
  switches <- newIORef Map.empty
  return (Nettle server switches)

makeSwitchChan :: Nettle
               -> IO (Chan (SwitchHandle, SwitchFeatures, 
                            Chan (Maybe (TransactionID, SCMessage))))
makeSwitchChan nettle = do
  chan <- newChan
  forkIO $ forever $ do
    v <- acceptSwitch nettle
    writeChan chan v
  return chan

acceptSwitch :: Nettle
             -> IO (SwitchHandle,
                    SwitchFeatures,
                    Chan (Maybe (TransactionID, SCMessage)))
acceptSwitch nettle = do
  let exnHandler (e :: SomeException) = do
        infoM "nettle" $ "could not accept switch " ++ show e
        accept
      accept = do
        (Server.acceptSwitch (server nettle)) `catches`
          [ Handler (\(e :: AsyncException) -> throw e),
            Handler exnHandler ]
  (switch, switchFeatures) <- accept
  modifyIORef (switches nettle) (Map.insert (handle2SwitchID switch) switch)
  switchMessages <- newChan
  let loop = do
        m <- receiveFromSwitch switch
        writeChan switchMessages m
        loop
  threadId <- forkIO $ loop
  return (switch, switchFeatures, switchMessages)

closeServer :: Nettle -> IO ()
closeServer nettle = Server.closeServer (server nettle)

sendToSwitch :: SwitchHandle -> (TransactionID, CSMessage) -> IO ()
sendToSwitch sw (xid, msg) = do
  debugM "nettle" $ "msg to switch with xid=" ++ show xid ++ "; msg=" ++
                    show msg
  Server.sendToSwitch sw (xid, msg)

sendToSwitchWithID :: Nettle -> SwitchID -> (TransactionID, CSMessage) -> IO ()
sendToSwitchWithID nettle sw (xid, msg) = do
  debugM "nettle" $ "msg to switch with xid=" ++ show xid ++ "; msg=" ++
                    show msg
  Server.sendToSwitchWithID (server nettle) sw (xid, msg)

csMsgWithResponse :: CSMessage -> Bool
csMsgWithResponse msg = case msg of
  CSHello -> True
  CSEchoRequest _ -> True
  FeaturesRequest -> True
  StatsRequest _ -> True
  BarrierRequest -> True<commit_msg>Make NettleEx beyond trivial<commit_after>-- |Nettle with additional features. None of this code is Frenetic-specific.
module Frenetic.NettleEx
  ( Nettle
  , module Nettle.OpenFlow
  , module Nettle.Servers.Server
  , closeServer
  , acceptSwitch
  , makeSwitchChan
  , sendToSwitch
  , sendToSwitchWithID
  , startOpenFlowServerEx
  , ethVLANId
  , ethVLANPcp
  , ethSrcIP
  , ethDstIP
  , ethProto
  , ethTOS
  , srcPort
  , dstPort
  ) where

import Frenetic.Common
import qualified Data.Map as Map
import Nettle.OpenFlow hiding (intersect)
import qualified Nettle.Servers.Server as Server
import Nettle.Servers.Server hiding (acceptSwitch, closeServer, sendToSwitch,
  sendToSwitchWithID)
import Nettle.Ethernet.EthernetFrame
import Nettle.Ethernet.AddressResolutionProtocol
import Prelude hiding (catch)
import Control.Exception

data Nettle = Nettle {
  server :: OpenFlowServer
}

startOpenFlowServerEx :: Maybe HostName -> ServerPortNumber -> IO Nettle
startOpenFlowServerEx host port = do
  server <- Server.startOpenFlowServer Nothing -- bind to this address
                                6633    -- port to listen on
  return (Nettle server)

makeSwitchChan :: Nettle
               -> IO (Chan (SwitchHandle, SwitchFeatures, 
                            Chan (Maybe (TransactionID, SCMessage))))
makeSwitchChan nettle = do
  chan <- newChan
  forkIO $ forever $ do
    v <- acceptSwitch nettle
    writeChan chan v
  return chan

acceptSwitch :: Nettle
             -> IO (SwitchHandle,
                    SwitchFeatures,
                    Chan (Maybe (TransactionID, SCMessage)))
acceptSwitch nettle = do
  let exnHandler (e :: SomeException) = do
        infoM "nettle" $ "could not accept switch " ++ show e
        accept
      accept = do
        (Server.acceptSwitch (server nettle)) `catches`
          [ Handler (\(e :: AsyncException) -> throw e),
            Handler exnHandler ]
  (switch, switchFeatures) <- accept
  switchMessages <- newChan
  let loop = do
        m <- receiveFromSwitch switch
        writeChan switchMessages m
        loop
  threadId <- forkIO $ loop
  return (switch, switchFeatures, switchMessages)

closeServer :: Nettle -> IO ()
closeServer nettle = Server.closeServer (server nettle)

sendToSwitch :: SwitchHandle -> (TransactionID, CSMessage) -> IO ()
sendToSwitch sw (xid, msg) = do
  debugM "nettle" $ "msg to switch with xid=" ++ show xid ++ "; msg=" ++
                    show msg
  Server.sendToSwitch sw (xid, msg)

sendToSwitchWithID :: Nettle -> SwitchID -> (TransactionID, CSMessage) -> IO ()
sendToSwitchWithID nettle sw (xid, msg) = do
  debugM "nettle" $ "msg to switch with xid=" ++ show xid ++ "; msg=" ++
                    show msg
  Server.sendToSwitchWithID (server nettle) sw (xid, msg)

csMsgWithResponse :: CSMessage -> Bool
csMsgWithResponse msg = case msg of
  CSHello -> True
  CSEchoRequest _ -> True
  FeaturesRequest -> True
  StatsRequest _ -> True
  BarrierRequest -> True
{'fraction_non_alphanumeric': 0.08707818930041153, 'fraction_numerical': 0.0014814814814814814, 'mean_word_length': 2.9480181936322287, 'pattern_counts': {'":': 0, '<': 18, '<?xml version=': 0, '>': 37, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7286577', 'n_tokens_mistral': 1853, 'n_tokens_neox': 1758, 'n_words': 548}