    {-# LINE 1 "Network/Socket/Info.hsc" #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# OPTIONS_GHC -fno-warn-orphans #-}

    #include "HsNetDef.h"

    module Network.Socket.Info where

    import Control.Exception (mask, onException)
    import Data.List.NonEmpty (NonEmpty(..))
    import qualified Data.List.NonEmpty as NE
    import Foreign.Marshal.Alloc (alloca, allocaBytes)
    import Foreign.Marshal.Utils (maybeWith, with)
    import GHC.IO.Exception (IOErrorType(NoSuchThing))
    import System.IO.Error (ioeSetErrorString, mkIOError)

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

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

    -- | 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       = String
    -- | Either a service name e.g., @\"http\"@ or a numeric port number.
    type ServiceName    = String

    -----------------------------------------------------------------------------
    -- 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 'SockAddr'
        --   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 (Eq, Read, Show)

    aiFlagMapping :: [(AddrInfoFlag, CInt)]

    aiFlagMapping =
        [

    {-# LINE 75 "Network/Socket/Info.hsc" #-}
         (AI_ADDRCONFIG, 32),
    {-# LINE 76 "Network/Socket/Info.hsc" #-}

    {-# LINE 79 "Network/Socket/Info.hsc" #-}

    {-# LINE 80 "Network/Socket/Info.hsc" #-}
         (AI_ALL, 16),
    {-# LINE 81 "Network/Socket/Info.hsc" #-}

    {-# LINE 84 "Network/Socket/Info.hsc" #-}
         (AI_CANONNAME, 2),
    {-# LINE 85 "Network/Socket/Info.hsc" #-}
         (AI_NUMERICHOST, 4),
    {-# LINE 86 "Network/Socket/Info.hsc" #-}

    {-# LINE 87 "Network/Socket/Info.hsc" #-}
         (AI_NUMERICSERV, 1024),
    {-# LINE 88 "Network/Socket/Info.hsc" #-}

    {-# LINE 91 "Network/Socket/Info.hsc" #-}
         (AI_PASSIVE, 1),
    {-# LINE 92 "Network/Socket/Info.hsc" #-}

    {-# LINE 93 "Network/Socket/Info.hsc" #-}
         (AI_V4MAPPED, 8)
    {-# LINE 94 "Network/Socket/Info.hsc" #-}

    {-# LINE 97 "Network/Socket/Info.hsc" #-}
        ]

    -- | Indicate whether the given 'AddrInfoFlag' will have any effect on
    -- this system.
    addrInfoFlagImplemented :: AddrInfoFlag -> Bool
    addrInfoFlagImplemented f = packBits aiFlagMapping [f] /= 0

    data AddrInfo = AddrInfo {
        addrFlags :: [AddrInfoFlag]
      , addrFamily :: Family
      , addrSocketType :: SocketType
      , addrProtocol :: ProtocolNumber
      , addrAddress :: SockAddr
      , addrCanonName :: Maybe String
      } deriving (Eq, Show)

    instance Storable AddrInfo where
        sizeOf    ~_ = 48
    {-# LINE 115 "Network/Socket/Info.hsc" #-}
        alignment ~_ = alignment (0 :: CInt)

        peek p = do
            ai_flags <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p
    {-# LINE 119 "Network/Socket/Info.hsc" #-}
            ai_family <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p
    {-# LINE 120 "Network/Socket/Info.hsc" #-}
            ai_socktype <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
    {-# LINE 121 "Network/Socket/Info.hsc" #-}
            ai_protocol <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) p
    {-# LINE 122 "Network/Socket/Info.hsc" #-}
            ai_addr <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p >>= peekSockAddr
    {-# LINE 123 "Network/Socket/Info.hsc" #-}
            ai_canonname_ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) p
    {-# LINE 124 "Network/Socket/Info.hsc" #-}

            ai_canonname <- if ai_canonname_ptr == nullPtr
                            then return Nothing
                            else Just <$> peekCString ai_canonname_ptr

            return $ AddrInfo {
                addrFlags = unpackBits aiFlagMapping ai_flags
              , addrFamily = unpackFamily ai_family
              , addrSocketType = unpackSocketType ai_socktype
              , addrProtocol = ai_protocol
              , addrAddress = ai_addr
              , addrCanonName = ai_canonname
              }

        poke p (AddrInfo flags family sockType protocol _ _) = do
            let c_stype = packSocketType sockType

            ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p (packBits aiFlagMapping flags)
    {-# LINE 142 "Network/Socket/Info.hsc" #-}
            ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p (packFamily family)
    {-# LINE 143 "Network/Socket/Info.hsc" #-}
            ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p c_stype
    {-# LINE 144 "Network/Socket/Info.hsc" #-}
            ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) p protocol
    {-# LINE 145 "Network/Socket/Info.hsc" #-}

            -- stuff below is probably not needed, but let's zero it for safety

            ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) p (0::CSize)
    {-# LINE 149 "Network/Socket/Info.hsc" #-}
            ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) p nullPtr
    {-# LINE 150 "Network/Socket/Info.hsc" #-}
            ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) p nullPtr
    {-# LINE 151 "Network/Socket/Info.hsc" #-}
            ((\hsc_ptr -> pokeByteOff hsc_ptr 40)) p nullPtr
    {-# LINE 152 "Network/Socket/Info.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 (Eq, Read, Show)

    niFlagMapping :: [(NameInfoFlag, CInt)]

    niFlagMapping = [(NI_DGRAM, 16),
    {-# LINE 180 "Network/Socket/Info.hsc" #-}
                     (NI_NAMEREQD, 8),
    {-# LINE 181 "Network/Socket/Info.hsc" #-}
                     (NI_NOFQDN, 4),
    {-# LINE 182 "Network/Socket/Info.hsc" #-}
                     (NI_NUMERICHOST, 1),
    {-# LINE 183 "Network/Socket/Info.hsc" #-}
                     (NI_NUMERICSERV, 2)]
    {-# LINE 184 "Network/Socket/Info.hsc" #-}

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

    defaultHints :: AddrInfo
    defaultHints = AddrInfo {
        addrFlags      = []
      , addrFamily     = AF_UNSPEC
      , addrSocketType = NoSocketType
      , addrProtocol   = defaultProtocol
      , addrAddress    = SockAddrInet 0 0
      , addrCanonName  = Nothing
      }

    class GetAddrInfo t where
        -----------------------------------------------------------------------------
        -- | Resolve a host or service name to one or more addresses.
        -- The 'AddrInfo' values that this function returns contain 'SockAddr'
        -- values that you can pass directly to 'connect' or
        -- 'bind'.
        --
        -- This function calls @getaddrinfo(3)@, which never successfully returns
        -- with an empty list. If the query fails, 'getAddrInfo' throws an IO
        -- exception.
        --
        -- For backwards-compatibility reasons, a hidden 'GetAddrInfo' class is used
        -- to make the result polymorphic. It only has instances for @[]@ (lists)
        -- and 'NonEmpty'. Use of 'NonEmpty' is recommended.
        --
        -- 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 a 'Just' 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.
        --
        -- 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.
        --
        -- >>> import qualified Data.List.NonEmpty as NE
        -- >>> addr <- NE.head <$> getAddrInfo (Just hints) (Just "127.0.0.1") (Just "http")
        -- >>> addrAddress addr
        -- 127.0.0.1:80
        --
        -- Polymorphic version: @since 3.2.3.0
        getAddrInfo
            :: Maybe AddrInfo -- ^ preferred socket type or protocol
            -> Maybe HostName -- ^ host name to look up
            -> Maybe ServiceName -- ^ service name to look up
            -> IO (t AddrInfo) -- ^ resolved addresses, with "best" first

    instance GetAddrInfo [] where
        getAddrInfo = getAddrInfoList

    instance GetAddrInfo NE.NonEmpty where
        getAddrInfo = getAddrInfoNE

    getAddrInfoNE
        :: Maybe AddrInfo -- ^ preferred socket type or protocol
        -> Maybe HostName -- ^ host name to look up
        -> Maybe ServiceName -- ^ service name to look up
        -> IO (NonEmpty AddrInfo) -- ^ resolved addresses, with "best" first
    getAddrInfoNE hints node service = alloc getaddrinfo
      where
        alloc body = withSocketsDo $ maybeWith withCString node $ \c_node ->
            maybeWith withCString service                       $ \c_service ->
                maybeWith with filteredHints                    $ \c_hints ->
                      alloca                                    $ \ptr_ptr_addrs ->
                          body c_node c_service c_hints ptr_ptr_addrs
        getaddrinfo c_node c_service c_hints ptr_ptr_addrs = mask $ \release -> do
            ret <- c_getaddrinfo c_node c_service c_hints ptr_ptr_addrs
            if ret == 0 then do
                ptr_addrs <- peek ptr_ptr_addrs
                ais       <- release (followAddrInfo ptr_addrs) `onException` c_freeaddrinfo ptr_addrs
                c_freeaddrinfo ptr_addrs
                return ais
              else do
                err <- gai_strerror ret
                ioError $ ioeSetErrorString
                            (mkIOError NoSuchThing message Nothing Nothing)
                            err
        message = concat [
            "Network.Socket.getAddrInfo (called with preferred socket type/protocol: "
          , maybe "Nothing" show hints
          , ", host name: "
          , maybe "Nothing" show node
          , ", service name: "
          , maybe "Nothing" show service
          , ")"
          ]

    {-# LINE 308 "Network/Socket/Info.hsc" #-}
        filteredHints = hints

    {-# LINE 310 "Network/Socket/Info.hsc" #-}

    getAddrInfoList
        :: Maybe AddrInfo
        -> Maybe HostName
        -> Maybe ServiceName
        -> IO [AddrInfo]
    getAddrInfoList hints node service =
        -- getAddrInfo never returns an empty list.
        NE.toList <$> getAddrInfoNE hints node service

    followAddrInfo :: Ptr AddrInfo -> IO (NonEmpty AddrInfo)
    followAddrInfo ptr_ai
        -- POSIX requires that getaddrinfo(3) returns at least one addrinfo.
        -- See: http://pubs.opengroup.org/onlinepubs/9699919799/functions/getaddrinfo.html
        | ptr_ai == nullPtr = ioError $ mkIOError NoSuchThing "getaddrinfo must return at least one addrinfo" Nothing Nothing
        | otherwise = do
            a <- peek ptr_ai
            ptr <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) ptr_ai
    {-# LINE 328 "Network/Socket/Info.hsc" #-}
            (a :|) <$> go ptr
      where
        go :: Ptr AddrInfo -> IO [AddrInfo]
        go ptr
          | ptr == nullPtr = return []
          | otherwise = do
                a' <- peek ptr
                ptr' <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) ptr
    {-# LINE 336 "Network/Socket/Info.hsc" #-}
                as' <- go ptr'
                return (a':as')

    foreign import ccall safe "hsnet_getaddrinfo"
        c_getaddrinfo :: CString -> CString -> Ptr AddrInfo -> Ptr (Ptr AddrInfo)
                      -> IO CInt

    foreign import ccall safe "hsnet_freeaddrinfo"
        c_freeaddrinfo :: Ptr AddrInfo -> IO ()

    gai_strerror :: CInt -> IO String

    {-# LINE 349 "Network/Socket/Info.hsc" #-}
    gai_strerror n = c_gai_strerror n >>= peekCString

    foreign import ccall safe "gai_strerror"
        c_gai_strerror :: CInt -> IO CString

    {-# LINE 356 "Network/Socket/Info.hsc" #-}

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

    withCStringIf :: Bool -> Int -> (CSize -> CString -> IO a) -> IO a
    withCStringIf False _ f = f 0 nullPtr
    withCStringIf True  n f = allocaBytes n (f (fromIntegral n))

    -- | 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) (Just "127.0.0.1") (Just "http")
    -- >>> getNameInfo [NI_NUMERICHOST, NI_NUMERICSERV] True True $ addrAddress addr
    -- (Just "127.0.0.1",Just "80")
    {-
    -- >>> getNameInfo [] True True $ addrAddress addr
    -- (Just "localhost",Just "http")
    -}
    getNameInfo
        :: [NameInfoFlag] -- ^ flags to control lookup behaviour
        -> Bool -- ^ whether to look up a hostname
        -> Bool -- ^ whether to look up a service name
        -> SockAddr -- ^ the address to look up
        -> IO (Maybe HostName, Maybe ServiceName)
    getNameInfo flags doHost doService addr = alloc getnameinfo
      where
        alloc body = withSocketsDo $
            withCStringIf doHost (1025)        $ \c_hostlen c_host ->
    {-# LINE 389 "Network/Socket/Info.hsc" #-}
                withCStringIf doService (32) $ \c_servlen c_serv ->
    {-# LINE 390 "Network/Socket/Info.hsc" #-}
                    withSockAddr addr                        $ \ptr_addr sz ->
                      body c_hostlen c_host c_servlen c_serv ptr_addr sz
        getnameinfo c_hostlen c_host c_servlen c_serv ptr_addr sz = do
            ret <- c_getnameinfo ptr_addr
                                 (fromIntegral sz)
                                 c_host
                                 c_hostlen
                                 c_serv
                                 c_servlen
                                 (packBits niFlagMapping flags)
            if ret == 0 then do
                let peekIf doIf c_val =
                        if doIf then Just <$> peekCString c_val else return Nothing
                host <- peekIf doHost c_host
                serv <- peekIf doService c_serv
                return (host, serv)
              else do
                err <- gai_strerror ret
                ioError $ ioeSetErrorString
                            (mkIOError NoSuchThing message Nothing Nothing)
                            err
        message = concat [
            "Network.Socket.getNameInfo (called with flags: "
          , show flags
          , ", hostname lookup: "
          , show doHost
          , ", service name lookup: "
          , show doService
          , ", socket address: "
          , show addr
          , ")"
          ]

    foreign import ccall safe "hsnet_getnameinfo"
        c_getnameinfo :: Ptr SockAddr -> CInt{-CSockLen???-} -> CString -> CSize -> CString
                      -> CSize -> CInt -> IO CInt

    -- | 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
    packBits mapping xs = foldl' pack 0 mapping
      where
        pack acc (k, v) | k `elem` xs = acc .|. v
                        | otherwise   = acc

    -- | Unpack a bitmask into a list of values.
    unpackBits :: (Num b, Bits b) => [(a, b)] -> b -> [a]
    -- 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 [] _    = []
    unpackBits ((k,v):xs) r
        | r .&. v /= 0 = k : unpackBits xs (r .&. complement v)
        | otherwise    = unpackBits xs r

    -----------------------------------------------------------------------------
    -- SockAddr

    -- |
    --
    -- >>> SockAddrInet6 80 0 (0,0,0xffff,0x01020304) 0
    -- [::ffff:1.2.3.4]:80
    instance Show SockAddr where
      showsPrec _ (SockAddrUnix str) = showString str
      showsPrec _ (SockAddrInet port ha)
       = showHostAddress ha
       . showString ":"
       . shows port
      showsPrec _ (SockAddrInet6 port _ ha6 _)
       = showChar '['
       . showHostAddress6 ha6
       . showString "]:"
       . shows port

    -- Taken from on the implementation of showIPv4 in Data.IP.Addr
    showHostAddress :: HostAddress -> ShowS
    showHostAddress ip =
      let (u3, u2, u1, u0) = hostAddressToTuple ip in
      foldr1 (.) . intersperse (showChar '.') $ map showInt [u3, u2, u1, u0]

    showHostAddress' :: HostAddress -> ShowS
    showHostAddress' ip =
      let (u3, u2, u1, u0) = hostAddressToTuple' ip in
      foldr1 (.) . intersperse (showChar '.') $ map showInt [u3, u2, u1, u0]

    -- Taken from showIPv6 in Data.IP.Addr.

    -- | Show an IPv6 address in the most appropriate notation, based on recommended
    -- representation proposed by <http://tools.ietf.org/html/rfc5952 RFC 5952>.
    --
    -- /The implementation is completely compatible with the current implementation
    -- of the `inet_ntop` function in glibc./
    showHostAddress6 :: HostAddress6 -> ShowS
    showHostAddress6 ha6@(a1, a2, a3, a4)
        -- IPv4-Mapped IPv6 Address
        | a1 == 0 && a2 == 0 && a3 == 0xffff =
          showString "::ffff:" . showHostAddress' a4
        -- IPv4-Compatible IPv6 Address (exclude IPRange ::/112)
        | a1 == 0 && a2 == 0 && a3 == 0 && a4 >= 0x10000 =
            showString "::" . showHostAddress' a4
        -- length of longest run > 1, replace it with "::"
        | end - begin > 1 =
            showFields prefix . showString "::" . showFields suffix
        | otherwise =
            showFields fields
      where
        fields =
            let (u7, u6, u5, u4, u3, u2, u1, u0) = hostAddress6ToTuple ha6 in
            [u7, u6, u5, u4, u3, u2, u1, u0]
        showFields = foldr (.) id . intersperse (showChar ':') . map showHex
        prefix = take begin fields  -- fields before "::"
        suffix = drop end fields    -- fields after "::"
        begin = end + diff          -- the longest run of zeros
        (diff, end) = minimum $
            scanl (\c i -> if i == 0 then c - 1 else 0) 0 fields `zip` [0..]

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

    -- | A utility function to open a socket with `AddrInfo`.
    -- This is a just wrapper for the following code:
    --
    -- > \addr -> socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
    openSocket :: AddrInfo -> IO Socket
    openSocket addr = socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)