module Sound.OSC.Transport.FD.TCP where
import qualified Data.ByteString.Lazy as B
import Control.Monad
import Network
import System.IO
import Sound.OSC.Class
import Sound.OSC.Coding
import Sound.OSC.Coding.Byte
import Sound.OSC.Transport.FD
data TCP = TCP {tcpHandle :: Handle}
instance Transport TCP where
sendOSC (TCP fd) msg =
do let b = encodeOSC msg
n = fromIntegral (B.length b)
B.hPut fd (B.append (encode_u32 n) b)
hFlush fd
recvPacket (TCP fd) =
do b0 <- B.hGet fd 4
b1 <- B.hGet fd (fromIntegral (decode_u32 b0))
return (decodePacket b1)
close (TCP fd) = hClose fd
openTCP :: String -> Int -> IO TCP
openTCP host =
liftM TCP .
connectTo host .
PortNumber .
fromIntegral
tcpServer' :: Int -> (TCP -> IO ()) -> IO ()
tcpServer' p f = do
s <- listenOn (PortNumber (fromIntegral p))
(sequence_ . repeat) (do (fd, _, _) <- accept s
f (TCP fd)
return ())