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))