module Nettle.Servers.Client
(
ClientHandle
, connectToController
, connectToHandles
, closeClient
, receiveControlMessage
, sendMessage
, flushClient
) where
import Network
import System.IO
import qualified Data.ByteString as S
import Data.Binary.Strict.Get
import Nettle.OpenFlow hiding (PortID)
import qualified Nettle.OpenFlow.StrictPut as Strict
import Data.Word
import Foreign
newtype ClientHandle = ClientHandle (Handle, Handle, ForeignPtr Word8)
connectToController :: HostName -> PortID -> IO ClientHandle
connectToController host port =
do h <- connectTo host port
hSetBuffering h (BlockBuffering (Just (4 * 1024)))
connectToHandles h h
connectToHandles :: Handle -> Handle -> IO ClientHandle
connectToHandles h h' =
do let bufferSize = 32 * 1024
outBufferPtr <- mallocForeignPtrBytes bufferSize :: IO (ForeignPtr Word8)
return (ClientHandle (h,h',outBufferPtr))
closeClient :: ClientHandle -> IO ()
closeClient (ClientHandle (h,h',_)) = hClose h >> hClose h'
receiveControlMessage :: ClientHandle -> IO (Maybe (TransactionID, CSMessage))
receiveControlMessage (ClientHandle (h,_,_))
= do eof <- hIsEOF h
if eof
then return Nothing
else do hdrbs <- S.hGet h headerSize
when (headerSize /= S.length hdrbs) (error "error reading header")
case fst (runGet getHeader hdrbs) of
Left err -> error err
Right header ->
do let expectedBodyLen = fromIntegral (msgLength header) S.length hdrbs
bodybs <- S.hGet h expectedBodyLen
when (expectedBodyLen /= S.length bodybs) (error "error reading body")
case fst (runGet (getCSMessageBody header) bodybs) of
Left err -> error err
Right msg -> return (Just msg)
where headerSize = 8
sendMessage :: ClientHandle -> (TransactionID, SCMessage) -> IO ()
sendMessage (ClientHandle (_,h,fptr)) msg =
withForeignPtr fptr $ \ptr ->
do bytes <- Strict.runPut ptr (putSCMessage msg)
hPutBuf h ptr bytes
flushClient :: ClientHandle -> IO ()
flushClient (ClientHandle (_,h,_)) = hFlush h