{-# LINE 1 "Z/IO/Network/DNS.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RecordWildCards #-}

{-|
Module      : Z.IO.Network.DNS
Description : TCP/UDP socket address API
Copyright   : (c) Winterland, 2018
License     : BSD
Maintainer  : drkoster@qq.com
Stability   : experimental
Portability : non-portable

This module provides 'getAddrInfo' and 'getNameInfo'. <https://www.man7.org/linux/man-pages/man3/getnameinfo.3.html getnameinfo> and <https://man7.org/linux/man-pages/man3/getaddrinfo.3.html getaddrinfo> equivalent.

-}
module Z.IO.Network.DNS (
  -- * name to ip
    getAddrInfo
  , HostName
  , ServiceName
  , AddrInfoFlag(..), addrInfoFlagImplemented, addrInfoFlagMapping
  , AddrInfo(..), defaultHints, followAddrInfo
  -- * ip to name
  , getNameInfo
  , NameInfoFlag(..), nameInfoFlagMapping
  ) where

import           Data.Bits
import           Data.List as List
import           Foreign.C.String
import           Foreign.C.Types
import           Foreign.Marshal.Utils
import           Foreign.Ptr
import           Foreign.Storable 
import           Z.Data.CBytes  as CBytes
import           Z.Foreign
import           Z.IO.Exception
import           Z.IO.Network.SocketAddr
import           Z.IO.UV.Win



-----------------------------------------------------------------------------

-- | Either a host name e.g., @\"haskell.org\"@ or a numeric host
-- address string consisting of a dotted decimal IPv4 address or an
-- IPv6 address e.g., @\"192.168.0.1\"@.
type HostName       = CBytes
-- | Either a service name e.g., @\"http\"@ or a numeric port number.
type ServiceName    = CBytes

-----------------------------------------------------------------------------
-- Address and service lookups

-- | Flags that control the querying behaviour of 'getAddrInfo'.
--   For more information, see <https://tools.ietf.org/html/rfc3493#page-25>
data AddrInfoFlag =
    -- | The list of returned 'AddrInfo' values will
    --   only contain IPv4 addresses if the local system has at least
    --   one IPv4 interface configured, and likewise for IPv6.
    --   (Only some platforms support this.)
      AI_ADDRCONFIG
    -- | If 'AI_ALL' is specified, return all matching IPv6 and
    --   IPv4 addresses.  Otherwise, this flag has no effect.
    --   (Only some platforms support this.)
    | AI_ALL
    -- | The 'addrCanonName' field of the first returned
    --   'AddrInfo' will contain the "canonical name" of the host.
    | AI_CANONNAME
    -- | The 'HostName' argument /must/ be a numeric
    --   address in string form, and network name lookups will not be
    --   attempted.
    | AI_NUMERICHOST
    -- | The 'ServiceName' argument /must/ be a port
    --   number in string form, and service name lookups will not be
    --   attempted. (Only some platforms support this.)
    | AI_NUMERICSERV
    -- | If no 'HostName' value is provided, the network
    --   address in each 'SocketAddr'
    --   will be left as a "wild card".
    --   This is useful for server applications that
    --   will accept connections from any client.
    | AI_PASSIVE
    -- | If an IPv6 lookup is performed, and no IPv6
    --   addresses are found, IPv6-mapped IPv4 addresses will be
    --   returned. (Only some platforms support this.)
    | AI_V4MAPPED
    deriving (AddrInfoFlag -> AddrInfoFlag -> Bool
(AddrInfoFlag -> AddrInfoFlag -> Bool)
-> (AddrInfoFlag -> AddrInfoFlag -> Bool) -> Eq AddrInfoFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddrInfoFlag -> AddrInfoFlag -> Bool
$c/= :: AddrInfoFlag -> AddrInfoFlag -> Bool
== :: AddrInfoFlag -> AddrInfoFlag -> Bool
$c== :: AddrInfoFlag -> AddrInfoFlag -> Bool
Eq, ReadPrec [AddrInfoFlag]
ReadPrec AddrInfoFlag
Int -> ReadS AddrInfoFlag
ReadS [AddrInfoFlag]
(Int -> ReadS AddrInfoFlag)
-> ReadS [AddrInfoFlag]
-> ReadPrec AddrInfoFlag
-> ReadPrec [AddrInfoFlag]
-> Read AddrInfoFlag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddrInfoFlag]
$creadListPrec :: ReadPrec [AddrInfoFlag]
readPrec :: ReadPrec AddrInfoFlag
$creadPrec :: ReadPrec AddrInfoFlag
readList :: ReadS [AddrInfoFlag]
$creadList :: ReadS [AddrInfoFlag]
readsPrec :: Int -> ReadS AddrInfoFlag
$creadsPrec :: Int -> ReadS AddrInfoFlag
Read, Int -> AddrInfoFlag -> ShowS
[AddrInfoFlag] -> ShowS
AddrInfoFlag -> String
(Int -> AddrInfoFlag -> ShowS)
-> (AddrInfoFlag -> String)
-> ([AddrInfoFlag] -> ShowS)
-> Show AddrInfoFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddrInfoFlag] -> ShowS
$cshowList :: [AddrInfoFlag] -> ShowS
show :: AddrInfoFlag -> String
$cshow :: AddrInfoFlag -> String
showsPrec :: Int -> AddrInfoFlag -> ShowS
$cshowsPrec :: Int -> AddrInfoFlag -> ShowS
Show)

addrInfoFlagMapping :: [(AddrInfoFlag, CInt)]
addrInfoFlagMapping :: [(AddrInfoFlag, CInt)]
addrInfoFlagMapping =
    [

{-# LINE 95 "Z/IO/Network/DNS.hsc" #-}
     (AI_ADDRCONFIG, 32),
{-# LINE 96 "Z/IO/Network/DNS.hsc" #-}

{-# LINE 99 "Z/IO/Network/DNS.hsc" #-}

{-# LINE 100 "Z/IO/Network/DNS.hsc" #-}
     (AI_ALL, 16),
{-# LINE 101 "Z/IO/Network/DNS.hsc" #-}

{-# LINE 104 "Z/IO/Network/DNS.hsc" #-}
     (AddrInfoFlag
AI_CANONNAME, CInt
2),
{-# LINE 105 "Z/IO/Network/DNS.hsc" #-}
     (AI_NUMERICHOST, 4),
{-# LINE 106 "Z/IO/Network/DNS.hsc" #-}

{-# LINE 107 "Z/IO/Network/DNS.hsc" #-}
     (AI_NUMERICSERV, 1024),
{-# LINE 108 "Z/IO/Network/DNS.hsc" #-}

{-# LINE 111 "Z/IO/Network/DNS.hsc" #-}
     (AddrInfoFlag
AI_PASSIVE, CInt
1),
{-# LINE 112 "Z/IO/Network/DNS.hsc" #-}

{-# LINE 113 "Z/IO/Network/DNS.hsc" #-}
     (AI_V4MAPPED, 8)
{-# LINE 114 "Z/IO/Network/DNS.hsc" #-}

{-# LINE 117 "Z/IO/Network/DNS.hsc" #-}
    ]

-- | Indicate whether the given 'AddrInfoFlag' will have any effect on this system.
addrInfoFlagImplemented :: AddrInfoFlag -> Bool
addrInfoFlagImplemented :: AddrInfoFlag -> Bool
addrInfoFlagImplemented AddrInfoFlag
f = [(AddrInfoFlag, CInt)] -> [AddrInfoFlag] -> CInt
forall a b. (Eq a, Num b, Bits b) => [(a, b)] -> [a] -> b
packBits [(AddrInfoFlag, CInt)]
addrInfoFlagMapping [AddrInfoFlag
f] CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0

-- | Address info
data AddrInfo = AddrInfo {
    AddrInfo -> [AddrInfoFlag]
addrFlags :: [AddrInfoFlag]
  , AddrInfo -> SocketFamily
addrFamily :: SocketFamily
  , AddrInfo -> SocketType
addrSocketType :: SocketType
  , AddrInfo -> ProtocolNumber
addrProtocol :: ProtocolNumber
  , AddrInfo -> SocketAddr
addrAddress :: SocketAddr
  , AddrInfo -> CBytes
addrCanonName :: CBytes
  } deriving (AddrInfo -> AddrInfo -> Bool
(AddrInfo -> AddrInfo -> Bool)
-> (AddrInfo -> AddrInfo -> Bool) -> Eq AddrInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddrInfo -> AddrInfo -> Bool
$c/= :: AddrInfo -> AddrInfo -> Bool
== :: AddrInfo -> AddrInfo -> Bool
$c== :: AddrInfo -> AddrInfo -> Bool
Eq, Int -> AddrInfo -> ShowS
[AddrInfo] -> ShowS
AddrInfo -> String
(Int -> AddrInfo -> ShowS)
-> (AddrInfo -> String) -> ([AddrInfo] -> ShowS) -> Show AddrInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddrInfo] -> ShowS
$cshowList :: [AddrInfo] -> ShowS
show :: AddrInfo -> String
$cshow :: AddrInfo -> String
showsPrec :: Int -> AddrInfo -> ShowS
$cshowsPrec :: Int -> AddrInfo -> ShowS
Show)


instance Storable AddrInfo where
    sizeOf :: AddrInfo -> Int
sizeOf    AddrInfo
_ = Int
48
{-# LINE 136 "Z/IO/Network/DNS.hsc" #-}
    alignment _ = alignment (0 :: CInt)

    peek :: Ptr AddrInfo -> IO AddrInfo
peek Ptr AddrInfo
p = do
        CInt
ai_flags <- ((\Ptr AddrInfo
hsc_ptr -> Ptr AddrInfo -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr AddrInfo
hsc_ptr Int
0)) Ptr AddrInfo
p
{-# LINE 140 "Z/IO/Network/DNS.hsc" #-}
        SocketFamily
ai_family <- ((\Ptr AddrInfo
hsc_ptr -> Ptr AddrInfo -> Int -> IO SocketFamily
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr AddrInfo
hsc_ptr Int
4)) Ptr AddrInfo
p
{-# LINE 141 "Z/IO/Network/DNS.hsc" #-}
        SocketType
ai_socktype <- ((\Ptr AddrInfo
hsc_ptr -> Ptr AddrInfo -> Int -> IO SocketType
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr AddrInfo
hsc_ptr Int
8)) Ptr AddrInfo
p
{-# LINE 142 "Z/IO/Network/DNS.hsc" #-}
        ProtocolNumber
ai_protocol <- ((\Ptr AddrInfo
hsc_ptr -> Ptr AddrInfo -> Int -> IO ProtocolNumber
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr AddrInfo
hsc_ptr Int
12)) Ptr AddrInfo
p
{-# LINE 143 "Z/IO/Network/DNS.hsc" #-}
        SocketAddr
ai_addr <- ((\Ptr AddrInfo
hsc_ptr -> Ptr AddrInfo -> Int -> IO (Ptr SocketAddr)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr AddrInfo
hsc_ptr Int
24)) Ptr AddrInfo
p IO (Ptr SocketAddr)
-> (Ptr SocketAddr -> IO SocketAddr) -> IO SocketAddr
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HasCallStack => Ptr SocketAddr -> IO SocketAddr
Ptr SocketAddr -> IO SocketAddr
peekSocketAddr
{-# LINE 144 "Z/IO/Network/DNS.hsc" #-}
        CString
ai_canonname_ptr <- ((\Ptr AddrInfo
hsc_ptr -> Ptr AddrInfo -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr AddrInfo
hsc_ptr Int
32)) Ptr AddrInfo
p
{-# LINE 145 "Z/IO/Network/DNS.hsc" #-}
        CBytes
ai_canonname <- CString -> IO CBytes
fromCString CString
ai_canonname_ptr

        AddrInfo -> IO AddrInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrInfo -> IO AddrInfo) -> AddrInfo -> IO AddrInfo
forall a b. (a -> b) -> a -> b
$ AddrInfo :: [AddrInfoFlag]
-> SocketFamily
-> SocketType
-> ProtocolNumber
-> SocketAddr
-> CBytes
-> AddrInfo
AddrInfo {
            addrFlags :: [AddrInfoFlag]
addrFlags = [(AddrInfoFlag, CInt)] -> CInt -> [AddrInfoFlag]
forall b a. (Num b, Bits b) => [(a, b)] -> b -> [a]
unpackBits [(AddrInfoFlag, CInt)]
addrInfoFlagMapping CInt
ai_flags
          , addrFamily :: SocketFamily
addrFamily = SocketFamily
ai_family
          , addrSocketType :: SocketType
addrSocketType = SocketType
ai_socktype
          , addrProtocol :: ProtocolNumber
addrProtocol = ProtocolNumber
ai_protocol
          , addrAddress :: SocketAddr
addrAddress = SocketAddr
ai_addr
          , addrCanonName :: CBytes
addrCanonName = CBytes
ai_canonname
          }

    poke :: Ptr AddrInfo -> AddrInfo -> IO ()
poke Ptr AddrInfo
p (AddrInfo [AddrInfoFlag]
flags SocketFamily
family SocketType
sockType ProtocolNumber
protocol SocketAddr
_ CBytes
_) = do
        ((\Ptr AddrInfo
hsc_ptr -> Ptr AddrInfo -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr AddrInfo
hsc_ptr Int
0)) Ptr AddrInfo
p ([(AddrInfoFlag, CInt)] -> [AddrInfoFlag] -> CInt
forall a b. (Eq a, Num b, Bits b) => [(a, b)] -> [a] -> b
packBits [(AddrInfoFlag, CInt)]
addrInfoFlagMapping [AddrInfoFlag]
flags)
{-# LINE 158 "Z/IO/Network/DNS.hsc" #-}
        ((\Ptr AddrInfo
hsc_ptr -> Ptr AddrInfo -> Int -> SocketFamily -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr AddrInfo
hsc_ptr Int
4)) Ptr AddrInfo
p SocketFamily
family
{-# LINE 159 "Z/IO/Network/DNS.hsc" #-}
        ((\Ptr AddrInfo
hsc_ptr -> Ptr AddrInfo -> Int -> SocketType -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr AddrInfo
hsc_ptr Int
8)) Ptr AddrInfo
p SocketType
sockType
{-# LINE 160 "Z/IO/Network/DNS.hsc" #-}
        ((\Ptr AddrInfo
hsc_ptr -> Ptr AddrInfo -> Int -> ProtocolNumber -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr AddrInfo
hsc_ptr Int
12)) Ptr AddrInfo
p ProtocolNumber
protocol
{-# LINE 161 "Z/IO/Network/DNS.hsc" #-}
        -- stuff below is probably not needed, but let's zero it for safety
        ((\Ptr AddrInfo
hsc_ptr -> Ptr AddrInfo -> Int -> CSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr AddrInfo
hsc_ptr Int
16)) Ptr AddrInfo
p (CSize
0::CSize)
{-# LINE 163 "Z/IO/Network/DNS.hsc" #-}
        ((\Ptr AddrInfo
hsc_ptr -> Ptr AddrInfo -> Int -> Ptr Any -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr AddrInfo
hsc_ptr Int
24)) Ptr AddrInfo
p Ptr Any
forall a. Ptr a
nullPtr
{-# LINE 164 "Z/IO/Network/DNS.hsc" #-}
        ((\Ptr AddrInfo
hsc_ptr -> Ptr AddrInfo -> Int -> Ptr Any -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr AddrInfo
hsc_ptr Int
32)) Ptr AddrInfo
p Ptr Any
forall a. Ptr a
nullPtr
{-# LINE 165 "Z/IO/Network/DNS.hsc" #-}
        ((\Ptr AddrInfo
hsc_ptr -> Ptr AddrInfo -> Int -> Ptr Any -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr AddrInfo
hsc_ptr Int
40)) Ptr AddrInfo
p Ptr Any
forall a. Ptr a
nullPtr
{-# LINE 166 "Z/IO/Network/DNS.hsc" #-}

-- | Flags that control the querying behaviour of 'getNameInfo'.
--   For more information, see <https://tools.ietf.org/html/rfc3493#page-30>
data NameInfoFlag =
    -- | Resolve a datagram-based service name.  This is
    --   required only for the few protocols that have different port
    --   numbers for their datagram-based versions than for their
    --   stream-based versions.
      NI_DGRAM
    -- | If the hostname cannot be looked up, an IO error is thrown.
    | NI_NAMEREQD
    -- | If a host is local, return only the hostname part of the FQDN.
    | NI_NOFQDN
    -- | The name of the host is not looked up.
    --   Instead, a numeric representation of the host's
    --   address is returned.  For an IPv4 address, this will be a
    --   dotted-quad string.  For IPv6, it will be colon-separated
    --   hexadecimal.
    | NI_NUMERICHOST
    -- | The name of the service is not
    --   looked up.  Instead, a numeric representation of the
    --   service is returned.
    | NI_NUMERICSERV
    deriving (NameInfoFlag -> NameInfoFlag -> Bool
(NameInfoFlag -> NameInfoFlag -> Bool)
-> (NameInfoFlag -> NameInfoFlag -> Bool) -> Eq NameInfoFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameInfoFlag -> NameInfoFlag -> Bool
$c/= :: NameInfoFlag -> NameInfoFlag -> Bool
== :: NameInfoFlag -> NameInfoFlag -> Bool
$c== :: NameInfoFlag -> NameInfoFlag -> Bool
Eq, ReadPrec [NameInfoFlag]
ReadPrec NameInfoFlag
Int -> ReadS NameInfoFlag
ReadS [NameInfoFlag]
(Int -> ReadS NameInfoFlag)
-> ReadS [NameInfoFlag]
-> ReadPrec NameInfoFlag
-> ReadPrec [NameInfoFlag]
-> Read NameInfoFlag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NameInfoFlag]
$creadListPrec :: ReadPrec [NameInfoFlag]
readPrec :: ReadPrec NameInfoFlag
$creadPrec :: ReadPrec NameInfoFlag
readList :: ReadS [NameInfoFlag]
$creadList :: ReadS [NameInfoFlag]
readsPrec :: Int -> ReadS NameInfoFlag
$creadsPrec :: Int -> ReadS NameInfoFlag
Read, Int -> NameInfoFlag -> ShowS
[NameInfoFlag] -> ShowS
NameInfoFlag -> String
(Int -> NameInfoFlag -> ShowS)
-> (NameInfoFlag -> String)
-> ([NameInfoFlag] -> ShowS)
-> Show NameInfoFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameInfoFlag] -> ShowS
$cshowList :: [NameInfoFlag] -> ShowS
show :: NameInfoFlag -> String
$cshow :: NameInfoFlag -> String
showsPrec :: Int -> NameInfoFlag -> ShowS
$cshowsPrec :: Int -> NameInfoFlag -> ShowS
Show)

nameInfoFlagMapping :: [(NameInfoFlag, CInt)]

nameInfoFlagMapping :: [(NameInfoFlag, CInt)]
nameInfoFlagMapping = [(NameInfoFlag
NI_DGRAM, CInt
16),
{-# LINE 194 "Z/IO/Network/DNS.hsc" #-}
                 (NameInfoFlag
NI_NAMEREQD, CInt
8),
{-# LINE 195 "Z/IO/Network/DNS.hsc" #-}
                 (NameInfoFlag
NI_NOFQDN, CInt
4),
{-# LINE 196 "Z/IO/Network/DNS.hsc" #-}
                 (NameInfoFlag
NI_NUMERICHOST, CInt
1),
{-# LINE 197 "Z/IO/Network/DNS.hsc" #-}
                 (NameInfoFlag
NI_NUMERICSERV, CInt
2)]
{-# LINE 198 "Z/IO/Network/DNS.hsc" #-}

-- | Default hints for address lookup with 'getAddrInfo'.
--
-- >>> addrFlags defaultHints
-- []
-- >>> addrFamily defaultHints
-- AF_UNSPEC
-- >>> addrSocketType defaultHints
-- NoSocketType
-- >>> addrProtocol defaultHints
-- 0

defaultHints :: AddrInfo
defaultHints :: AddrInfo
defaultHints = AddrInfo :: [AddrInfoFlag]
-> SocketFamily
-> SocketType
-> ProtocolNumber
-> SocketAddr
-> CBytes
-> AddrInfo
AddrInfo {
    addrFlags :: [AddrInfoFlag]
addrFlags      = []
  , addrFamily :: SocketFamily
addrFamily     = SocketFamily
AF_UNSPEC
  , addrSocketType :: SocketType
addrSocketType = SocketType
SOCK_ANY
  , addrProtocol :: ProtocolNumber
addrProtocol   = ProtocolNumber
IPPROTO_DEFAULT
  , addrAddress :: SocketAddr
addrAddress    = PortNumber -> InetAddr -> SocketAddr
SocketAddrInet PortNumber
portAny InetAddr
inetAny
  , addrCanonName :: CBytes
addrCanonName  = CBytes
empty
  }

-----------------------------------------------------------------------------
-- | Resolve a host or service name to one or more addresses.
-- The 'AddrInfo' values that this function returns contain 'SocketAddr'
-- values that you can use to init TCP connection.
--
-- This function is protocol independent.  It can return both IPv4 and
-- IPv6 address information.
--
-- The 'AddrInfo' argument specifies the preferred query behaviour,
-- socket options, or protocol.  You can override these conveniently
-- using Haskell's record update syntax on 'defaultHints', for example
-- as follows:
--
-- >>> let hints = defaultHints { addrFlags = [AI_NUMERICHOST], addrSocketType = Stream }
--
-- You must provide non empty value for at least one of the 'HostName'
-- or 'ServiceName' arguments.  'HostName' can be either a numeric
-- network address (dotted quad for IPv4, colon-separated hex for
-- IPv6) or a hostname.  In the latter case, its addresses will be
-- looked up unless 'AI_NUMERICHOST' is specified as a hint.  If you
-- do not provide a 'HostName' value /and/ do not set 'AI_PASSIVE' as
-- a hint, network addresses in the result will contain the address of
-- the loopback interface.
--
-- If the query fails, this function throws an IO exception instead of
-- returning an empty list.  Otherwise, it returns a non-empty list
-- of 'AddrInfo' values.
--
-- There are several reasons why a query might result in several
-- values.  For example, the queried-for host could be multihomed, or
-- the service might be available via several protocols.
--
-- Note: the order of arguments is slightly different to that defined
-- for @getaddrinfo@ in RFC 2553.  The 'AddrInfo' parameter comes first
-- to make partial application easier.
--
-- >>> addr:_ <- getAddrInfo (Just hints) "127.0.0.1" "http"
-- >>> addrAddress addr
-- 127.0.0.1:80
--
getAddrInfo
    :: Maybe AddrInfo -- ^ preferred socket type or protocol
    -> HostName -- ^ host name to look up
    -> ServiceName -- ^ service name to look up
    -> IO [AddrInfo] -- ^ resolved addresses, with "best" first
getAddrInfo :: Maybe AddrInfo -> CBytes -> CBytes -> IO [AddrInfo]
getAddrInfo Maybe AddrInfo
hints CBytes
host CBytes
service = IO [AddrInfo] -> IO [AddrInfo]
forall a. IO a -> IO a
withUVInitDo (IO [AddrInfo] -> IO [AddrInfo]) -> IO [AddrInfo] -> IO [AddrInfo]
forall a b. (a -> b) -> a -> b
$
    IO (Ptr AddrInfo)
-> (Ptr AddrInfo -> IO ())
-> (Ptr AddrInfo -> IO [AddrInfo])
-> IO [AddrInfo]
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
        (do CBytes -> (CString -> IO (Ptr AddrInfo)) -> IO (Ptr AddrInfo)
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
host ((CString -> IO (Ptr AddrInfo)) -> IO (Ptr AddrInfo))
-> (CString -> IO (Ptr AddrInfo)) -> IO (Ptr AddrInfo)
forall a b. (a -> b) -> a -> b
$ \ CString
ptr_h ->
                CBytes -> (CString -> IO (Ptr AddrInfo)) -> IO (Ptr AddrInfo)
forall a. CBytes -> (CString -> IO a) -> IO a
withCBytes CBytes
service ((CString -> IO (Ptr AddrInfo)) -> IO (Ptr AddrInfo))
-> (CString -> IO (Ptr AddrInfo)) -> IO (Ptr AddrInfo)
forall a b. (a -> b) -> a -> b
$ \ CString
ptr_s ->
                (AddrInfo
 -> (Ptr AddrInfo -> IO (Ptr AddrInfo)) -> IO (Ptr AddrInfo))
-> Maybe AddrInfo
-> (Ptr AddrInfo -> IO (Ptr AddrInfo))
-> IO (Ptr AddrInfo)
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith AddrInfo
-> (Ptr AddrInfo -> IO (Ptr AddrInfo)) -> IO (Ptr AddrInfo)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Maybe AddrInfo
filteredHints ((Ptr AddrInfo -> IO (Ptr AddrInfo)) -> IO (Ptr AddrInfo))
-> (Ptr AddrInfo -> IO (Ptr AddrInfo)) -> IO (Ptr AddrInfo)
forall a b. (a -> b) -> a -> b
$ \ Ptr AddrInfo
ptr_hints ->
                (Ptr AddrInfo, ()) -> Ptr AddrInfo
forall a b. (a, b) -> a
fst ((Ptr AddrInfo, ()) -> Ptr AddrInfo)
-> IO (Ptr AddrInfo, ()) -> IO (Ptr AddrInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr (Ptr AddrInfo) -> IO ()) -> IO (Ptr AddrInfo, ())
forall a b. Prim a => (Ptr a -> IO b) -> IO (a, b)
allocPrimSafe (\ Ptr (Ptr AddrInfo)
ptr_ptr_addrs -> do
                    IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ CString -> CString -> Ptr AddrInfo -> Ptr (Ptr AddrInfo) -> IO Int
hs_getaddrinfo CString
ptr_h CString
ptr_s Ptr AddrInfo
ptr_hints Ptr (Ptr AddrInfo)
ptr_ptr_addrs))
        Ptr AddrInfo -> IO ()
freeaddrinfo
        Ptr AddrInfo -> IO [AddrInfo]
followAddrInfo
  where

{-# LINE 282 "Z/IO/Network/DNS.hsc" #-}
    filteredHints :: Maybe AddrInfo
filteredHints = Maybe AddrInfo
hints

{-# LINE 284 "Z/IO/Network/DNS.hsc" #-}

-- | Peek @addrinfo@ linked list.
--
followAddrInfo :: Ptr AddrInfo -> IO [AddrInfo]
followAddrInfo :: Ptr AddrInfo -> IO [AddrInfo]
followAddrInfo Ptr AddrInfo
ptr_ai
    | Ptr AddrInfo
ptr_ai Ptr AddrInfo -> Ptr AddrInfo -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr AddrInfo
forall a. Ptr a
nullPtr = [AddrInfo] -> IO [AddrInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    | Bool
otherwise = do
        !AddrInfo
a  <- Ptr AddrInfo -> IO AddrInfo
forall a. Storable a => Ptr a -> IO a
peek Ptr AddrInfo
ptr_ai
        [AddrInfo]
as <- ((\Ptr AddrInfo
hsc_ptr -> Ptr AddrInfo -> Int -> IO (Ptr AddrInfo)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr AddrInfo
hsc_ptr Int
40)) Ptr AddrInfo
ptr_ai IO (Ptr AddrInfo)
-> (Ptr AddrInfo -> IO [AddrInfo]) -> IO [AddrInfo]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr AddrInfo -> IO [AddrInfo]
followAddrInfo
{-# LINE 293 "Z/IO/Network/DNS.hsc" #-}
        [AddrInfo] -> IO [AddrInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrInfo
a AddrInfo -> [AddrInfo] -> [AddrInfo]
forall a. a -> [a] -> [a]
: [AddrInfo]
as)

-----------------------------------------------------------------------------


-- | Resolve an address to a host or service name.
-- This function is protocol independent.
-- The list of 'NameInfoFlag' values controls query behaviour.
--
-- If a host or service's name cannot be looked up, then the numeric
-- form of the address or service will be returned.
--
-- If the query fails, this function throws an IO exception.
--
-- >>> addr:_ <- getAddrInfo (Just defaultHints) "127.0.0.1" "http"
-- >>> getNameInfo [NI_NUMERICHOST, NI_NUMERICSERV] True True $ addrAddress addr
-- ("127.0.0.1", "80")
{-
-- >>> getNameInfo [] True True $ addrAddress addr
-- ("localhost", "http")
-}
getNameInfo
    :: [NameInfoFlag] -- ^ flags to control lookup behaviour
    -> Bool -- ^ whether to look up a hostname
    -> Bool -- ^ whether to look up a service name
    -> SocketAddr -- ^ the address to look up
    -> IO (HostName, ServiceName)
getNameInfo :: [NameInfoFlag] -> Bool -> Bool -> SocketAddr -> IO (CBytes, CBytes)
getNameInfo [NameInfoFlag]
flags Bool
doHost Bool
doService SocketAddr
addr = IO (CBytes, CBytes) -> IO (CBytes, CBytes)
forall a. IO a -> IO a
withUVInitDo (IO (CBytes, CBytes) -> IO (CBytes, CBytes))
-> IO (CBytes, CBytes) -> IO (CBytes, CBytes)
forall a b. (a -> b) -> a -> b
$ do
    (CBytes
host, (CBytes
service, ()
_)) <- Int -> (CString -> IO (CBytes, ())) -> IO (CBytes, (CBytes, ()))
forall a.
HasCallStack =>
Int -> (CString -> IO a) -> IO (CBytes, a)
allocCBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
h_len) ((CString -> IO (CBytes, ())) -> IO (CBytes, (CBytes, ())))
-> (CString -> IO (CBytes, ())) -> IO (CBytes, (CBytes, ()))
forall a b. (a -> b) -> a -> b
$ \ CString
ptr_h ->
        Int -> (CString -> IO ()) -> IO (CBytes, ())
forall a.
HasCallStack =>
Int -> (CString -> IO a) -> IO (CBytes, a)
allocCBytes (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
s_len) ((CString -> IO ()) -> IO (CBytes, ()))
-> (CString -> IO ()) -> IO (CBytes, ())
forall a b. (a -> b) -> a -> b
$ \ CString
ptr_s ->
        SocketAddr -> (Ptr SocketAddr -> IO ()) -> IO ()
forall a. SocketAddr -> (Ptr SocketAddr -> IO a) -> IO a
withSocketAddr SocketAddr
addr ((Ptr SocketAddr -> IO ()) -> IO ())
-> (Ptr SocketAddr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr SocketAddr
ptr_addr -> 
            IO Int -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwUVIfMinus_ (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SocketAddr
-> CSize -> CString -> CSize -> CString -> CSize -> CInt -> IO Int
hs_getnameinfo Ptr SocketAddr
ptr_addr CSize
addr_len CString
ptr_h CSize
h_len CString
ptr_s CSize
s_len CInt
cflag
    (CBytes, CBytes) -> IO (CBytes, CBytes)
forall (m :: * -> *) a. Monad m => a -> m a
return (CBytes
host, CBytes
service)
  where
    addr_len :: CSize
addr_len = SocketAddr -> CSize
sizeOfSocketAddr SocketAddr
addr
    h_len :: CSize
h_len = if Bool
doHost then (CSize
1025) else CSize
0
{-# LINE 329 "Z/IO/Network/DNS.hsc" #-}
    s_len = if doService then (32) else 0
{-# LINE 330 "Z/IO/Network/DNS.hsc" #-}
    cflag = packBits nameInfoFlagMapping flags


-----------------------------------------------------------------------------
-- | Pack a list of values into a bitmask.  The possible mappings from
-- value to bit-to-set are given as the first argument.  We assume
-- that each value can cause exactly one bit to be set; unpackBits will
-- break if this property is not true.
--
packBits :: (Eq a, Num b, Bits b) => [(a, b)] -> [a] -> b
{-# INLINE packBits #-}
packBits :: [(a, b)] -> [a] -> b
packBits [(a, b)]
mapping [a]
xs = (b -> (a, b) -> b) -> b -> [(a, b)] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' b -> (a, b) -> b
forall p. Bits p => p -> (a, p) -> p
go b
0 [(a, b)]
mapping
  where
    go :: p -> (a, p) -> p
go p
acc (a
k, p
v) | a
k a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
xs = p
acc p -> p -> p
forall a. Bits a => a -> a -> a
.|. p
v
                  | Bool
otherwise   = p
acc

-- | Unpack a bitmask into a list of values.
unpackBits :: (Num b, Bits b) => [(a, b)] -> b -> [a]
{-# INLINE unpackBits #-}
-- Be permissive and ignore unknown bit values. At least on OS X,
-- getaddrinfo returns an ai_flags field with bits set that have no
-- entry in <netdb.h>.
unpackBits :: [(a, b)] -> b -> [a]
unpackBits [] b
_    = []
unpackBits ((a
k,b
v):[(a, b)]
xs) b
r
    | b
r b -> b -> b
forall a. Bits a => a -> a -> a
.&. b
v b -> b -> Bool
forall a. Eq a => a -> a -> Bool
/= b
0 = a
k a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [(a, b)] -> b -> [a]
forall b a. (Num b, Bits b) => [(a, b)] -> b -> [a]
unpackBits [(a, b)]
xs (b
r b -> b -> b
forall a. Bits a => a -> a -> a
.&. b -> b
forall a. Bits a => a -> a
complement b
v)
    | Bool
otherwise    = [(a, b)] -> b -> [a]
forall b a. (Num b, Bits b) => [(a, b)] -> b -> [a]
unpackBits [(a, b)]
xs b
r

-----------------------------------------------------------------------------
foreign import ccall safe "hs_getaddrinfo"
    hs_getaddrinfo :: CString -- ^ host 
                      -> CString -- ^ service
                      -> Ptr AddrInfo   -- ^ hints
                      -> Ptr (Ptr AddrInfo) -- ^ output addrinfo linked list
                      -> IO Int

foreign import ccall unsafe "freeaddrinfo" freeaddrinfo :: Ptr AddrInfo -> IO ()

foreign import ccall safe "hs_getnameinfo"
    hs_getnameinfo :: Ptr SocketAddr
                      -> CSize
                      -> CString -- ^ output host 
                      -> CSize
                      -> CString -- ^ output service
                      -> CSize
                      -> CInt    -- ^ flags
                      -> IO Int