{-# LANGUAGE CPP #-}

#include "HsNetDef.h"

module Network.Socket.Name (
    getPeerName
  , getSocketName
  , socketPort
  , socketPortSafe
  ) where

import Foreign.Marshal.Utils (with)

import Network.Socket.Imports
import Network.Socket.Internal
import Network.Socket.Types

-- | Getting peer's socket address.
getPeerName :: SocketAddress sa => Socket -> IO sa
getPeerName :: forall sa. SocketAddress sa => Socket -> IO sa
getPeerName Socket
s =
 forall sa a. SocketAddress sa => (Ptr sa -> Int -> IO a) -> IO a
withNewSocketAddress forall a b. (a -> b) -> a -> b
$ \Ptr sa
ptr Int
sz ->
   forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz) forall a b. (a -> b) -> a -> b
$ \Ptr CInt
int_star -> forall r. Socket -> (CInt -> IO r) -> IO r
withFdSocket Socket
s forall a b. (a -> b) -> a -> b
$ \CInt
fd -> do
     forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwSocketErrorIfMinus1Retry_ String
"Network.Socket.getPeerName" forall a b. (a -> b) -> a -> b
$
       forall sa. CInt -> Ptr sa -> Ptr CInt -> IO CInt
c_getpeername CInt
fd Ptr sa
ptr Ptr CInt
int_star
     CInt
_sz <- forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
int_star
     forall sa. SocketAddress sa => Ptr sa -> IO sa
peekSocketAddress Ptr sa
ptr

-- | Getting my socket address.
getSocketName :: SocketAddress sa => Socket -> IO sa
getSocketName :: forall sa. SocketAddress sa => Socket -> IO sa
getSocketName Socket
s =
 forall sa a. SocketAddress sa => (Ptr sa -> Int -> IO a) -> IO a
withNewSocketAddress forall a b. (a -> b) -> a -> b
$ \Ptr sa
ptr Int
sz ->
   forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz) forall a b. (a -> b) -> a -> b
$ \Ptr CInt
int_star -> forall r. Socket -> (CInt -> IO r) -> IO r
withFdSocket Socket
s forall a b. (a -> b) -> a -> b
$ \CInt
fd -> do
     forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwSocketErrorIfMinus1Retry_ String
"Network.Socket.getSocketName" forall a b. (a -> b) -> a -> b
$
       forall sa. CInt -> Ptr sa -> Ptr CInt -> IO CInt
c_getsockname CInt
fd Ptr sa
ptr Ptr CInt
int_star
     forall sa. SocketAddress sa => Ptr sa -> IO sa
peekSocketAddress Ptr sa
ptr

foreign import CALLCONV unsafe "getpeername"
  c_getpeername :: CInt -> Ptr sa -> Ptr CInt -> IO CInt
foreign import CALLCONV unsafe "getsockname"
  c_getsockname :: CInt -> Ptr sa -> Ptr CInt -> IO CInt

-- ---------------------------------------------------------------------------
-- socketPort
--
-- The port number the given socket is currently connected to can be
-- determined by calling $port$, is generally only useful when bind
-- was given $aNY\_PORT$.

-- | Getting the port of socket.
--   `IOError` is thrown if a port is not available.
socketPort :: Socket            -- Connected & Bound Socket
           -> IO PortNumber     -- Port Number of Socket
socketPort :: Socket -> IO PortNumber
socketPort Socket
s = do
    SockAddr
sa <- forall sa. SocketAddress sa => Socket -> IO sa
getSocketName Socket
s
    case SockAddr
sa of
      SockAddrInet PortNumber
port HostAddress
_      -> forall (m :: * -> *) a. Monad m => a -> m a
return PortNumber
port
      SockAddrInet6 PortNumber
port HostAddress
_ HostAddress6
_ HostAddress
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return PortNumber
port
      SockAddr
_                        -> forall a. IOError -> IO a
ioError forall a b. (a -> b) -> a -> b
$ String -> IOError
userError String
"Network.Socket.socketPort: AF_UNIX not supported."

-- ---------------------------------------------------------------------------
-- socketPortSafe
-- | Getting the port of socket.
socketPortSafe :: Socket                -- Connected & Bound Socket
               -> IO (Maybe PortNumber) -- Port Number of Socket
socketPortSafe :: Socket -> IO (Maybe PortNumber)
socketPortSafe Socket
s = do
    SockAddr
sa <- forall sa. SocketAddress sa => Socket -> IO sa
getSocketName Socket
s
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case SockAddr
sa of
      SockAddrInet PortNumber
port HostAddress
_      -> forall a. a -> Maybe a
Just PortNumber
port
      SockAddrInet6 PortNumber
port HostAddress
_ HostAddress6
_ HostAddress
_ -> forall a. a -> Maybe a
Just PortNumber
port
      SockAddr
_                        -> forall a. Maybe a
Nothing