{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Ouroboros.Network.Snocket
(
Accept (..)
, AddressFamily (..)
, Snocket (..)
, SocketSnocket
, socketSnocket
, LocalSnocket
, localSnocket
, LocalSocket (..)
, LocalAddress (..)
, localAddressFromPath
, FileDescriptor
, socketFileDescriptor
, localSocketFileDescriptor
) where
import Control.Exception
import Control.Monad (when)
import Control.Monad.Class.MonadTime (DiffTime)
import Control.Tracer (Tracer)
import Data.Bifunctor (Bifunctor (..))
import Data.Hashable
import GHC.Generics (Generic)
import Quiet (Quiet (..))
#if !defined(mingw32_HOST_OS)
import Network.Socket ( Family (AF_UNIX) )
#endif
import Network.Socket ( Socket
, SockAddr (..)
)
import qualified Network.Socket as Socket
#if defined(mingw32_HOST_OS)
import Data.Bits
import Foreign.Ptr (IntPtr (..), ptrToIntPtr)
import qualified System.Win32 as Win32
import qualified System.Win32.NamedPipes as Win32
import qualified System.Win32.Async as Win32.Async
import Network.Mux.Bearer.NamedPipe (namedPipeAsBearer)
#endif
import Network.Mux.Types (MuxBearer)
import Network.Mux.Trace (MuxTrace)
import qualified Network.Mux.Bearer.Socket as Mx
import Ouroboros.Network.IOManager
newtype Accept m fd addr = Accept
{ Accept m fd addr -> m (fd, addr, Accept m fd addr)
runAccept :: m (fd, addr, Accept m fd addr)
}
instance Functor m => Bifunctor (Accept m) where
bimap :: (a -> b) -> (c -> d) -> Accept m a c -> Accept m b d
bimap a -> b
f c -> d
g Accept m a c
ac = m (b, d, Accept m b d) -> Accept m b d
forall (m :: * -> *) fd addr.
m (fd, addr, Accept m fd addr) -> Accept m fd addr
Accept (m (b, d, Accept m b d) -> Accept m b d)
-> m (b, d, Accept m b d) -> Accept m b d
forall a b. (a -> b) -> a -> b
$ (a, c, Accept m a c) -> (b, d, Accept m b d)
h ((a, c, Accept m a c) -> (b, d, Accept m b d))
-> m (a, c, Accept m a c) -> m (b, d, Accept m b d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Accept m a c -> m (a, c, Accept m a c)
forall (m :: * -> *) fd addr.
Accept m fd addr -> m (fd, addr, Accept m fd addr)
runAccept Accept m a c
ac
where
h :: (a, c, Accept m a c) -> (b, d, Accept m b d)
h (a
fd, c
addr, Accept m a c
next) = (a -> b
f a
fd, c -> d
g c
addr, (a -> b) -> (c -> d) -> Accept m a c -> Accept m b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g Accept m a c
next)
berkeleyAccept :: IOManager
-> Socket
-> Accept IO Socket SockAddr
berkeleyAccept :: IOManager -> Socket -> Accept IO Socket SockAddr
berkeleyAccept IOManager
ioManager Socket
sock = Accept IO Socket SockAddr
go
where
go :: Accept IO Socket SockAddr
go = IO (Socket, SockAddr, Accept IO Socket SockAddr)
-> Accept IO Socket SockAddr
forall (m :: * -> *) fd addr.
m (fd, addr, Accept m fd addr) -> Accept m fd addr
Accept (IO (Socket, SockAddr, Accept IO Socket SockAddr)
-> Accept IO Socket SockAddr)
-> IO (Socket, SockAddr, Accept IO Socket SockAddr)
-> Accept IO Socket SockAddr
forall a b. (a -> b) -> a -> b
$ do
(Socket
sock', SockAddr
addr') <-
#if !defined(mingw32_HOST_OS)
Socket -> IO (Socket, SockAddr)
Socket.accept Socket
sock
#else
Win32.Async.accept sock
#endif
IOManager -> Either Any Socket -> IO ()
IOManager -> forall hole. hole -> IO ()
associateWithIOManager IOManager
ioManager (Socket -> Either Any Socket
forall a b. b -> Either a b
Right Socket
sock')
IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOException
e :: IOException) -> do
Socket -> IO ()
Socket.close Socket
sock'
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO IOException
e
IO () -> (SomeAsyncException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(SomeAsyncException e
_) -> do
Socket -> IO ()
Socket.close Socket
sock'
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO IOException
e
(Socket, SockAddr, Accept IO Socket SockAddr)
-> IO (Socket, SockAddr, Accept IO Socket SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Socket
sock', SockAddr
addr', Accept IO Socket SockAddr
go)
newtype LocalAddress = LocalAddress { LocalAddress -> FilePath
getFilePath :: FilePath }
deriving (LocalAddress -> LocalAddress -> Bool
(LocalAddress -> LocalAddress -> Bool)
-> (LocalAddress -> LocalAddress -> Bool) -> Eq LocalAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocalAddress -> LocalAddress -> Bool
$c/= :: LocalAddress -> LocalAddress -> Bool
== :: LocalAddress -> LocalAddress -> Bool
$c== :: LocalAddress -> LocalAddress -> Bool
Eq, Eq LocalAddress
Eq LocalAddress
-> (LocalAddress -> LocalAddress -> Ordering)
-> (LocalAddress -> LocalAddress -> Bool)
-> (LocalAddress -> LocalAddress -> Bool)
-> (LocalAddress -> LocalAddress -> Bool)
-> (LocalAddress -> LocalAddress -> Bool)
-> (LocalAddress -> LocalAddress -> LocalAddress)
-> (LocalAddress -> LocalAddress -> LocalAddress)
-> Ord LocalAddress
LocalAddress -> LocalAddress -> Bool
LocalAddress -> LocalAddress -> Ordering
LocalAddress -> LocalAddress -> LocalAddress
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
min :: LocalAddress -> LocalAddress -> LocalAddress
$cmin :: LocalAddress -> LocalAddress -> LocalAddress
max :: LocalAddress -> LocalAddress -> LocalAddress
$cmax :: LocalAddress -> LocalAddress -> LocalAddress
>= :: LocalAddress -> LocalAddress -> Bool
$c>= :: LocalAddress -> LocalAddress -> Bool
> :: LocalAddress -> LocalAddress -> Bool
$c> :: LocalAddress -> LocalAddress -> Bool
<= :: LocalAddress -> LocalAddress -> Bool
$c<= :: LocalAddress -> LocalAddress -> Bool
< :: LocalAddress -> LocalAddress -> Bool
$c< :: LocalAddress -> LocalAddress -> Bool
compare :: LocalAddress -> LocalAddress -> Ordering
$ccompare :: LocalAddress -> LocalAddress -> Ordering
$cp1Ord :: Eq LocalAddress
Ord, (forall x. LocalAddress -> Rep LocalAddress x)
-> (forall x. Rep LocalAddress x -> LocalAddress)
-> Generic LocalAddress
forall x. Rep LocalAddress x -> LocalAddress
forall x. LocalAddress -> Rep LocalAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LocalAddress x -> LocalAddress
$cfrom :: forall x. LocalAddress -> Rep LocalAddress x
Generic)
deriving Int -> LocalAddress -> ShowS
[LocalAddress] -> ShowS
LocalAddress -> FilePath
(Int -> LocalAddress -> ShowS)
-> (LocalAddress -> FilePath)
-> ([LocalAddress] -> ShowS)
-> Show LocalAddress
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [LocalAddress] -> ShowS
$cshowList :: [LocalAddress] -> ShowS
show :: LocalAddress -> FilePath
$cshow :: LocalAddress -> FilePath
showsPrec :: Int -> LocalAddress -> ShowS
$cshowsPrec :: Int -> LocalAddress -> ShowS
Show via Quiet LocalAddress
instance Hashable LocalAddress where
hashWithSalt :: Int -> LocalAddress -> Int
hashWithSalt Int
s (LocalAddress FilePath
path) = Int -> FilePath -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s FilePath
path
data AddressFamily addr where
SocketFamily :: !Socket.Family
-> AddressFamily Socket.SockAddr
LocalFamily :: AddressFamily LocalAddress
instance Eq (AddressFamily addr) where
SocketFamily Family
fam0 == :: AddressFamily addr -> AddressFamily addr -> Bool
== SocketFamily Family
fam1 = Family
fam0 Family -> Family -> Bool
forall a. Eq a => a -> a -> Bool
== Family
fam1
AddressFamily addr
LocalFamily == AddressFamily addr
LocalFamily = Bool
True
instance Show (AddressFamily addr) where
show :: AddressFamily addr -> FilePath
show (SocketFamily Family
fam) = Family -> FilePath
forall a. Show a => a -> FilePath
show Family
fam
show AddressFamily addr
LocalFamily = FilePath
"LocalFamily"
data Snocket m fd addr = Snocket {
Snocket m fd addr -> fd -> m addr
getLocalAddr :: fd -> m addr
, Snocket m fd addr -> fd -> m addr
getRemoteAddr :: fd -> m addr
, Snocket m fd addr -> addr -> AddressFamily addr
addrFamily :: addr -> AddressFamily addr
, Snocket m fd addr -> AddressFamily addr -> m fd
open :: AddressFamily addr -> m fd
, Snocket m fd addr -> addr -> m fd
openToConnect :: addr -> m fd
, Snocket m fd addr -> fd -> addr -> m ()
connect :: fd -> addr -> m ()
, Snocket m fd addr -> fd -> addr -> m ()
bind :: fd -> addr -> m ()
, Snocket m fd addr -> fd -> m ()
listen :: fd -> m ()
, Snocket m fd addr -> fd -> Accept m fd addr
accept :: fd -> Accept m fd addr
, Snocket m fd addr -> fd -> m ()
close :: fd -> m ()
, Snocket m fd addr
-> DiffTime -> Tracer m MuxTrace -> fd -> MuxBearer m
toBearer :: DiffTime -> Tracer m MuxTrace -> fd -> MuxBearer m
}
socketAddrFamily
:: Socket.SockAddr
-> AddressFamily Socket.SockAddr
socketAddrFamily :: SockAddr -> AddressFamily SockAddr
socketAddrFamily (Socket.SockAddrInet PortNumber
_ HostAddress
_ ) = Family -> AddressFamily SockAddr
SocketFamily Family
Socket.AF_INET
socketAddrFamily (Socket.SockAddrInet6 PortNumber
_ HostAddress
_ HostAddress6
_ HostAddress
_) = Family -> AddressFamily SockAddr
SocketFamily Family
Socket.AF_INET6
socketAddrFamily (Socket.SockAddrUnix FilePath
_ ) = Family -> AddressFamily SockAddr
SocketFamily Family
Socket.AF_UNIX
type SocketSnocket = Snocket IO Socket SockAddr
socketSnocket
:: IOManager
-> SocketSnocket
socketSnocket :: IOManager -> SocketSnocket
socketSnocket IOManager
ioManager = Snocket :: forall (m :: * -> *) fd addr.
(fd -> m addr)
-> (fd -> m addr)
-> (addr -> AddressFamily addr)
-> (AddressFamily addr -> m fd)
-> (addr -> m fd)
-> (fd -> addr -> m ())
-> (fd -> addr -> m ())
-> (fd -> m ())
-> (fd -> Accept m fd addr)
-> (fd -> m ())
-> (DiffTime -> Tracer m MuxTrace -> fd -> MuxBearer m)
-> Snocket m fd addr
Snocket {
getLocalAddr :: Socket -> IO SockAddr
getLocalAddr = Socket -> IO SockAddr
Socket.getSocketName
, getRemoteAddr :: Socket -> IO SockAddr
getRemoteAddr = Socket -> IO SockAddr
Socket.getPeerName
, addrFamily :: SockAddr -> AddressFamily SockAddr
addrFamily = SockAddr -> AddressFamily SockAddr
socketAddrFamily
, open :: AddressFamily SockAddr -> IO Socket
open = AddressFamily SockAddr -> IO Socket
openSocket
, openToConnect :: SockAddr -> IO Socket
openToConnect = \SockAddr
addr -> AddressFamily SockAddr -> IO Socket
openSocket (SockAddr -> AddressFamily SockAddr
socketAddrFamily SockAddr
addr)
, connect :: Socket -> SockAddr -> IO ()
connect = \Socket
s SockAddr
a -> do
#if !defined(mingw32_HOST_OS)
Socket -> SockAddr -> IO ()
Socket.connect Socket
s SockAddr
a
#else
Win32.Async.connect s a
#endif
, bind :: Socket -> SockAddr -> IO ()
bind = \Socket
sd SockAddr
addr -> do
let SocketFamily Family
fml = SockAddr -> AddressFamily SockAddr
socketAddrFamily SockAddr
addr
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Family
fml Family -> Family -> Bool
forall a. Eq a => a -> a -> Bool
== Family
Socket.AF_INET Bool -> Bool -> Bool
||
Family
fml Family -> Family -> Bool
forall a. Eq a => a -> a -> Bool
== Family
Socket.AF_INET6) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Socket -> SocketOption -> Int -> IO ()
Socket.setSocketOption Socket
sd SocketOption
Socket.ReuseAddr Int
1
#if !defined(mingw32_HOST_OS)
Socket -> SocketOption -> Int -> IO ()
Socket.setSocketOption Socket
sd SocketOption
Socket.ReusePort Int
1
#endif
Socket -> SocketOption -> Int -> IO ()
Socket.setSocketOption Socket
sd SocketOption
Socket.NoDelay Int
1
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Family
fml Family -> Family -> Bool
forall a. Eq a => a -> a -> Bool
== Family
Socket.AF_INET6)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Socket -> SocketOption -> Int -> IO ()
Socket.setSocketOption Socket
sd SocketOption
Socket.IPv6Only Int
1
Socket -> SockAddr -> IO ()
Socket.bind Socket
sd SockAddr
addr
, listen :: Socket -> IO ()
listen = \Socket
s -> Socket -> Int -> IO ()
Socket.listen Socket
s Int
8
, accept :: Socket -> Accept IO Socket SockAddr
accept = IOManager -> Socket -> Accept IO Socket SockAddr
berkeleyAccept IOManager
ioManager
, close :: Socket -> IO ()
close = Socket -> IO ()
Socket.close
, toBearer :: DiffTime -> Tracer IO MuxTrace -> Socket -> MuxBearer IO
toBearer = DiffTime -> Tracer IO MuxTrace -> Socket -> MuxBearer IO
Mx.socketAsMuxBearer
}
where
openSocket :: AddressFamily SockAddr -> IO Socket
openSocket :: AddressFamily SockAddr -> IO Socket
openSocket (SocketFamily Family
family_) = do
Socket
sd <- Family -> SocketType -> ProtocolNumber -> IO Socket
Socket.socket Family
family_ SocketType
Socket.Stream ProtocolNumber
Socket.defaultProtocol
IOManager -> Either Any Socket -> IO ()
IOManager -> forall hole. hole -> IO ()
associateWithIOManager IOManager
ioManager (Socket -> Either Any Socket
forall a b. b -> Either a b
Right Socket
sd)
IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOException
e :: IOException) -> do
Socket -> IO ()
Socket.close Socket
sd
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO IOException
e
IO () -> (SomeAsyncException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(SomeAsyncException e
_) -> do
Socket -> IO ()
Socket.close Socket
sd
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO IOException
e
Socket -> IO Socket
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sd
#if defined(mingw32_HOST_OS)
type LocalHandle = Win32.HANDLE
#else
type LocalHandle = Socket
#endif
newtype LocalSocket = LocalSocket { LocalSocket -> Socket
getLocalHandle :: LocalHandle }
deriving (LocalSocket -> LocalSocket -> Bool
(LocalSocket -> LocalSocket -> Bool)
-> (LocalSocket -> LocalSocket -> Bool) -> Eq LocalSocket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocalSocket -> LocalSocket -> Bool
$c/= :: LocalSocket -> LocalSocket -> Bool
== :: LocalSocket -> LocalSocket -> Bool
$c== :: LocalSocket -> LocalSocket -> Bool
Eq, (forall x. LocalSocket -> Rep LocalSocket x)
-> (forall x. Rep LocalSocket x -> LocalSocket)
-> Generic LocalSocket
forall x. Rep LocalSocket x -> LocalSocket
forall x. LocalSocket -> Rep LocalSocket x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LocalSocket x -> LocalSocket
$cfrom :: forall x. LocalSocket -> Rep LocalSocket x
Generic)
deriving Int -> LocalSocket -> ShowS
[LocalSocket] -> ShowS
LocalSocket -> FilePath
(Int -> LocalSocket -> ShowS)
-> (LocalSocket -> FilePath)
-> ([LocalSocket] -> ShowS)
-> Show LocalSocket
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [LocalSocket] -> ShowS
$cshowList :: [LocalSocket] -> ShowS
show :: LocalSocket -> FilePath
$cshow :: LocalSocket -> FilePath
showsPrec :: Int -> LocalSocket -> ShowS
$cshowsPrec :: Int -> LocalSocket -> ShowS
Show via Quiet LocalSocket
type LocalSnocket = Snocket IO LocalSocket LocalAddress
localSnocket :: IOManager -> FilePath -> LocalSnocket
#if defined(mingw32_HOST_OS)
localSnocket ioManager path = Snocket {
getLocalAddr = \_ -> return localAddress
, getRemoteAddr = \_ -> return localAddress
, addrFamily = \_ -> LocalFamily
, open = \_addrFamily -> do
hpipe <- Win32.createNamedPipe
path
(Win32.pIPE_ACCESS_DUPLEX .|. Win32.fILE_FLAG_OVERLAPPED)
(Win32.pIPE_TYPE_BYTE .|. Win32.pIPE_READMODE_BYTE)
Win32.pIPE_UNLIMITED_INSTANCES
65536
16384
0
Nothing
associateWithIOManager ioManager (Left hpipe)
`catch` \(e :: IOException) -> do
Win32.closeHandle hpipe
throwIO e
`catch` \(SomeAsyncException _) -> do
Win32.closeHandle hpipe
throwIO e
pure (LocalSocket hpipe)
, openToConnect = \(LocalAddress pipeName) -> do
hpipe <- Win32.connect pipeName
(Win32.gENERIC_READ .|. Win32.gENERIC_WRITE )
Win32.fILE_SHARE_NONE
Nothing
Win32.oPEN_EXISTING
Win32.fILE_FLAG_OVERLAPPED
Nothing
associateWithIOManager ioManager (Left hpipe)
`catch` \(e :: IOException) -> do
Win32.closeHandle hpipe
throwIO e
`catch` \(SomeAsyncException _) -> do
Win32.closeHandle hpipe
throwIO e
return (LocalSocket hpipe)
, connect = \_ _ -> pure ()
, bind = \_ _ -> pure ()
, listen = \_ -> pure ()
, accept = \sock@(LocalSocket hpipe) -> Accept $ do
Win32.Async.connectNamedPipe hpipe
return (sock, localAddress, acceptNext)
, close = Win32.closeHandle . getLocalHandle
, toBearer = \_sduTimeout tr -> namedPipeAsBearer tr . getLocalHandle
}
where
localAddress :: LocalAddress
localAddress = LocalAddress path
acceptNext :: Accept IO LocalSocket LocalAddress
acceptNext = Accept $ do
hpipe <- Win32.createNamedPipe
path
(Win32.pIPE_ACCESS_DUPLEX .|. Win32.fILE_FLAG_OVERLAPPED)
(Win32.pIPE_TYPE_BYTE .|. Win32.pIPE_READMODE_BYTE)
Win32.pIPE_UNLIMITED_INSTANCES
65536
16384
0
Nothing
associateWithIOManager ioManager (Left hpipe)
Win32.Async.connectNamedPipe hpipe
return (LocalSocket hpipe, localAddress, acceptNext)
#else
localSnocket :: IOManager -> FilePath -> LocalSnocket
localSnocket IOManager
ioManager FilePath
_ =
Snocket :: forall (m :: * -> *) fd addr.
(fd -> m addr)
-> (fd -> m addr)
-> (addr -> AddressFamily addr)
-> (AddressFamily addr -> m fd)
-> (addr -> m fd)
-> (fd -> addr -> m ())
-> (fd -> addr -> m ())
-> (fd -> m ())
-> (fd -> Accept m fd addr)
-> (fd -> m ())
-> (DiffTime -> Tracer m MuxTrace -> fd -> MuxBearer m)
-> Snocket m fd addr
Snocket {
getLocalAddr :: LocalSocket -> IO LocalAddress
getLocalAddr = (SockAddr -> LocalAddress) -> IO SockAddr -> IO LocalAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SockAddr -> LocalAddress
toLocalAddress (IO SockAddr -> IO LocalAddress)
-> (LocalSocket -> IO SockAddr) -> LocalSocket -> IO LocalAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket -> IO SockAddr
Socket.getSocketName (Socket -> IO SockAddr)
-> (LocalSocket -> Socket) -> LocalSocket -> IO SockAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalSocket -> Socket
getLocalHandle
, getRemoteAddr :: LocalSocket -> IO LocalAddress
getRemoteAddr = (SockAddr -> LocalAddress) -> IO SockAddr -> IO LocalAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SockAddr -> LocalAddress
toLocalAddress (IO SockAddr -> IO LocalAddress)
-> (LocalSocket -> IO SockAddr) -> LocalSocket -> IO LocalAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket -> IO SockAddr
Socket.getPeerName (Socket -> IO SockAddr)
-> (LocalSocket -> Socket) -> LocalSocket -> IO SockAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalSocket -> Socket
getLocalHandle
, addrFamily :: LocalAddress -> AddressFamily LocalAddress
addrFamily = AddressFamily LocalAddress
-> LocalAddress -> AddressFamily LocalAddress
forall a b. a -> b -> a
const AddressFamily LocalAddress
LocalFamily
, connect :: LocalSocket -> LocalAddress -> IO ()
connect = \(LocalSocket Socket
s) LocalAddress
addr ->
Socket -> SockAddr -> IO ()
Socket.connect Socket
s (LocalAddress -> SockAddr
fromLocalAddress LocalAddress
addr)
, bind :: LocalSocket -> LocalAddress -> IO ()
bind = \(LocalSocket Socket
fd) LocalAddress
addr -> Socket -> SockAddr -> IO ()
Socket.bind Socket
fd (LocalAddress -> SockAddr
fromLocalAddress LocalAddress
addr)
, listen :: LocalSocket -> IO ()
listen = (Socket -> Int -> IO ()) -> Int -> Socket -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Socket -> Int -> IO ()
Socket.listen Int
1 (Socket -> IO ())
-> (LocalSocket -> Socket) -> LocalSocket -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalSocket -> Socket
getLocalHandle
, accept :: LocalSocket -> Accept IO LocalSocket LocalAddress
accept = (Socket -> LocalSocket)
-> (SockAddr -> LocalAddress)
-> Accept IO Socket SockAddr
-> Accept IO LocalSocket LocalAddress
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Socket -> LocalSocket
LocalSocket SockAddr -> LocalAddress
toLocalAddress
(Accept IO Socket SockAddr -> Accept IO LocalSocket LocalAddress)
-> (LocalSocket -> Accept IO Socket SockAddr)
-> LocalSocket
-> Accept IO LocalSocket LocalAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOManager -> Socket -> Accept IO Socket SockAddr
berkeleyAccept IOManager
ioManager
(Socket -> Accept IO Socket SockAddr)
-> (LocalSocket -> Socket)
-> LocalSocket
-> Accept IO Socket SockAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalSocket -> Socket
getLocalHandle
, open :: AddressFamily LocalAddress -> IO LocalSocket
open = AddressFamily LocalAddress -> IO LocalSocket
openSocket
, openToConnect :: LocalAddress -> IO LocalSocket
openToConnect = \LocalAddress
_addr -> AddressFamily LocalAddress -> IO LocalSocket
openSocket AddressFamily LocalAddress
LocalFamily
, close :: LocalSocket -> IO ()
close = Socket -> IO ()
Socket.close (Socket -> IO ())
-> (LocalSocket -> Socket) -> LocalSocket -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalSocket -> Socket
getLocalHandle
, toBearer :: DiffTime -> Tracer IO MuxTrace -> LocalSocket -> MuxBearer IO
toBearer = \DiffTime
df Tracer IO MuxTrace
tr (LocalSocket Socket
sd) -> DiffTime -> Tracer IO MuxTrace -> Socket -> MuxBearer IO
Mx.socketAsMuxBearer DiffTime
df Tracer IO MuxTrace
tr Socket
sd
}
where
toLocalAddress :: SockAddr -> LocalAddress
toLocalAddress :: SockAddr -> LocalAddress
toLocalAddress (SockAddrUnix FilePath
path) = FilePath -> LocalAddress
LocalAddress FilePath
path
toLocalAddress SockAddr
_ = FilePath -> LocalAddress
forall a. HasCallStack => FilePath -> a
error FilePath
"localSnocket.toLocalAddr: impossible happend"
fromLocalAddress :: LocalAddress -> SockAddr
fromLocalAddress :: LocalAddress -> SockAddr
fromLocalAddress = FilePath -> SockAddr
SockAddrUnix (FilePath -> SockAddr)
-> (LocalAddress -> FilePath) -> LocalAddress -> SockAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalAddress -> FilePath
getFilePath
openSocket :: AddressFamily LocalAddress -> IO LocalSocket
openSocket :: AddressFamily LocalAddress -> IO LocalSocket
openSocket AddressFamily LocalAddress
LocalFamily = do
Socket
sd <- Family -> SocketType -> ProtocolNumber -> IO Socket
Socket.socket Family
AF_UNIX SocketType
Socket.Stream ProtocolNumber
Socket.defaultProtocol
IOManager -> Either Any Socket -> IO ()
IOManager -> forall hole. hole -> IO ()
associateWithIOManager IOManager
ioManager (Socket -> Either Any Socket
forall a b. b -> Either a b
Right Socket
sd)
IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOException
e :: IOException) -> do
Socket -> IO ()
Socket.close Socket
sd
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO IOException
e
IO () -> (SomeAsyncException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(SomeAsyncException e
_) -> do
Socket -> IO ()
Socket.close Socket
sd
IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO IOException
e
LocalSocket -> IO LocalSocket
forall (m :: * -> *) a. Monad m => a -> m a
return (Socket -> LocalSocket
LocalSocket Socket
sd)
#endif
localAddressFromPath :: FilePath -> LocalAddress
localAddressFromPath :: FilePath -> LocalAddress
localAddressFromPath = FilePath -> LocalAddress
LocalAddress
newtype FileDescriptor = FileDescriptor { FileDescriptor -> Int
getFileDescriptor :: Int }
deriving (forall x. FileDescriptor -> Rep FileDescriptor x)
-> (forall x. Rep FileDescriptor x -> FileDescriptor)
-> Generic FileDescriptor
forall x. Rep FileDescriptor x -> FileDescriptor
forall x. FileDescriptor -> Rep FileDescriptor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FileDescriptor x -> FileDescriptor
$cfrom :: forall x. FileDescriptor -> Rep FileDescriptor x
Generic
deriving Int -> FileDescriptor -> ShowS
[FileDescriptor] -> ShowS
FileDescriptor -> FilePath
(Int -> FileDescriptor -> ShowS)
-> (FileDescriptor -> FilePath)
-> ([FileDescriptor] -> ShowS)
-> Show FileDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FileDescriptor] -> ShowS
$cshowList :: [FileDescriptor] -> ShowS
show :: FileDescriptor -> FilePath
$cshow :: FileDescriptor -> FilePath
showsPrec :: Int -> FileDescriptor -> ShowS
$cshowsPrec :: Int -> FileDescriptor -> ShowS
Show via Quiet FileDescriptor
socketFileDescriptor :: Socket -> IO FileDescriptor
socketFileDescriptor :: Socket -> IO FileDescriptor
socketFileDescriptor = (ProtocolNumber -> FileDescriptor)
-> IO ProtocolNumber -> IO FileDescriptor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> FileDescriptor
FileDescriptor (Int -> FileDescriptor)
-> (ProtocolNumber -> Int) -> ProtocolNumber -> FileDescriptor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO ProtocolNumber -> IO FileDescriptor)
-> (Socket -> IO ProtocolNumber) -> Socket -> IO FileDescriptor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket -> IO ProtocolNumber
Socket.unsafeFdSocket
localSocketFileDescriptor :: LocalSocket -> IO FileDescriptor
#if defined(mingw32_HOST_OS)
localSocketFileDescriptor =
\(LocalSocket fd) -> case ptrToIntPtr fd of
IntPtr i -> return (FileDescriptor i)
#else
localSocketFileDescriptor :: LocalSocket -> IO FileDescriptor
localSocketFileDescriptor = Socket -> IO FileDescriptor
socketFileDescriptor (Socket -> IO FileDescriptor)
-> (LocalSocket -> Socket) -> LocalSocket -> IO FileDescriptor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalSocket -> Socket
getLocalHandle
#endif