nettle-openflow-0.1: src/Examples/SimpleImperativeIONetworkControl/SimpleImperativeIONetworkControl.hs

module SimpleImperativeIONetworkControl where

import Prelude hiding (catch)
import Control.Concurrent
import Control.Monad.State
import Control.Monad.Reader
import Nettle.OpenFlow.MessagesBinary
import Nettle.OpenFlow.Messages
import Nettle.Servers.MultiplexedTCPServer
import Nettle.Servers.TCPServer
import Control.Exception

type NetController s a = ReaderT ChanEnv (StateT s IO) a
type ChanEnv           = Process (TCPMessage (TransactionID, SCMessage)) (SockAddr, ((TransactionID, CSMessage))) IOException

runNetController :: ServerPortNumber -> NetController s a -> s -> IO ()
runNetController pstring netc s = do 
    netCh <- muxedTCPServer pstring messageDriver
    chanFn netCh
  where
    chanFn netCh = do
      runStateT (runReaderT netc netCh) s 
      return ()


waitForEvent :: NetController s (TCPMessage (TransactionID, SCMessage))
waitForEvent = ask >>= liftIO . readP

sendMessage  :: SockAddr -> TransactionID -> CSMessage -> NetController s ()
sendMessage addr xid msg = ask >>= \p -> liftIO $ tellP p (addr, (xid, msg))