haskell-nettle openflow example

of-init-sw.hs

import Nettle.Servers.Server
import Nettle.OpenFlow
import Control.Concurrent
import System.Environment

getPortNumber :: IO ServerPortNumber
getPortNumber = do
  args <- getArgs
  if length args < 1
    then error "Requires one command-line argument specifying the server port number."
    else return (read (args !! 0))

getQueueConfig switch = do
  qcfg <- do sendToSwitch switch (0, GetQueueConfig (QueueConfigRequest 0x05))
             m <- receiveFromSwitch switch
             case m of
               Nothing -> error ("switch broke conn during GetQueueConfigRequest")
               Just (xid, msg) ->
                 case msg of
                   QueueConfigReply _ -> return msg
                   _ -> error ("invalid GetQueueConfigReply: " ++ show (xid, msg))
  return qcfg

main :: IO ()
main = do
  portNum <- getPortNumber
  ofpServer <- startOpenFlowServer Nothing portNum
  forever $ do switch <- acceptSwitch ofpServer
               forkIO $ do features <- handshake switch
                           putStrLn ("features: " ++ show features)
                           queuecfg <- getQueueConfig switch
                           putStrLn ("queuecfg: " ++ show queuecfg)                                                                       
                           closeSwitchHandle switch
  closeServer ofpServer