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

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

import qualified Sound.Osc.Coding.Byte as Byte {- hosc -}
import qualified Sound.Osc.Coding.Convert as Convert {- hosc -}
import qualified Sound.Osc.Coding.Decode.Binary as Decode.Binary {- hosc -}
import qualified Sound.Osc.Coding.Encode.Builder as Encode.Builder {- 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 -> ByteString.Lazy.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
ByteString.Lazy.length ByteString
d)
  Handle -> ByteString -> IO ()
ByteString.Lazy.hPut Handle
fd (ByteString -> ByteString -> ByteString
ByteString.Lazy.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.PacketOf Packet.Message -> IO ()
tcp_send_packet :: Tcp -> PacketOf Message -> IO ()
tcp_send_packet Tcp
tcp PacketOf Message
p = Tcp -> ByteString -> IO ()
tcp_send_data Tcp
tcp (PacketOf Message -> ByteString
Encode.Builder.encodePacket PacketOf Message
p)

-- | Receive packet over Tcp.
tcp_recv_packet :: Tcp -> IO (Packet.PacketOf Packet.Message)
tcp_recv_packet :: Tcp -> IO (PacketOf Message)
tcp_recv_packet (Tcp Handle
fd) = do
  b0 <- Handle -> Int -> IO ByteString
ByteString.Lazy.hGet Handle
fd Int
4
  b1 <- ByteString.Lazy.hGet fd (Convert.word32_to_int (Byte.decode_word32 b0))
  return (Decode.Binary.decodePacket b1)

tcp_recv_packet_or :: Tcp -> IO (Either String Packet.Packet)
tcp_recv_packet_or :: Tcp -> IO (Either String (PacketOf Message))
tcp_recv_packet_or (Tcp Handle
fd) = do
  b0 <- Handle -> Int -> IO ByteString
ByteString.Lazy.hGet Handle
fd Int
4
  b1 <- ByteString.Lazy.hGet fd (Convert.word32_to_int (Byte.decode_word32 b0))
  return (Decode.Binary.decodePacketOr 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 -> PacketOf Message -> IO ()
sendPacket = Tcp -> PacketOf Message -> IO ()
tcp_send_packet
  recvPacket :: Tcp -> IO (PacketOf Message)
recvPacket = Tcp -> IO (PacketOf Message)
tcp_recv_packet
  recvPacketOr :: Tcp -> IO (Either String (PacketOf Message))
recvPacketOr = Tcp -> IO (Either String (PacketOf Message))
tcp_recv_packet_or
  close :: Tcp -> IO ()
close = Tcp -> IO ()
tcp_close

-- | Bracket Tcp 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 = 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 :: (Socket.Socket -> Socket.SockAddr -> IO ()) -> Maybe String -> Int -> IO Socket.Socket
tcp_socket :: (Socket -> SockAddr -> IO ()) -> Maybe String -> Int -> IO Socket
tcp_socket Socket -> SockAddr -> IO ()
f Maybe String
host Int
port = do
  fd <- Family -> SocketType -> ProtocolNumber -> IO Socket
Socket.socket Family
Socket.AF_INET SocketType
Socket.Stream ProtocolNumber
0
  let hints = AddrInfo
Socket.defaultHints {Socket.addrFamily = Socket.AF_INET} -- localhost=ipv4
  i : _ <- Socket.getAddrInfo (Just hints) host (Just (show port))
  let sa = AddrInfo -> SockAddr
Socket.addrAddress AddrInfo
i
  _ <- f fd sa
  return fd

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

-- | Create and initialise Tcp.
tcp_handle :: (Socket.Socket -> Socket.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 a b. IO a -> (a -> IO b) -> IO b
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
> import Sound.Osc.Time
> 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 ()
Socket.connect

-- | 'Socket.accept' connection at /s/ and run /f/.
tcp_server_f :: Socket.Socket -> (Tcp -> IO ()) -> IO ()
tcp_server_f :: Socket -> (Tcp -> IO ()) -> IO ()
tcp_server_f Socket
s Tcp -> IO ()
f = do
  (fd, _) <- Socket -> IO (Socket, SockAddr)
Socket.accept Socket
s
  h <- socket_to_tcp fd
  f 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
  s <- (Socket -> SockAddr -> IO ()) -> Maybe String -> Int -> IO Socket
tcp_socket Socket -> SockAddr -> IO ()
Socket.bind Maybe String
forall a. Maybe a
Nothing Int
port
  Socket.listen s 1
  let repeatM_ = [IO a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([IO a] -> IO ()) -> (IO a -> [IO a]) -> IO a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> [IO a]
forall a. a -> [a]
repeat
  repeatM_ (tcp_server_f s f)