-- | 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 packet over TCP.
tcp_send_packet :: TCP -> Packet.Packet -> IO ()
tcp_send_packet :: TCP -> Packet -> IO ()
tcp_send_packet (TCP Handle
fd) Packet
p = do
  let b :: ByteString
b = Packet -> ByteString
Builder.encodePacket Packet
p
      n :: Word32
n = Int64 -> Word32
Convert.int64_to_word32 (ByteString -> Int64
B.length ByteString
b)
  Handle -> ByteString -> IO ()
B.hPut Handle
fd (ByteString -> ByteString -> ByteString
B.append (Word32 -> ByteString
Byte.encode_word32 Word32
n) ByteString
b)
  Handle -> IO ()
IO.hFlush Handle
fd

-- | 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))
  Packet -> IO Packet
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 (Handle -> IO ()) -> (TCP -> Handle) -> TCP -> IO ()
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 :: IO TCP -> (TCP -> IO t) -> IO t
with_tcp IO TCP
u = IO TCP -> (TCP -> IO ()) -> (TCP -> IO t) -> IO t
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 (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints) Maybe String
host (String -> Maybe String
forall a. a -> Maybe a
Just (Int -> String
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
  Socket -> IO Socket
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 = (Handle -> TCP) -> IO Handle -> IO TCP
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 (String -> Maybe String
forall a. a -> Maybe a
Just String
host) Int
port IO Socket -> (Socket -> IO TCP) -> IO TCP
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

-- | 'sequence_' of 'repeat'.
repeatM_ :: (Monad m) => m a -> m ()
repeatM_ :: m a -> m ()
repeatM_ = [m a] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([m a] -> m ()) -> (m a -> [m a]) -> m a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> [m a]
forall a. a -> [a]
repeat

-- | 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 Maybe String
forall a. Maybe a
Nothing Int
port
  Socket -> Int -> IO ()
N.listen Socket
s Int
1
  IO () -> IO ()
forall (m :: * -> *) a. Monad m => m a -> m ()
repeatM_ (Socket -> (TCP -> IO ()) -> IO ()
tcp_server_f Socket
s TCP -> IO ()
f)