module Dahdit.Network
  ( Decoder (..)
  , runDecoder
  , Encoder (..)
  , runEncoder
  , Conn (..)
  , HostPort (..)
  , TcpOpts (..)
  , resolveAddr
  , tcpClientConn
  , withTcpClientConn
  , tcpServerConn
  , udpClientConn
  , withUdpClientConn
  , udpServerConn
  , withUdpServerConn
  )
where

import Control.Monad (unless, (>=>))
import Control.Monad.IO.Class (liftIO)
import Control.Monad.IO.Unlift (MonadUnliftIO)
import Dahdit
  ( Binary (..)
  , ByteCount (..)
  , Get
  , GetError
  , GetIncCb
  , GetIncRequest (..)
  , Put
  , getEnd
  , getTarget
  , getTargetInc
  , putTarget
  )
import Data.Acquire (Acquire, mkAcquire, withAcquire)
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.IORef (IORef, modifyIORef', newIORef, readIORef)
import Data.Tuple (swap)
import Network.Socket qualified as NS
import Network.Socket.ByteString qualified as NSB

maxRecv :: Int
maxRecv :: Int
maxRecv = Int
65535

maxQueue :: Int
maxQueue :: Int
maxQueue = Int
1024

sockRecvUntil :: NS.Socket -> IORef ByteString -> Int -> IO ()
sockRecvUntil :: Socket -> IORef ByteString -> Int -> IO ()
sockRecvUntil Socket
sock IORef ByteString
ref Int
len = IO ()
go
 where
  go :: IO ()
go = do
    ByteString
lastBs <- IORef ByteString -> IO ByteString
forall a. IORef a -> IO a
readIORef IORef ByteString
ref
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Int
BS.length ByteString
lastBs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      ByteString
chunkBs <- Socket -> Int -> IO ByteString
NSB.recv Socket
sock Int
maxRecv
      IORef ByteString -> (ByteString -> ByteString) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef ByteString
ref (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
chunkBs)
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
chunkBs) IO ()
go

-- Appropriate for TCP connections (uses 'recv' instead of 'recvFrom')
sockGetIncCb :: NS.Socket -> IO (GetIncCb ByteString IO)
sockGetIncCb :: Socket -> IO (GetIncCb ByteString IO)
sockGetIncCb Socket
sock = do
  IORef ByteString
ref <- ByteString -> IO (IORef ByteString)
forall a. a -> IO (IORef a)
newIORef ByteString
forall a. Monoid a => a
mempty
  GetIncCb ByteString IO -> IO (GetIncCb ByteString IO)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GetIncCb ByteString IO -> IO (GetIncCb ByteString IO))
-> GetIncCb ByteString IO -> IO (GetIncCb ByteString IO)
forall a b. (a -> b) -> a -> b
$ \(GetIncRequest ByteCount
_ (ByteCount Int
off) (ByteCount Int
len)) -> do
    IORef ByteString -> (ByteString -> ByteString) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef ByteString
ref (Int -> ByteString -> ByteString
BS.drop Int
off)
    Socket -> IORef ByteString -> Int -> IO ()
sockRecvUntil Socket
sock IORef ByteString
ref Int
len
    ByteString
nextBs <- IORef ByteString -> IO ByteString
forall a. IORef a -> IO a
readIORef IORef ByteString
ref
    Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (if ByteString -> Int
BS.length ByteString
nextBs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len then Maybe ByteString
forall a. Maybe a
Nothing else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
nextBs)

newtype Decoder k = Decoder {forall k. Decoder k -> forall a. Get a -> IO (k, Either GetError a)
unDecoder :: forall a. Get a -> IO (k, Either GetError a)}
  deriving stock ((forall a b. (a -> b) -> Decoder a -> Decoder b)
-> (forall a b. a -> Decoder b -> Decoder a) -> Functor Decoder
forall a b. a -> Decoder b -> Decoder a
forall a b. (a -> b) -> Decoder a -> Decoder b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Decoder a -> Decoder b
fmap :: forall a b. (a -> b) -> Decoder a -> Decoder b
$c<$ :: forall a b. a -> Decoder b -> Decoder a
<$ :: forall a b. a -> Decoder b -> Decoder a
Functor)

runDecoder :: (Binary a) => Decoder k -> IO (k, Either GetError a)
runDecoder :: forall a k. Binary a => Decoder k -> IO (k, Either GetError a)
runDecoder Decoder k
dec = Decoder k -> forall a. Get a -> IO (k, Either GetError a)
forall k. Decoder k -> forall a. Get a -> IO (k, Either GetError a)
unDecoder Decoder k
dec Get a
forall a. Binary a => Get a
get

-- | Decodes a stream of packets incrementally for TCP
streamDecoder :: Maybe ByteCount -> NS.Socket -> IO (Decoder ())
streamDecoder :: Maybe ByteCount -> Socket -> IO (Decoder ())
streamDecoder Maybe ByteCount
mayLim Socket
sock = do
  GetIncCb ByteString IO
cb <- Socket -> IO (GetIncCb ByteString IO)
sockGetIncCb Socket
sock
  Decoder () -> IO (Decoder ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((forall a. Get a -> IO ((), Either GetError a)) -> Decoder ()
forall k.
(forall a. Get a -> IO (k, Either GetError a)) -> Decoder k
Decoder (\Get a
getter -> ((Either GetError a, ByteCount, ByteCount)
 -> ((), Either GetError a))
-> IO (Either GetError a, ByteCount, ByteCount)
-> IO ((), Either GetError a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Either GetError a
res, ByteCount
_, ByteCount
_) -> ((), Either GetError a
res)) (Maybe ByteCount
-> Get a
-> GetIncCb ByteString IO
-> IO (Either GetError a, ByteCount, ByteCount)
forall a.
Maybe ByteCount
-> Get a
-> GetIncCb ByteString IO
-> IO (Either GetError a, ByteCount, ByteCount)
forall z (m :: * -> *) a.
BinaryGetTarget z m =>
Maybe ByteCount
-> Get a
-> GetIncCb z m
-> m (Either GetError a, ByteCount, ByteCount)
getTargetInc Maybe ByteCount
mayLim Get a
getter GetIncCb ByteString IO
cb)))

-- | Completely decodes one packet at a time for UDP server
datagramServerDecoder :: Maybe ByteCount -> NS.Socket -> Decoder NS.SockAddr
datagramServerDecoder :: Maybe ByteCount -> Socket -> Decoder SockAddr
datagramServerDecoder Maybe ByteCount
mayLim Socket
sock =
  let lim :: Int
lim = Int -> (ByteCount -> Int) -> Maybe ByteCount -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
maxRecv ByteCount -> Int
unByteCount Maybe ByteCount
mayLim
  in  (forall a. Get a -> IO (SockAddr, Either GetError a))
-> Decoder SockAddr
forall k.
(forall a. Get a -> IO (k, Either GetError a)) -> Decoder k
Decoder ((forall a. Get a -> IO (SockAddr, Either GetError a))
 -> Decoder SockAddr)
-> (forall a. Get a -> IO (SockAddr, Either GetError a))
-> Decoder SockAddr
forall a b. (a -> b) -> a -> b
$ \Get a
getter -> do
        (ByteString
bs, SockAddr
addr) <- Socket -> Int -> IO (ByteString, SockAddr)
NSB.recvFrom Socket
sock Int
lim
        (Either GetError a
ea, ByteCount
_) <- Get a -> ByteString -> IO (Either GetError a, ByteCount)
forall z (m :: * -> *) a.
BinaryGetTarget z m =>
Get a -> z -> m (Either GetError a, ByteCount)
getTarget (Get a -> Get a
forall a. Get a -> Get a
getEnd Get a
getter) ByteString
bs
        (SockAddr, Either GetError a) -> IO (SockAddr, Either GetError a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SockAddr
addr, Either GetError a
ea)

datagramClientDecoder :: Maybe ByteCount -> NS.Socket -> Decoder ()
datagramClientDecoder :: Maybe ByteCount -> Socket -> Decoder ()
datagramClientDecoder Maybe ByteCount
mayLim Socket
sock =
  let lim :: Int
lim = Int -> (ByteCount -> Int) -> Maybe ByteCount -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
maxRecv ByteCount -> Int
unByteCount Maybe ByteCount
mayLim
  in  (forall a. Get a -> IO ((), Either GetError a)) -> Decoder ()
forall k.
(forall a. Get a -> IO (k, Either GetError a)) -> Decoder k
Decoder ((forall a. Get a -> IO ((), Either GetError a)) -> Decoder ())
-> (forall a. Get a -> IO ((), Either GetError a)) -> Decoder ()
forall a b. (a -> b) -> a -> b
$ \Get a
getter -> do
        ByteString
bs <- Socket -> Int -> IO ByteString
NSB.recv Socket
sock Int
lim
        (Either GetError a
ea, ByteCount
_) <- Get a -> ByteString -> IO (Either GetError a, ByteCount)
forall z (m :: * -> *) a.
BinaryGetTarget z m =>
Get a -> z -> m (Either GetError a, ByteCount)
getTarget (Get a -> Get a
forall a. Get a -> Get a
getEnd Get a
getter) ByteString
bs
        ((), Either GetError a) -> IO ((), Either GetError a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((), Either GetError a
ea)

newtype Encoder k = Encoder {forall k. Encoder k -> k -> Put -> IO ()
unEncoder :: k -> Put -> IO ()}

runEncoder :: (Binary a) => Encoder k -> k -> a -> IO ()
runEncoder :: forall a k. Binary a => Encoder k -> k -> a -> IO ()
runEncoder Encoder k
enc k
k = Encoder k -> k -> Put -> IO ()
forall k. Encoder k -> k -> Put -> IO ()
unEncoder Encoder k
enc k
k (Put -> IO ()) -> (a -> Put) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Put
forall a. Binary a => a -> Put
put

streamEncoder :: NS.Socket -> Encoder ()
streamEncoder :: Socket -> Encoder ()
streamEncoder Socket
sock = (() -> Put -> IO ()) -> Encoder ()
forall k. (k -> Put -> IO ()) -> Encoder k
Encoder (\()
_ -> Put -> IO ByteString
forall z (m :: * -> *). BinaryPutTarget z m => Put -> m z
putTarget (Put -> IO ByteString) -> (ByteString -> IO ()) -> Put -> IO ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Socket -> ByteString -> IO ()
NSB.sendAll Socket
sock)

datagramClientEncoder :: NS.Socket -> Encoder ()
datagramClientEncoder :: Socket -> Encoder ()
datagramClientEncoder Socket
sock = (() -> Put -> IO ()) -> Encoder ()
forall k. (k -> Put -> IO ()) -> Encoder k
Encoder (\()
_ -> Put -> IO ByteString
forall z (m :: * -> *). BinaryPutTarget z m => Put -> m z
putTarget (Put -> IO ByteString) -> (ByteString -> IO ()) -> Put -> IO ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Socket -> ByteString -> IO ()
NSB.sendAll Socket
sock)

datagramServerEncoder :: NS.Socket -> Encoder NS.SockAddr
datagramServerEncoder :: Socket -> Encoder SockAddr
datagramServerEncoder Socket
sock = (SockAddr -> Put -> IO ()) -> Encoder SockAddr
forall k. (k -> Put -> IO ()) -> Encoder k
Encoder (\SockAddr
addr -> Put -> IO ByteString
forall z (m :: * -> *). BinaryPutTarget z m => Put -> m z
putTarget (Put -> IO ByteString) -> (ByteString -> IO ()) -> Put -> IO ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ByteString -> SockAddr -> IO ())
-> SockAddr -> ByteString -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Socket -> ByteString -> SockAddr -> IO ()
NSB.sendAllTo Socket
sock) SockAddr
addr)

data Conn k = Conn {forall k. Conn k -> Decoder k
connDecoder :: Decoder k, forall k. Conn k -> Encoder k
connEncoder :: Encoder k}

data HostPort = HostPort
  { HostPort -> Maybe String
hpHost :: !(Maybe String)
  , HostPort -> Int
hpPort :: !Int
  }
  deriving stock (HostPort -> HostPort -> Bool
(HostPort -> HostPort -> Bool)
-> (HostPort -> HostPort -> Bool) -> Eq HostPort
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HostPort -> HostPort -> Bool
== :: HostPort -> HostPort -> Bool
$c/= :: HostPort -> HostPort -> Bool
/= :: HostPort -> HostPort -> Bool
Eq, Eq HostPort
Eq HostPort =>
(HostPort -> HostPort -> Ordering)
-> (HostPort -> HostPort -> Bool)
-> (HostPort -> HostPort -> Bool)
-> (HostPort -> HostPort -> Bool)
-> (HostPort -> HostPort -> Bool)
-> (HostPort -> HostPort -> HostPort)
-> (HostPort -> HostPort -> HostPort)
-> Ord HostPort
HostPort -> HostPort -> Bool
HostPort -> HostPort -> Ordering
HostPort -> HostPort -> HostPort
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: HostPort -> HostPort -> Ordering
compare :: HostPort -> HostPort -> Ordering
$c< :: HostPort -> HostPort -> Bool
< :: HostPort -> HostPort -> Bool
$c<= :: HostPort -> HostPort -> Bool
<= :: HostPort -> HostPort -> Bool
$c> :: HostPort -> HostPort -> Bool
> :: HostPort -> HostPort -> Bool
$c>= :: HostPort -> HostPort -> Bool
>= :: HostPort -> HostPort -> Bool
$cmax :: HostPort -> HostPort -> HostPort
max :: HostPort -> HostPort -> HostPort
$cmin :: HostPort -> HostPort -> HostPort
min :: HostPort -> HostPort -> HostPort
Ord, Int -> HostPort -> ShowS
[HostPort] -> ShowS
HostPort -> String
(Int -> HostPort -> ShowS)
-> (HostPort -> String) -> ([HostPort] -> ShowS) -> Show HostPort
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HostPort -> ShowS
showsPrec :: Int -> HostPort -> ShowS
$cshow :: HostPort -> String
show :: HostPort -> String
$cshowList :: [HostPort] -> ShowS
showList :: [HostPort] -> ShowS
Show)

newtype TcpOpts = TcpOpts {TcpOpts -> Int
tcoFinTimeoutMs :: Int}
  deriving newtype (Int -> TcpOpts -> ShowS
[TcpOpts] -> ShowS
TcpOpts -> String
(Int -> TcpOpts -> ShowS)
-> (TcpOpts -> String) -> ([TcpOpts] -> ShowS) -> Show TcpOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TcpOpts -> ShowS
showsPrec :: Int -> TcpOpts -> ShowS
$cshow :: TcpOpts -> String
show :: TcpOpts -> String
$cshowList :: [TcpOpts] -> ShowS
showList :: [TcpOpts] -> ShowS
Show)
  deriving stock (TcpOpts -> TcpOpts -> Bool
(TcpOpts -> TcpOpts -> Bool)
-> (TcpOpts -> TcpOpts -> Bool) -> Eq TcpOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TcpOpts -> TcpOpts -> Bool
== :: TcpOpts -> TcpOpts -> Bool
$c/= :: TcpOpts -> TcpOpts -> Bool
/= :: TcpOpts -> TcpOpts -> Bool
Eq, Eq TcpOpts
Eq TcpOpts =>
(TcpOpts -> TcpOpts -> Ordering)
-> (TcpOpts -> TcpOpts -> Bool)
-> (TcpOpts -> TcpOpts -> Bool)
-> (TcpOpts -> TcpOpts -> Bool)
-> (TcpOpts -> TcpOpts -> Bool)
-> (TcpOpts -> TcpOpts -> TcpOpts)
-> (TcpOpts -> TcpOpts -> TcpOpts)
-> Ord TcpOpts
TcpOpts -> TcpOpts -> Bool
TcpOpts -> TcpOpts -> Ordering
TcpOpts -> TcpOpts -> TcpOpts
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TcpOpts -> TcpOpts -> Ordering
compare :: TcpOpts -> TcpOpts -> Ordering
$c< :: TcpOpts -> TcpOpts -> Bool
< :: TcpOpts -> TcpOpts -> Bool
$c<= :: TcpOpts -> TcpOpts -> Bool
<= :: TcpOpts -> TcpOpts -> Bool
$c> :: TcpOpts -> TcpOpts -> Bool
> :: TcpOpts -> TcpOpts -> Bool
$c>= :: TcpOpts -> TcpOpts -> Bool
>= :: TcpOpts -> TcpOpts -> Bool
$cmax :: TcpOpts -> TcpOpts -> TcpOpts
max :: TcpOpts -> TcpOpts -> TcpOpts
$cmin :: TcpOpts -> TcpOpts -> TcpOpts
min :: TcpOpts -> TcpOpts -> TcpOpts
Ord)

data SockTy = SockTyTcp | SockTyUdp
  deriving stock (SockTy -> SockTy -> Bool
(SockTy -> SockTy -> Bool)
-> (SockTy -> SockTy -> Bool) -> Eq SockTy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SockTy -> SockTy -> Bool
== :: SockTy -> SockTy -> Bool
$c/= :: SockTy -> SockTy -> Bool
/= :: SockTy -> SockTy -> Bool
Eq, Eq SockTy
Eq SockTy =>
(SockTy -> SockTy -> Ordering)
-> (SockTy -> SockTy -> Bool)
-> (SockTy -> SockTy -> Bool)
-> (SockTy -> SockTy -> Bool)
-> (SockTy -> SockTy -> Bool)
-> (SockTy -> SockTy -> SockTy)
-> (SockTy -> SockTy -> SockTy)
-> Ord SockTy
SockTy -> SockTy -> Bool
SockTy -> SockTy -> Ordering
SockTy -> SockTy -> SockTy
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SockTy -> SockTy -> Ordering
compare :: SockTy -> SockTy -> Ordering
$c< :: SockTy -> SockTy -> Bool
< :: SockTy -> SockTy -> Bool
$c<= :: SockTy -> SockTy -> Bool
<= :: SockTy -> SockTy -> Bool
$c> :: SockTy -> SockTy -> Bool
> :: SockTy -> SockTy -> Bool
$c>= :: SockTy -> SockTy -> Bool
>= :: SockTy -> SockTy -> Bool
$cmax :: SockTy -> SockTy -> SockTy
max :: SockTy -> SockTy -> SockTy
$cmin :: SockTy -> SockTy -> SockTy
min :: SockTy -> SockTy -> SockTy
Ord, Int -> SockTy -> ShowS
[SockTy] -> ShowS
SockTy -> String
(Int -> SockTy -> ShowS)
-> (SockTy -> String) -> ([SockTy] -> ShowS) -> Show SockTy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SockTy -> ShowS
showsPrec :: Int -> SockTy -> ShowS
$cshow :: SockTy -> String
show :: SockTy -> String
$cshowList :: [SockTy] -> ShowS
showList :: [SockTy] -> ShowS
Show, Int -> SockTy
SockTy -> Int
SockTy -> [SockTy]
SockTy -> SockTy
SockTy -> SockTy -> [SockTy]
SockTy -> SockTy -> SockTy -> [SockTy]
(SockTy -> SockTy)
-> (SockTy -> SockTy)
-> (Int -> SockTy)
-> (SockTy -> Int)
-> (SockTy -> [SockTy])
-> (SockTy -> SockTy -> [SockTy])
-> (SockTy -> SockTy -> [SockTy])
-> (SockTy -> SockTy -> SockTy -> [SockTy])
-> Enum SockTy
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SockTy -> SockTy
succ :: SockTy -> SockTy
$cpred :: SockTy -> SockTy
pred :: SockTy -> SockTy
$ctoEnum :: Int -> SockTy
toEnum :: Int -> SockTy
$cfromEnum :: SockTy -> Int
fromEnum :: SockTy -> Int
$cenumFrom :: SockTy -> [SockTy]
enumFrom :: SockTy -> [SockTy]
$cenumFromThen :: SockTy -> SockTy -> [SockTy]
enumFromThen :: SockTy -> SockTy -> [SockTy]
$cenumFromTo :: SockTy -> SockTy -> [SockTy]
enumFromTo :: SockTy -> SockTy -> [SockTy]
$cenumFromThenTo :: SockTy -> SockTy -> SockTy -> [SockTy]
enumFromThenTo :: SockTy -> SockTy -> SockTy -> [SockTy]
Enum, SockTy
SockTy -> SockTy -> Bounded SockTy
forall a. a -> a -> Bounded a
$cminBound :: SockTy
minBound :: SockTy
$cmaxBound :: SockTy
maxBound :: SockTy
Bounded)

sockTyReal :: SockTy -> NS.SocketType
sockTyReal :: SockTy -> SocketType
sockTyReal = \case
  SockTy
SockTyTcp -> SocketType
NS.Stream
  SockTy
SockTyUdp -> SocketType
NS.Datagram

data Role = RoleServer | RoleClient
  deriving stock (Role -> Role -> Bool
(Role -> Role -> Bool) -> (Role -> Role -> Bool) -> Eq Role
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Role -> Role -> Bool
== :: Role -> Role -> Bool
$c/= :: Role -> Role -> Bool
/= :: Role -> Role -> Bool
Eq, Eq Role
Eq Role =>
(Role -> Role -> Ordering)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Role)
-> (Role -> Role -> Role)
-> Ord Role
Role -> Role -> Bool
Role -> Role -> Ordering
Role -> Role -> Role
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Role -> Role -> Ordering
compare :: Role -> Role -> Ordering
$c< :: Role -> Role -> Bool
< :: Role -> Role -> Bool
$c<= :: Role -> Role -> Bool
<= :: Role -> Role -> Bool
$c> :: Role -> Role -> Bool
> :: Role -> Role -> Bool
$c>= :: Role -> Role -> Bool
>= :: Role -> Role -> Bool
$cmax :: Role -> Role -> Role
max :: Role -> Role -> Role
$cmin :: Role -> Role -> Role
min :: Role -> Role -> Role
Ord, Int -> Role -> ShowS
[Role] -> ShowS
Role -> String
(Int -> Role -> ShowS)
-> (Role -> String) -> ([Role] -> ShowS) -> Show Role
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Role -> ShowS
showsPrec :: Int -> Role -> ShowS
$cshow :: Role -> String
show :: Role -> String
$cshowList :: [Role] -> ShowS
showList :: [Role] -> ShowS
Show)

data Target = Target
  { Target -> HostPort
targetHp :: !HostPort
  , Target -> SockTy
targetSockTy :: !SockTy
  , Target -> Role
targetRole :: !Role
  }
  deriving stock (Target -> Target -> Bool
(Target -> Target -> Bool)
-> (Target -> Target -> Bool) -> Eq Target
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Target -> Target -> Bool
== :: Target -> Target -> Bool
$c/= :: Target -> Target -> Bool
/= :: Target -> Target -> Bool
Eq, Eq Target
Eq Target =>
(Target -> Target -> Ordering)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Target)
-> (Target -> Target -> Target)
-> Ord Target
Target -> Target -> Bool
Target -> Target -> Ordering
Target -> Target -> Target
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Target -> Target -> Ordering
compare :: Target -> Target -> Ordering
$c< :: Target -> Target -> Bool
< :: Target -> Target -> Bool
$c<= :: Target -> Target -> Bool
<= :: Target -> Target -> Bool
$c> :: Target -> Target -> Bool
> :: Target -> Target -> Bool
$c>= :: Target -> Target -> Bool
>= :: Target -> Target -> Bool
$cmax :: Target -> Target -> Target
max :: Target -> Target -> Target
$cmin :: Target -> Target -> Target
min :: Target -> Target -> Target
Ord, Int -> Target -> ShowS
[Target] -> ShowS
Target -> String
(Int -> Target -> ShowS)
-> (Target -> String) -> ([Target] -> ShowS) -> Show Target
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Target -> ShowS
showsPrec :: Int -> Target -> ShowS
$cshow :: Target -> String
show :: Target -> String
$cshowList :: [Target] -> ShowS
showList :: [Target] -> ShowS
Show)

resolveAddr :: HostPort -> IO NS.SockAddr
resolveAddr :: HostPort -> IO SockAddr
resolveAddr hp :: HostPort
hp@(HostPort Maybe String
host Int
port) = do
  [AddrInfo]
infos <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
NS.getAddrInfo Maybe AddrInfo
forall a. Maybe a
Nothing Maybe String
host (String -> Maybe String
forall a. a -> Maybe a
Just (Int -> String
forall a. Show a => a -> String
show Int
port))
  case [AddrInfo]
infos of
    [] -> String -> IO SockAddr
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Could not resolve address: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ HostPort -> String
forall a. Show a => a -> String
show HostPort
hp)
    AddrInfo
info : [AddrInfo]
_ -> SockAddr -> IO SockAddr
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AddrInfo -> SockAddr
NS.addrAddress AddrInfo
info)

targetResolve :: Target -> IO NS.AddrInfo
targetResolve :: Target -> IO AddrInfo
targetResolve (Target hp :: HostPort
hp@(HostPort Maybe String
host Int
port) SockTy
sockTy Role
role) = do
  let hints :: AddrInfo
hints =
        AddrInfo
NS.defaultHints
          { NS.addrSocketType = sockTyReal sockTy
          , NS.addrFlags = [NS.AI_PASSIVE | role == RoleServer]
          }
  [AddrInfo]
infos <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
NS.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))
  case [AddrInfo]
infos of
    [] -> String -> IO AddrInfo
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Could not resolve address: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ HostPort -> String
forall a. Show a => a -> String
show HostPort
hp)
    AddrInfo
info : [AddrInfo]
_ -> AddrInfo -> IO AddrInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AddrInfo
info

targetOpen :: Target -> IO (NS.Socket, NS.SockAddr)
targetOpen :: Target -> IO (Socket, SockAddr)
targetOpen Target
t = do
  AddrInfo
info <- Target -> IO AddrInfo
targetResolve Target
t
  Socket
sock <- AddrInfo -> IO Socket
NS.openSocket AddrInfo
info
  (Socket, SockAddr) -> IO (Socket, SockAddr)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Socket
sock, AddrInfo -> SockAddr
NS.addrAddress AddrInfo
info)

targetConnect :: Target -> IO (NS.Socket, NS.SockAddr)
targetConnect :: Target -> IO (Socket, SockAddr)
targetConnect Target
t = do
  p :: (Socket, SockAddr)
p@(Socket
sock, SockAddr
addr) <- Target -> IO (Socket, SockAddr)
targetOpen Target
t
  Socket -> SockAddr -> IO ()
NS.connect Socket
sock SockAddr
addr
  (Socket, SockAddr) -> IO (Socket, SockAddr)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Socket, SockAddr)
p

targetBind :: Target -> IO NS.Socket
targetBind :: Target -> IO Socket
targetBind Target
t = do
  (Socket
sock, SockAddr
addr) <- Target -> IO (Socket, SockAddr)
targetOpen Target
t
  Socket -> SocketOption -> Int -> IO ()
NS.setSocketOption Socket
sock SocketOption
NS.ReuseAddr Int
1
  Socket -> (CInt -> IO ()) -> IO ()
forall r. Socket -> (CInt -> IO r) -> IO r
NS.withFdSocket Socket
sock CInt -> IO ()
NS.setCloseOnExecIfNeeded
  Socket -> SockAddr -> IO ()
NS.bind Socket
sock SockAddr
addr
  Socket -> IO Socket
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Socket
sock

tcpClientSock :: HostPort -> TcpOpts -> Acquire (NS.SockAddr, NS.Socket)
tcpClientSock :: HostPort -> TcpOpts -> Acquire (SockAddr, Socket)
tcpClientSock HostPort
hp (TcpOpts Int
finTo) = IO (SockAddr, Socket)
-> ((SockAddr, Socket) -> IO ()) -> Acquire (SockAddr, Socket)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire IO (SockAddr, Socket)
acq (SockAddr, Socket) -> IO ()
rel
 where
  acq :: IO (SockAddr, Socket)
acq = ((Socket, SockAddr) -> (SockAddr, Socket))
-> IO (Socket, SockAddr) -> IO (SockAddr, Socket)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Socket, SockAddr) -> (SockAddr, Socket)
forall a b. (a, b) -> (b, a)
swap (Target -> IO (Socket, SockAddr)
targetConnect (HostPort -> SockTy -> Role -> Target
Target HostPort
hp SockTy
SockTyTcp Role
RoleClient))
  rel :: (SockAddr, Socket) -> IO ()
rel (SockAddr
_, Socket
sock) = if Int
finTo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Socket -> Int -> IO ()
NS.gracefulClose Socket
sock Int
finTo else Socket -> IO ()
NS.close Socket
sock

tcpClientConn :: Maybe ByteCount -> HostPort -> TcpOpts -> Acquire (NS.SockAddr, Conn ())
tcpClientConn :: Maybe ByteCount
-> HostPort -> TcpOpts -> Acquire (SockAddr, Conn ())
tcpClientConn Maybe ByteCount
mayLim HostPort
hp TcpOpts
to = do
  (SockAddr
addr, Socket
sock) <- HostPort -> TcpOpts -> Acquire (SockAddr, Socket)
tcpClientSock HostPort
hp TcpOpts
to
  Decoder ()
dec <- IO (Decoder ()) -> Acquire (Decoder ())
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Maybe ByteCount -> Socket -> IO (Decoder ())
streamDecoder Maybe ByteCount
mayLim Socket
sock)
  let enc :: Encoder ()
enc = Socket -> Encoder ()
streamEncoder Socket
sock
  (SockAddr, Conn ()) -> Acquire (SockAddr, Conn ())
forall a. a -> Acquire a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SockAddr
addr, Decoder () -> Encoder () -> Conn ()
forall k. Decoder k -> Encoder k -> Conn k
Conn Decoder ()
dec Encoder ()
enc)

withTcpClientConn
  :: (MonadUnliftIO m) => Maybe ByteCount -> HostPort -> TcpOpts -> (NS.SockAddr -> Conn () -> m a) -> m a
withTcpClientConn :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Maybe ByteCount
-> HostPort -> TcpOpts -> (SockAddr -> Conn () -> m a) -> m a
withTcpClientConn Maybe ByteCount
mayLim HostPort
hp TcpOpts
to = Acquire (SockAddr, Conn ()) -> ((SockAddr, Conn ()) -> m a) -> m a
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Acquire a -> (a -> m b) -> m b
withAcquire (Maybe ByteCount
-> HostPort -> TcpOpts -> Acquire (SockAddr, Conn ())
tcpClientConn Maybe ByteCount
mayLim HostPort
hp TcpOpts
to) (((SockAddr, Conn ()) -> m a) -> m a)
-> ((SockAddr -> Conn () -> m a) -> (SockAddr, Conn ()) -> m a)
-> (SockAddr -> Conn () -> m a)
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SockAddr -> Conn () -> m a) -> (SockAddr, Conn ()) -> m a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry

tcpServerSock :: HostPort -> Acquire NS.Socket
tcpServerSock :: HostPort -> Acquire Socket
tcpServerSock HostPort
hp = IO Socket -> (Socket -> IO ()) -> Acquire Socket
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire IO Socket
acq Socket -> IO ()
rel
 where
  acq :: IO Socket
acq = do
    Socket
sock <- Target -> IO Socket
targetBind (HostPort -> SockTy -> Role -> Target
Target HostPort
hp SockTy
SockTyTcp Role
RoleServer)
    Socket -> Int -> IO ()
NS.listen Socket
sock Int
maxQueue
    Socket -> IO Socket
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Socket
sock
  rel :: Socket -> IO ()
rel = Socket -> IO ()
NS.close

tcpServerConn :: Maybe ByteCount -> HostPort -> TcpOpts -> Acquire (Acquire (NS.SockAddr, Conn ()))
tcpServerConn :: Maybe ByteCount
-> HostPort -> TcpOpts -> Acquire (Acquire (SockAddr, Conn ()))
tcpServerConn Maybe ByteCount
mayLim HostPort
hp TcpOpts
to = do
  Socket
srvSock <- HostPort -> Acquire Socket
tcpServerSock HostPort
hp
  Acquire (SockAddr, Conn ())
-> Acquire (Acquire (SockAddr, Conn ()))
forall a. a -> Acquire a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Acquire (SockAddr, Conn ())
 -> Acquire (Acquire (SockAddr, Conn ())))
-> Acquire (SockAddr, Conn ())
-> Acquire (Acquire (SockAddr, Conn ()))
forall a b. (a -> b) -> a -> b
$ do
    (SockAddr
addr, Socket
cliSock) <- TcpOpts -> Socket -> Acquire (SockAddr, Socket)
tcpAcceptSock TcpOpts
to Socket
srvSock
    Decoder ()
dec <- IO (Decoder ()) -> Acquire (Decoder ())
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Maybe ByteCount -> Socket -> IO (Decoder ())
streamDecoder Maybe ByteCount
mayLim Socket
cliSock)
    let enc :: Encoder ()
enc = Socket -> Encoder ()
streamEncoder Socket
cliSock
    (SockAddr, Conn ()) -> Acquire (SockAddr, Conn ())
forall a. a -> Acquire a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SockAddr
addr, Decoder () -> Encoder () -> Conn ()
forall k. Decoder k -> Encoder k -> Conn k
Conn Decoder ()
dec Encoder ()
enc)

tcpAcceptSock :: TcpOpts -> NS.Socket -> Acquire (NS.SockAddr, NS.Socket)
tcpAcceptSock :: TcpOpts -> Socket -> Acquire (SockAddr, Socket)
tcpAcceptSock (TcpOpts Int
finTo) Socket
servSock = IO (SockAddr, Socket)
-> ((SockAddr, Socket) -> IO ()) -> Acquire (SockAddr, Socket)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire IO (SockAddr, Socket)
acq (SockAddr, Socket) -> IO ()
rel
 where
  acq :: IO (SockAddr, Socket)
acq = ((Socket, SockAddr) -> (SockAddr, Socket))
-> IO (Socket, SockAddr) -> IO (SockAddr, Socket)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Socket, SockAddr) -> (SockAddr, Socket)
forall a b. (a, b) -> (b, a)
swap (Socket -> IO (Socket, SockAddr)
NS.accept Socket
servSock)
  rel :: (SockAddr, Socket) -> IO ()
rel (SockAddr
_, Socket
sock) = if Int
finTo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Socket -> Int -> IO ()
NS.gracefulClose Socket
sock Int
finTo else Socket -> IO ()
NS.close Socket
sock

udpClientSock :: HostPort -> Acquire (NS.SockAddr, NS.Socket)
udpClientSock :: HostPort -> Acquire (SockAddr, Socket)
udpClientSock HostPort
hp = IO (SockAddr, Socket)
-> ((SockAddr, Socket) -> IO ()) -> Acquire (SockAddr, Socket)
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire IO (SockAddr, Socket)
acq (SockAddr, Socket) -> IO ()
forall {a}. (a, Socket) -> IO ()
rel
 where
  acq :: IO (SockAddr, Socket)
acq = ((Socket, SockAddr) -> (SockAddr, Socket))
-> IO (Socket, SockAddr) -> IO (SockAddr, Socket)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Socket, SockAddr) -> (SockAddr, Socket)
forall a b. (a, b) -> (b, a)
swap (Target -> IO (Socket, SockAddr)
targetConnect (HostPort -> SockTy -> Role -> Target
Target HostPort
hp SockTy
SockTyUdp Role
RoleClient))
  rel :: (a, Socket) -> IO ()
rel = Socket -> IO ()
NS.close (Socket -> IO ())
-> ((a, Socket) -> Socket) -> (a, Socket) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Socket) -> Socket
forall a b. (a, b) -> b
snd

udpClientConn :: Maybe ByteCount -> HostPort -> Acquire (NS.SockAddr, Conn ())
udpClientConn :: Maybe ByteCount -> HostPort -> Acquire (SockAddr, Conn ())
udpClientConn Maybe ByteCount
mayLim HostPort
hp = do
  (SockAddr
addr, Socket
sock) <- HostPort -> Acquire (SockAddr, Socket)
udpClientSock HostPort
hp
  let dec :: Decoder ()
dec = Maybe ByteCount -> Socket -> Decoder ()
datagramClientDecoder Maybe ByteCount
mayLim Socket
sock
      enc :: Encoder ()
enc = Socket -> Encoder ()
datagramClientEncoder Socket
sock
  (SockAddr, Conn ()) -> Acquire (SockAddr, Conn ())
forall a. a -> Acquire a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SockAddr
addr, Decoder () -> Encoder () -> Conn ()
forall k. Decoder k -> Encoder k -> Conn k
Conn Decoder ()
dec Encoder ()
enc)

withUdpClientConn :: (MonadUnliftIO m) => Maybe ByteCount -> HostPort -> (NS.SockAddr -> Conn () -> m a) -> m a
withUdpClientConn :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Maybe ByteCount -> HostPort -> (SockAddr -> Conn () -> m a) -> m a
withUdpClientConn Maybe ByteCount
mayLim HostPort
hp = Acquire (SockAddr, Conn ()) -> ((SockAddr, Conn ()) -> m a) -> m a
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Acquire a -> (a -> m b) -> m b
withAcquire (Maybe ByteCount -> HostPort -> Acquire (SockAddr, Conn ())
udpClientConn Maybe ByteCount
mayLim HostPort
hp) (((SockAddr, Conn ()) -> m a) -> m a)
-> ((SockAddr -> Conn () -> m a) -> (SockAddr, Conn ()) -> m a)
-> (SockAddr -> Conn () -> m a)
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SockAddr -> Conn () -> m a) -> (SockAddr, Conn ()) -> m a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry

udpServerSock :: HostPort -> Acquire NS.Socket
udpServerSock :: HostPort -> Acquire Socket
udpServerSock HostPort
hp = IO Socket -> (Socket -> IO ()) -> Acquire Socket
forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire IO Socket
acq Socket -> IO ()
rel
 where
  acq :: IO Socket
acq = Target -> IO Socket
targetBind (HostPort -> SockTy -> Role -> Target
Target HostPort
hp SockTy
SockTyUdp Role
RoleServer)
  rel :: Socket -> IO ()
rel = Socket -> IO ()
NS.close

udpServerConn :: Maybe ByteCount -> HostPort -> Acquire (Conn NS.SockAddr)
udpServerConn :: Maybe ByteCount -> HostPort -> Acquire (Conn SockAddr)
udpServerConn Maybe ByteCount
mayLim HostPort
hp = do
  Socket
sock <- HostPort -> Acquire Socket
udpServerSock HostPort
hp
  let dec :: Decoder SockAddr
dec = Maybe ByteCount -> Socket -> Decoder SockAddr
datagramServerDecoder Maybe ByteCount
mayLim Socket
sock
      enc :: Encoder SockAddr
enc = Socket -> Encoder SockAddr
datagramServerEncoder Socket
sock
  Conn SockAddr -> Acquire (Conn SockAddr)
forall a. a -> Acquire a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Decoder SockAddr -> Encoder SockAddr -> Conn SockAddr
forall k. Decoder k -> Encoder k -> Conn k
Conn Decoder SockAddr
dec Encoder SockAddr
enc)

withUdpServerConn :: (MonadUnliftIO m) => Maybe ByteCount -> HostPort -> (Conn NS.SockAddr -> m a) -> m a
withUdpServerConn :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Maybe ByteCount -> HostPort -> (Conn SockAddr -> m a) -> m a
withUdpServerConn Maybe ByteCount
mayLim HostPort
hp = Acquire (Conn SockAddr) -> (Conn SockAddr -> m a) -> m a
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Acquire a -> (a -> m b) -> m b
withAcquire (Maybe ByteCount -> HostPort -> Acquire (Conn SockAddr)
udpServerConn Maybe ByteCount
mayLim HostPort
hp)