-- | 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 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket -> IO PortNumber
N.socketPort 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
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n forall a. Eq a => a -> a -> Bool
/= Int
l) (forall a. HasCallStack => String -> a
error (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.Packet -> IO ()
udp_send_packet :: Udp -> Packet -> IO ()
udp_send_packet Udp
udp = Udp -> ByteString -> IO ()
udp_sendAll_data Udp
udp forall b c a. (b -> c) -> (a -> b) -> a -> c
. Packet -> ByteString
Builder.encodePacket_strict

-- | Receive packet over Udp.
udp_recv_packet :: Udp -> IO Packet.Packet
udp_recv_packet :: Udp -> IO Packet
udp_recv_packet (Udp Socket
fd) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Packet
Binary.decodePacket_strict (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 -> Packet -> IO ()
sendPacket = Udp -> Packet -> IO ()
udp_send_packet
   recvPacket :: Udp -> IO Packet
recvPacket = Udp -> IO Packet
udp_recv_packet
   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 = 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 {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) (forall a. a -> Maybe a
Just 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 -> 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 {- base -}

> 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
        {addrFamily :: Family
N.addrFamily = Family
N.AF_INET -- localhost=ipv4
        ,addrFlags :: [AddrInfoFlag]
N.addrFlags = [AddrInfoFlag
N.AI_PASSIVE,AddrInfoFlag
N.AI_NUMERICSERV]
        ,addrSocketType :: SocketType
N.addrSocketType = SocketType
N.Datagram}
  AddrInfo
a:[AddrInfo]
_ <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
N.getAddrInfo (forall a. a -> Maybe a
Just AddrInfo
hints) forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just (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)
  forall (m :: * -> *) a. Monad m => a -> m a
return (Socket -> Udp
Udp Socket
s)

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

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