{-# LINE 1 "Z/IO/Network/DNS.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RecordWildCards #-}
module Z.IO.Network.DNS (
getAddrInfo
, HostName
, ServiceName
, AddrInfoFlag(..), addrInfoFlagImplemented, addrInfoFlagMapping
, AddrInfo(..), defaultHints, followAddrInfo
, 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
type HostName = CBytes
type ServiceName = CBytes
data AddrInfoFlag =
AI_ADDRCONFIG
| AI_ALL
| AI_CANONNAME
| AI_NUMERICHOST
| AI_NUMERICSERV
| AI_PASSIVE
| 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" #-}
]
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
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" #-}
((\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" #-}
data NameInfoFlag =
NI_DGRAM
| NI_NAMEREQD
| NI_NOFQDN
| NI_NUMERICHOST
| 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" #-}
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
}
getAddrInfo
:: Maybe AddrInfo
-> HostName
-> ServiceName
-> IO [AddrInfo]
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" #-}
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)
getNameInfo
:: [NameInfoFlag]
-> Bool
-> Bool
-> SocketAddr
-> 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
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
unpackBits :: (Num b, Bits b) => [(a, b)] -> b -> [a]
{-# INLINE unpackBits #-}
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
-> CString
-> Ptr AddrInfo
-> Ptr (Ptr AddrInfo)
-> IO Int
foreign import ccall unsafe "freeaddrinfo" freeaddrinfo :: Ptr AddrInfo -> IO ()
foreign import ccall safe "hs_getnameinfo"
hs_getnameinfo :: Ptr SocketAddr
-> CSize
-> CString
-> CSize
-> CString
-> CSize
-> CInt
-> IO Int