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

import Control.Exception {- base -}
import Control.Monad {- base -}
import Data.Bifunctor {- base -}

import qualified Data.ByteString as B {- bytestring -}
import qualified Data.ByteString.Lazy as BL {- bytestring -}
import qualified Network.Socket as N {- network -}
import qualified Network.Socket.ByteString as C {- network -}

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

-- | The Udp transport handle data type.
newtype Udp = Udp {Udp -> Socket
udpSocket :: N.Socket}

-- | Return the port number associated with the Udp socket.
udpPort :: Integral n => Udp -> IO n
udpPort :: forall n. Integral n => Udp -> IO n
udpPort = (PortNumber -> n) -> IO PortNumber -> IO n
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PortNumber -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO PortNumber -> IO n) -> (Udp -> IO PortNumber) -> Udp -> IO n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket -> IO PortNumber
N.socketPort (Socket -> IO PortNumber)
-> (Udp -> Socket) -> Udp -> IO PortNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Udp -> Socket
udpSocket

-- | Send data over Udp using 'C.send'.
udp_send_data :: Udp -> B.ByteString -> IO ()
udp_send_data :: Udp -> ByteString -> IO ()
udp_send_data (Udp Socket
fd) ByteString
d = do
  let l :: Int
l = ByteString -> Int
B.length ByteString
d
  Int
n <- Socket -> ByteString -> IO Int
C.send Socket
fd ByteString
d
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
l) (String -> IO ()
forall a. HasCallStack => String -> a
error ((String, Int, Int) -> String
forall a. Show a => a -> String
show (String
"udp_send_data", Int
l, Int
n)))

-- | Send data over Udp using 'C.sendAll'.
udp_sendAll_data :: Udp -> B.ByteString -> IO ()
udp_sendAll_data :: Udp -> ByteString -> IO ()
udp_sendAll_data (Udp Socket
fd) = Socket -> ByteString -> IO ()
C.sendAll Socket
fd

-- | Send packet over Udp.
udp_send_packet :: Udp -> Packet.PacketOf Packet.Message -> IO ()
udp_send_packet :: Udp -> PacketOf Message -> IO ()
udp_send_packet Udp
udp = Udp -> ByteString -> IO ()
udp_sendAll_data Udp
udp (ByteString -> IO ())
-> (PacketOf Message -> ByteString) -> PacketOf Message -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PacketOf Message -> ByteString
Builder.encodePacket_strict

-- | Receive packet over Udp.
udp_recv_packet :: Udp -> IO (Packet.PacketOf Packet.Message)
udp_recv_packet :: Udp -> IO (PacketOf Message)
udp_recv_packet (Udp Socket
fd) = (ByteString -> PacketOf Message)
-> IO ByteString -> IO (PacketOf Message)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> PacketOf Message
Binary.decodePacket_strict (Socket -> Int -> IO ByteString
C.recv Socket
fd Int
8192)

udp_recv_packet_or :: Udp -> IO (Either String Packet.Packet)
udp_recv_packet_or :: Udp -> IO (Either String (PacketOf Message))
udp_recv_packet_or (Udp Socket
fd) = ByteString -> Either String (PacketOf Message)
Binary.decodePacketOr (ByteString -> Either String (PacketOf Message))
-> (ByteString -> ByteString)
-> ByteString
-> Either String (PacketOf Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict (ByteString -> Either String (PacketOf Message))
-> IO ByteString -> IO (Either String (PacketOf Message))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket -> Int -> IO ByteString
C.recv Socket
fd Int
8192

-- | Close Udp.
udp_close :: Udp -> IO ()
udp_close :: Udp -> IO ()
udp_close (Udp Socket
fd) = Socket -> IO ()
N.close Socket
fd

-- | 'Udp' is an instance of 'Fd.Transport'.
instance Fd.Transport Udp where
  sendPacket :: Udp -> PacketOf Message -> IO ()
sendPacket = Udp -> PacketOf Message -> IO ()
udp_send_packet
  recvPacket :: Udp -> IO (PacketOf Message)
recvPacket = Udp -> IO (PacketOf Message)
udp_recv_packet
  recvPacketOr :: Udp -> IO (Either String (PacketOf Message))
recvPacketOr = Udp -> IO (Either String (PacketOf Message))
udp_recv_packet_or
  close :: Udp -> IO ()
close = Udp -> IO ()
udp_close

-- | Bracket Udp communication.
with_udp :: IO Udp -> (Udp -> IO t) -> IO t
with_udp :: forall t. IO Udp -> (Udp -> IO t) -> IO t
with_udp IO Udp
u = IO Udp -> (Udp -> IO ()) -> (Udp -> IO t) -> IO t
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO Udp
u Udp -> IO ()
udp_close

-- | Create and initialise Udp socket.
udp_socket :: (N.Socket -> N.SockAddr -> IO ()) -> String -> Int -> IO Udp
udp_socket :: (Socket -> SockAddr -> IO ()) -> String -> Int -> IO Udp
udp_socket Socket -> SockAddr -> IO ()
f String
host Int
port = do
  Socket
fd <- Family -> SocketType -> ProtocolNumber -> IO Socket
N.socket Family
N.AF_INET SocketType
N.Datagram ProtocolNumber
0
  let hints :: AddrInfo
hints = AddrInfo
N.defaultHints {N.addrFamily = N.AF_INET} -- localhost=ipv4
  AddrInfo
i : [AddrInfo]
_ <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
forall (t :: * -> *).
GetAddrInfo t =>
Maybe AddrInfo -> Maybe String -> Maybe String -> IO (t AddrInfo)
N.getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints) (String -> Maybe String
forall a. a -> Maybe a
Just 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
  Udp -> IO Udp
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Socket -> Udp
Udp Socket
fd)

-- | Set option, ie. 'N.Broadcast' or 'N.RecvTimeOut'.
set_udp_opt :: N.SocketOption -> Int -> Udp -> IO ()
set_udp_opt :: SocketOption -> Int -> Udp -> IO ()
set_udp_opt SocketOption
k Int
v (Udp Socket
s) = Socket -> SocketOption -> Int -> IO ()
N.setSocketOption Socket
s SocketOption
k Int
v

-- | Get option.
get_udp_opt :: N.SocketOption -> Udp -> IO Int
get_udp_opt :: SocketOption -> Udp -> IO Int
get_udp_opt SocketOption
k (Udp Socket
s) = Socket -> SocketOption -> IO Int
N.getSocketOption Socket
s SocketOption
k

-- | Make a 'Udp' connection.
openUdp :: String -> Int -> IO Udp
openUdp :: String -> Int -> IO Udp
openUdp = (Socket -> SockAddr -> IO ()) -> String -> Int -> IO Udp
udp_socket Socket -> SockAddr -> IO ()
N.connect

{- | Trivial 'Udp' server socket.

> import Control.Concurrent

> let u0 = udpServer "127.0.0.1" 57300
> t0 <- forkIO (Fd.withTransport u0 (\fd -> forever (Fd.recvMessage fd >>= print >> print "Received message, continuing")))
> killThread t0

> let u1 = openUdp "127.0.0.1" 57300
> Fd.withTransport u1 (\fd -> Fd.sendMessage fd (Packet.message "/n" []))
-}
udpServer :: String -> Int -> IO Udp
udpServer :: String -> Int -> IO Udp
udpServer = (Socket -> SockAddr -> IO ()) -> String -> Int -> IO Udp
udp_socket Socket -> SockAddr -> IO ()
N.bind

-- | Variant of 'udpServer' that doesn't require the host address.
udp_server :: Int -> IO Udp
udp_server :: Int -> IO Udp
udp_server Int
p = do
  let hints :: AddrInfo
hints =
        AddrInfo
N.defaultHints
          { N.addrFamily = N.AF_INET -- localhost=ipv4
          , N.addrFlags = [N.AI_PASSIVE, N.AI_NUMERICSERV]
          , N.addrSocketType = N.Datagram
          }
  AddrInfo
a : [AddrInfo]
_ <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
forall (t :: * -> *).
GetAddrInfo t =>
Maybe AddrInfo -> Maybe String -> Maybe String -> IO (t AddrInfo)
N.getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints) Maybe String
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just (Int -> String
forall a. Show a => a -> String
show Int
p))
  Socket
s <- Family -> SocketType -> ProtocolNumber -> IO Socket
N.socket (AddrInfo -> Family
N.addrFamily AddrInfo
a) (AddrInfo -> SocketType
N.addrSocketType AddrInfo
a) (AddrInfo -> ProtocolNumber
N.addrProtocol AddrInfo
a)
  Socket -> SocketOption -> Int -> IO ()
N.setSocketOption Socket
s SocketOption
N.ReuseAddr Int
1
  Socket -> SockAddr -> IO ()
N.bind Socket
s (AddrInfo -> SockAddr
N.addrAddress AddrInfo
a)
  Udp -> IO Udp
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Socket -> Udp
Udp Socket
s)

-- | Send to specified address using 'C.sendAllTo.
sendTo :: Udp -> Packet.PacketOf Packet.Message -> N.SockAddr -> IO ()
sendTo :: Udp -> PacketOf Message -> SockAddr -> IO ()
sendTo (Udp Socket
fd) PacketOf Message
p = Socket -> ByteString -> SockAddr -> IO ()
C.sendAllTo Socket
fd (PacketOf Message -> ByteString
Builder.encodePacket_strict PacketOf Message
p)

-- | Recv variant to collect message source address.
recvFrom :: Udp -> IO (Packet.PacketOf Packet.Message, N.SockAddr)
recvFrom :: Udp -> IO (PacketOf Message, SockAddr)
recvFrom (Udp Socket
fd) = ((ByteString, SockAddr) -> (PacketOf Message, SockAddr))
-> IO (ByteString, SockAddr) -> IO (PacketOf Message, SockAddr)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> PacketOf Message)
-> (ByteString, SockAddr) -> (PacketOf Message, SockAddr)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ByteString -> PacketOf Message
Binary.decodePacket_strict) (Socket -> Int -> IO (ByteString, SockAddr)
C.recvFrom Socket
fd Int
8192)