{-# LINE 1 "src/System/Socket/Internal/AddrInfo.hsc" #-}
{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables,
{-# LINE 2 "src/System/Socket/Internal/AddrInfo.hsc" #-}
            StandaloneDeriving, FlexibleContexts, TypeFamilies, CPP,
            GeneralizedNewtypeDeriving #-}
module System.Socket.Internal.AddrInfo (
    AddrInfo (..)
  , GetAddrInfo (..)
  , GetNameInfo (..)
  , AddrInfoException (..)
  , gaiStrerror
  , eaiAGAIN
  , eaiBADFLAGS
  , eaiFAIL
  , eaiFAMILY
  , eaiMEMORY
  , eaiNONAME
  , eaiSOCKTYPE
  , eaiSERVICE
  , eaiSYSTEM
  , AddrInfoFlags (..)
  , aiADDRCONFIG
  , aiALL
  , aiCANONNAME
  , aiNUMERICHOST
  , aiNUMERICSERV
  , aiPASSIVE
  , aiV4MAPPED
  , NameInfoFlags (..)
  , niNAMEREQD
  , niDGRAM
  , niNOFQDN
  , niNUMERICHOST
  , niNUMERICSERV
  ) where

import Control.Exception
import Control.Monad

import Data.Bits
import Data.Monoid
import Data.Typeable
import qualified Data.ByteString as BS

import Foreign.Ptr
import Foreign.Storable
import Foreign.C.Types
import Foreign.C.String
import Foreign.Marshal.Alloc

import System.IO.Unsafe

import System.Socket.Family
import System.Socket.Family.INET
import System.Socket.Family.INET6
import System.Socket.Type
import System.Socket.Protocol
import System.Socket.Internal.FFI


{-# LINE 59 "src/System/Socket/Internal/AddrInfo.hsc" #-}

{-# LINE 60 "src/System/Socket/Internal/AddrInfo.hsc" #-}

-------------------------------------------------------------------------------
-- AddrInfo
-------------------------------------------------------------------------------

data AddrInfo f t p
   = AddrInfo
     { addrInfoFlags :: AddrInfoFlags
     , addrAddress   :: SockAddr f
     , addrCanonName :: Maybe BS.ByteString
     }

deriving instance (Eq   (SockAddr f)) => Eq   (AddrInfo f t p)
deriving instance (Show (SockAddr f)) => Show (AddrInfo f t p)

-------------------------------------------------------------------------------
-- AddrInfoException
-------------------------------------------------------------------------------

-- | Contains the error code that can be matched against. Use `gaiStrerror`
--   to get a human readable explanation of the error (show`
--   does this as well).
newtype AddrInfoException
      = AddrInfoException CInt
   deriving (Eq, Typeable)

instance Show AddrInfoException where
  show e = "AddrInfoException \"" ++ gaiStrerror e ++ "\""

instance Exception AddrInfoException

-- | A wrapper around @gai_strerror@.
gaiStrerror :: AddrInfoException -> String
gaiStrerror (AddrInfoException e) =
  unsafePerformIO $ do
    msgPtr <- c_gai_strerror e
    peekCString msgPtr

-- | > AddrInfoException "Temporary failure in name resolution"
eaiAGAIN    :: AddrInfoException
eaiAGAIN     = AddrInfoException (-3)
{-# LINE 101 "src/System/Socket/Internal/AddrInfo.hsc" #-}

-- | > AddrInfoException "Bad value for ai_flags"
eaiBADFLAGS :: AddrInfoException
eaiBADFLAGS  = AddrInfoException (-1)
{-# LINE 105 "src/System/Socket/Internal/AddrInfo.hsc" #-}

-- | > AddrInfoException "Non-recoverable failure in name resolution"
eaiFAIL     :: AddrInfoException
eaiFAIL      = AddrInfoException (-4)
{-# LINE 109 "src/System/Socket/Internal/AddrInfo.hsc" #-}

-- | > AddrInfoException "ai_family not supported"
eaiFAMILY   :: AddrInfoException
eaiFAMILY    = AddrInfoException (-6)
{-# LINE 113 "src/System/Socket/Internal/AddrInfo.hsc" #-}

-- | > AddrInfoException "Memory allocation failure"
eaiMEMORY   :: AddrInfoException
eaiMEMORY    = AddrInfoException (-10)
{-# LINE 117 "src/System/Socket/Internal/AddrInfo.hsc" #-}

-- | > AddrInfoException "No such host is known"
eaiNONAME   :: AddrInfoException
eaiNONAME    = AddrInfoException (-2)
{-# LINE 121 "src/System/Socket/Internal/AddrInfo.hsc" #-}

-- | > AddrInfoException "Servname not supported for ai_socktype"
eaiSERVICE  :: AddrInfoException
eaiSERVICE   = AddrInfoException (-8)
{-# LINE 125 "src/System/Socket/Internal/AddrInfo.hsc" #-}

-- | > AddrInfoException "ai_socktype not supported"
eaiSOCKTYPE :: AddrInfoException
eaiSOCKTYPE  = AddrInfoException (-7)
{-# LINE 129 "src/System/Socket/Internal/AddrInfo.hsc" #-}

-- | > AddrInfoException "System error"
eaiSYSTEM   :: AddrInfoException
eaiSYSTEM    = AddrInfoException (-11)
{-# LINE 133 "src/System/Socket/Internal/AddrInfo.hsc" #-}


-- | Use the `Data.Monoid.Monoid` instance to combine several flags:
--
--   > mconcat [aiADDRCONFIG, aiV4MAPPED]
newtype AddrInfoFlags
      = AddrInfoFlags CInt
      deriving (Eq, Show, Bits)

instance Monoid AddrInfoFlags where
  mempty
    = AddrInfoFlags 0
  mappend (AddrInfoFlags a) (AddrInfoFlags b)
    = AddrInfoFlags (a .|. b)

aiADDRCONFIG  :: AddrInfoFlags
aiADDRCONFIG   = AddrInfoFlags (32)
{-# LINE 150 "src/System/Socket/Internal/AddrInfo.hsc" #-}

aiALL         :: AddrInfoFlags
aiALL          = AddrInfoFlags (16)
{-# LINE 153 "src/System/Socket/Internal/AddrInfo.hsc" #-}

aiCANONNAME   :: AddrInfoFlags
aiCANONNAME    = AddrInfoFlags (2)
{-# LINE 156 "src/System/Socket/Internal/AddrInfo.hsc" #-}

aiNUMERICHOST :: AddrInfoFlags
aiNUMERICHOST  = AddrInfoFlags (4)
{-# LINE 159 "src/System/Socket/Internal/AddrInfo.hsc" #-}

aiNUMERICSERV :: AddrInfoFlags
aiNUMERICSERV  = AddrInfoFlags (1024)
{-# LINE 162 "src/System/Socket/Internal/AddrInfo.hsc" #-}

aiPASSIVE     :: AddrInfoFlags
aiPASSIVE      = AddrInfoFlags (1)
{-# LINE 165 "src/System/Socket/Internal/AddrInfo.hsc" #-}

aiV4MAPPED    :: AddrInfoFlags
aiV4MAPPED     = AddrInfoFlags (8)
{-# LINE 168 "src/System/Socket/Internal/AddrInfo.hsc" #-}

-- | Use the `Data.Monoid.Monoid` instance to combine several flags:
--
--   > mconcat [niNAMEREQD, niNOFQDN]
newtype NameInfoFlags
      = NameInfoFlags CInt
      deriving (Eq, Show, Bits)

instance Monoid NameInfoFlags where
  mempty
    = NameInfoFlags 0
  mappend (NameInfoFlags a) (NameInfoFlags b)
    = NameInfoFlags (a .|. b)

-- | Throw an exception if the hostname cannot be determined.
niNAMEREQD     :: NameInfoFlags
niNAMEREQD      = NameInfoFlags (8)
{-# LINE 185 "src/System/Socket/Internal/AddrInfo.hsc" #-}

-- | Service is datagram based (UDP) rather than stream based (TCP).
niDGRAM        :: NameInfoFlags
niDGRAM         = NameInfoFlags (16)
{-# LINE 189 "src/System/Socket/Internal/AddrInfo.hsc" #-}

-- | Return only the hostname part of the fully qualified domain name for local hosts.
niNOFQDN       :: NameInfoFlags
niNOFQDN        = NameInfoFlags (4)
{-# LINE 193 "src/System/Socket/Internal/AddrInfo.hsc" #-}

-- | Return the numeric form of the host address.
niNUMERICHOST  :: NameInfoFlags
niNUMERICHOST   = NameInfoFlags (1)
{-# LINE 197 "src/System/Socket/Internal/AddrInfo.hsc" #-}

-- | Return the numeric form of the service address.
niNUMERICSERV  :: NameInfoFlags
niNUMERICSERV   = NameInfoFlags (2)
{-# LINE 201 "src/System/Socket/Internal/AddrInfo.hsc" #-}

class (Family f) => GetAddrInfo f where
  -- | Maps names to addresses (i.e. by DNS lookup).
--
--   The operation throws `AddrInfoException`s.
--
--   Contrary to the underlying @getaddrinfo@ operation this wrapper is
--   typesafe and thus only returns records that match the address, type
--   and protocol encoded in the type. This is the price we have to pay
--   for typesafe sockets and extensibility.
--
--   If you need different types of records, you need to start several
--   queries. If you want to connect to both IPv4 and IPV6 addresses use
--   `aiV4MAPPED` and use IPv6-sockets.
--
--   > > getAddrInfo (Just "www.haskell.org") (Just "80") aiV4MAPPED :: IO [AddrInfo INET6 STREAM TCP]
--   > [AddrInfo {addrInfoFlags = AddrInfoFlags 8, addrAddress = [2400:cb00:2048:0001:0000:0000:6ca2:cc3c]:80, addrCanonName = Nothing}]
--   > > getAddrInfo (Just "darcs.haskell.org") Nothing aiV4MAPPED :: IO [AddrInfo INET6 STREAM TCP]
--   > [AddrInfo {addrInfoFlags = AddrInfoFlags 8, addrAddress = [0000:0000:0000:0000:0000:ffff:17fd:e1ad]:0, addrCanonName = Nothing}]
--   > > getAddrInfo (Just "darcs.haskell.org") Nothing mempty :: IO [AddrInfo INET6 STREAM TCP]
--   > *** Exception: AddrInfoException "Name or service not known"
  getAddrInfo :: (Type t, Protocol p) => Maybe BS.ByteString -> Maybe BS.ByteString -> AddrInfoFlags -> IO [AddrInfo f t p]

instance GetAddrInfo INET where
  getAddrInfo = getAddrInfo'

instance GetAddrInfo INET6 where
  getAddrInfo = getAddrInfo'

getAddrInfo' :: forall f t p. (Family f, Type t, Protocol p) => Maybe BS.ByteString -> Maybe BS.ByteString -> AddrInfoFlags -> IO [AddrInfo f t p]
getAddrInfo' mnode mservice (AddrInfoFlags flags) = do
  alloca $ \resultPtrPtr-> do
    poke resultPtrPtr nullPtr
    allocaBytes ((48)) $ \addrInfoPtr-> do
{-# LINE 235 "src/System/Socket/Internal/AddrInfo.hsc" #-}
      -- properly initialize the struct
      c_memset addrInfoPtr 0 (48)
{-# LINE 237 "src/System/Socket/Internal/AddrInfo.hsc" #-}
      poke (ai_flags addrInfoPtr) flags
      poke (ai_family addrInfoPtr) (familyNumber (undefined :: f))
      poke (ai_socktype addrInfoPtr) (typeNumber (undefined :: t))
      poke (ai_protocol addrInfoPtr) (protocolNumber (undefined :: p))
      fnode $ \nodePtr-> do
        fservice $ \servicePtr->
          bracket
            (c_getaddrinfo nodePtr servicePtr addrInfoPtr resultPtrPtr)
            (\_-> do resultPtr <- peek resultPtrPtr
                     when (resultPtr /= nullPtr) (c_freeaddrinfo resultPtr)
            )
            (\e-> if e == 0 then do
                    resultPtr <- peek resultPtrPtr
                    peekAddrInfos resultPtr
                  else do
                    throwIO (AddrInfoException e)
            )
  where
    ai_flags     = ((\hsc_ptr -> hsc_ptr `plusPtr` 0))     :: Ptr (AddrInfo a t p) -> Ptr CInt
{-# LINE 256 "src/System/Socket/Internal/AddrInfo.hsc" #-}
    ai_family    = ((\hsc_ptr -> hsc_ptr `plusPtr` 4))    :: Ptr (AddrInfo a t p) -> Ptr CInt
{-# LINE 257 "src/System/Socket/Internal/AddrInfo.hsc" #-}
    ai_socktype  = ((\hsc_ptr -> hsc_ptr `plusPtr` 8))  :: Ptr (AddrInfo a t p) -> Ptr CInt
{-# LINE 258 "src/System/Socket/Internal/AddrInfo.hsc" #-}
    ai_protocol  = ((\hsc_ptr -> hsc_ptr `plusPtr` 12))  :: Ptr (AddrInfo a t p) -> Ptr CInt
{-# LINE 259 "src/System/Socket/Internal/AddrInfo.hsc" #-}
    ai_addr      = ((\hsc_ptr -> hsc_ptr `plusPtr` 24))      :: Ptr (AddrInfo a t p) -> Ptr (Ptr a)
{-# LINE 260 "src/System/Socket/Internal/AddrInfo.hsc" #-}
    ai_canonname = ((\hsc_ptr -> hsc_ptr `plusPtr` 32)) :: Ptr (AddrInfo a t p) -> Ptr CString
{-# LINE 261 "src/System/Socket/Internal/AddrInfo.hsc" #-}
    ai_next      = ((\hsc_ptr -> hsc_ptr `plusPtr` 40))      :: Ptr (AddrInfo a t p) -> Ptr (Ptr (AddrInfo a t p))
{-# LINE 262 "src/System/Socket/Internal/AddrInfo.hsc" #-}
    fnode = case mnode of
      Just node    -> BS.useAsCString node
      Nothing      -> \f-> f nullPtr
    fservice = case mservice of
      Just service -> BS.useAsCString service
      Nothing      -> \f-> f nullPtr
    peekAddrInfos ptr = 
      if ptr == nullPtr
        then return []
        else do
          flag  <- peek (ai_flags ptr)
          addr  <- peek (ai_addr ptr) >>= peek
          cname <- do cnPtr <- peek (ai_canonname ptr)
                      if cnPtr == nullPtr
                        then return Nothing
                        else BS.packCString cnPtr >>= return . Just
          as    <- peek (ai_next ptr) >>= peekAddrInfos
          return ((AddrInfo (AddrInfoFlags flag) addr cname):as)

-- | Maps addresss to readable host- and service names.
--
--   The operation throws `AddrInfoException`s.
--
--   > > getNameInfo (SockAddrIn 80 inaddrLOOPBACK) mempty
--   > ("localhost.localdomain","http")
class (Family f) => GetNameInfo f where
  getNameInfo :: SockAddr f -> NameInfoFlags -> IO (BS.ByteString, BS.ByteString)

instance GetNameInfo INET where
  getNameInfo = getNameInfo'

instance GetNameInfo INET6 where
  getNameInfo = getNameInfo'

getNameInfo' :: Storable a => a -> NameInfoFlags -> IO (BS.ByteString, BS.ByteString)
getNameInfo' addr (NameInfoFlags flags) =
  alloca $ \addrPtr->
    allocaBytes (1025) $ \hostPtr->
{-# LINE 300 "src/System/Socket/Internal/AddrInfo.hsc" #-}
      allocaBytes (32) $ \servPtr-> do
{-# LINE 301 "src/System/Socket/Internal/AddrInfo.hsc" #-}
        poke addrPtr addr
        e <- c_getnameinfo addrPtr (fromIntegral $ sizeOf addr)
                           hostPtr (1025)
{-# LINE 304 "src/System/Socket/Internal/AddrInfo.hsc" #-}
                           servPtr (32)
{-# LINE 305 "src/System/Socket/Internal/AddrInfo.hsc" #-}
                           flags
        if e == 0 then do
          host <- BS.packCString hostPtr
          serv <- BS.packCString servPtr
          return (host,serv)
        else do
          throwIO (AddrInfoException e)

-------------------------------------------------------------------------------
-- FFI
-------------------------------------------------------------------------------

foreign import ccall FFI_GETADDRINFO_SAFETY FFI_GETADDRINFO
  c_getaddrinfo  :: CString -> CString -> Ptr (AddrInfo a t p) -> Ptr (Ptr (AddrInfo a t p)) -> IO CInt

foreign import ccall FFI_FREEADDRINFO_SAFETY FFI_FREEADDRINFO
  c_freeaddrinfo :: Ptr (AddrInfo a t p) -> IO ()

foreign import ccall FFI_GETNAMEINFO_SAFETY FFI_GETNAMEINFO
  c_getnameinfo  :: Ptr a -> CInt -> CString -> CInt -> CString -> CInt -> CInt -> IO CInt

foreign import ccall FFI_GAI_STRERROR_SAFETY FFI_GAI_STRERROR
  c_gai_strerror  :: CInt -> IO CString