-- | Osc over Tcp implementation.
module Sound.Osc.Transport.Fd.Tcp where

import qualified Control.Exception as Exception {- base -}
import qualified Data.ByteString.Lazy as B {- bytestring -}
import qualified Network.Socket as N {- network -}
import qualified System.IO as IO {- base -}

import qualified Sound.Osc.Coding.Decode.Binary as Binary {- hosc -}
import qualified Sound.Osc.Coding.Encode.Builder as Builder {- hosc -}
import qualified Sound.Osc.Coding.Byte as Byte {- hosc -}
import qualified Sound.Osc.Coding.Convert as Convert {- hosc -}
import qualified Sound.Osc.Packet as Packet {- hosc -}
import qualified Sound.Osc.Transport.Fd as Fd {- hosc -}

-- | The Tcp transport handle data type.
newtype Tcp = Tcp {Tcp -> Handle
tcpHandle :: IO.Handle}

-- | Send data over Tcp.
tcp_send_data :: Tcp -> B.ByteString -> IO ()
tcp_send_data :: Tcp -> ByteString -> IO ()
tcp_send_data (Tcp Handle
fd) ByteString
d = do
  let n :: Word32
n = Int64 -> Word32
Convert.int64_to_word32 (ByteString -> Int64
B.length ByteString
d)
  Handle -> ByteString -> IO ()
B.hPut Handle
fd (ByteString -> ByteString -> ByteString
B.append (Word32 -> ByteString
Byte.encode_word32 Word32
n) ByteString
d)
  Handle -> IO ()
IO.hFlush Handle
fd

-- | Send packet over Tcp.
tcp_send_packet :: Tcp -> Packet.Packet -> IO ()
tcp_send_packet :: Tcp -> Packet -> IO ()
tcp_send_packet Tcp
tcp Packet
p = Tcp -> ByteString -> IO ()
tcp_send_data Tcp
tcp (Packet -> ByteString
Builder.encodePacket Packet
p)

-- | Receive packet over Tcp.
tcp_recv_packet :: Tcp -> IO Packet.Packet
tcp_recv_packet :: Tcp -> IO Packet
tcp_recv_packet (Tcp Handle
fd) = do
  ByteString
b0 <- Handle -> Int -> IO ByteString
B.hGet Handle
fd Int
4
  ByteString
b1 <- Handle -> Int -> IO ByteString
B.hGet Handle
fd (Word32 -> Int
Convert.word32_to_int (ByteString -> Word32
Byte.decode_word32 ByteString
b0))
  forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Packet
Binary.decodePacket ByteString
b1)

-- | Close Tcp.
tcp_close :: Tcp -> IO ()
tcp_close :: Tcp -> IO ()
tcp_close = Handle -> IO ()
IO.hClose forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tcp -> Handle
tcpHandle

-- | 'Tcp' is an instance of 'Transport'.
instance Fd.Transport Tcp where
   sendPacket :: Tcp -> Packet -> IO ()
sendPacket = Tcp -> Packet -> IO ()
tcp_send_packet
   recvPacket :: Tcp -> IO Packet
recvPacket = Tcp -> IO Packet
tcp_recv_packet
   close :: Tcp -> IO ()
close = Tcp -> IO ()
tcp_close

-- | Bracket UDP communication.
with_tcp :: IO Tcp -> (Tcp -> IO t) -> IO t
with_tcp :: forall t. IO Tcp -> (Tcp -> IO t) -> IO t
with_tcp IO Tcp
u = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracket IO Tcp
u Tcp -> IO ()
tcp_close

-- | Create and initialise Tcp socket.
tcp_socket :: (N.Socket -> N.SockAddr -> IO ()) -> Maybe String -> Int -> IO N.Socket
tcp_socket :: (Socket -> SockAddr -> IO ()) -> Maybe String -> Int -> IO Socket
tcp_socket Socket -> SockAddr -> IO ()
f Maybe String
host Int
port = do
  Socket
fd <- Family -> SocketType -> ProtocolNumber -> IO Socket
N.socket Family
N.AF_INET SocketType
N.Stream ProtocolNumber
0
  let hints :: AddrInfo
hints = AddrInfo
N.defaultHints {addrFamily :: Family
N.addrFamily = Family
N.AF_INET} -- localhost=ipv4
  AddrInfo
i:[AddrInfo]
_ <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
N.getAddrInfo (forall a. a -> Maybe a
Just AddrInfo
hints) Maybe String
host (forall a. a -> Maybe a
Just (forall a. Show a => a -> String
show Int
port))
  let sa :: SockAddr
sa = AddrInfo -> SockAddr
N.addrAddress AddrInfo
i
  ()
_ <- Socket -> SockAddr -> IO ()
f Socket
fd SockAddr
sa
  forall (m :: * -> *) a. Monad m => a -> m a
return Socket
fd

-- | Convert 'N.Socket' to 'Tcp'.
socket_to_tcp :: N.Socket -> IO Tcp
socket_to_tcp :: Socket -> IO Tcp
socket_to_tcp Socket
fd = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Handle -> Tcp
Tcp (Socket -> IOMode -> IO Handle
N.socketToHandle Socket
fd IOMode
IO.ReadWriteMode)

-- | Create and initialise Tcp.
tcp_handle :: (N.Socket -> N.SockAddr -> IO ()) -> String -> Int -> IO Tcp
tcp_handle :: (Socket -> SockAddr -> IO ()) -> String -> Int -> IO Tcp
tcp_handle Socket -> SockAddr -> IO ()
f String
host Int
port = (Socket -> SockAddr -> IO ()) -> Maybe String -> Int -> IO Socket
tcp_socket Socket -> SockAddr -> IO ()
f (forall a. a -> Maybe a
Just String
host) Int
port forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Socket -> IO Tcp
socket_to_tcp

{- | Make a 'Tcp' connection.

> import Sound.Osc.Datum {- hosc -}
> import Sound.Osc.Time {- hosc -}
> let t = openTcp "127.0.0.1" 57110
> let m1 = Packet.message "/dumpOsc" [Int32 1]
> let m2 = Packet.message "/g_new" [Int32 1]
> Fd.withTransport t (\fd -> let f = Fd.sendMessage fd in f m1 >> pauseThread 0.25 >> f m2)

-}
openTcp :: String -> Int -> IO Tcp
openTcp :: String -> Int -> IO Tcp
openTcp = (Socket -> SockAddr -> IO ()) -> String -> Int -> IO Tcp
tcp_handle Socket -> SockAddr -> IO ()
N.connect

-- | 'N.accept' connection at /s/ and run /f/.
tcp_server_f :: N.Socket -> (Tcp -> IO ()) -> IO ()
tcp_server_f :: Socket -> (Tcp -> IO ()) -> IO ()
tcp_server_f Socket
s Tcp -> IO ()
f = do
  (Socket
fd, SockAddr
_) <- Socket -> IO (Socket, SockAddr)
N.accept Socket
s
  Tcp
h <- Socket -> IO Tcp
socket_to_tcp Socket
fd
  Tcp -> IO ()
f Tcp
h

-- | A trivial 'Tcp' /Osc/ server.
tcp_server :: Int -> (Tcp -> IO ()) -> IO ()
tcp_server :: Int -> (Tcp -> IO ()) -> IO ()
tcp_server Int
port Tcp -> IO ()
f = do
  Socket
s <- (Socket -> SockAddr -> IO ()) -> Maybe String -> Int -> IO Socket
tcp_socket Socket -> SockAddr -> IO ()
N.bind forall a. Maybe a
Nothing Int
port
  Socket -> Int -> IO ()
N.listen Socket
s Int
1
  let repeatM_ :: IO a -> IO ()
repeatM_ = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a]
repeat
  forall {a}. IO a -> IO ()
repeatM_ (Socket -> (Tcp -> IO ()) -> IO ()
tcp_server_f Socket
s Tcp -> IO ()
f)