{-# LINE 1 "src/System/Socket/Internal/AddressInfo.hsc" #-}
{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables, StandaloneDeriving,
FlexibleContexts, TypeFamilies, GeneralizedNewtypeDeriving #-}
module System.Socket.Internal.AddressInfo (
AddressInfo (..)
, HasAddressInfo (..)
, NameInfo (..)
, HasNameInfo (..)
, AddressInfoException (..)
, eaiAgain
, eaiBadFlags
, eaiFail
, eaiFamily
, eaiMemory
, eaiNoName
, eaiSocketType
, eaiService
, eaiSystem
, AddressInfoFlags (..)
, aiAddressConfig
, aiAll
, aiCanonicalName
, aiNumericHost
, aiNumericService
, aiPassive
, aiV4Mapped
, NameInfoFlags (..)
, niNameRequired
, niDatagram
, niNoFullyQualifiedDomainName
, niNumericHost
, niNumericService
) where
import Control.Exception
import Control.Monad
import Data.Monoid
import Data.Bits
import Data.Semigroup as Sem
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.Socket.Family.Inet
import System.Socket.Family.Inet6
import System.Socket.Internal.Socket
import System.Socket.Internal.Platform
{-# LINE 68 "src/System/Socket/Internal/AddressInfo.hsc" #-}
data AddressInfo f t p
= AddressInfo
{ addressInfoFlags :: AddressInfoFlags
, socketAddress :: SocketAddress f
, canonicalName :: Maybe BS.ByteString
}
deriving instance (Eq (SocketAddress f)) => Eq (AddressInfo f t p)
deriving instance (Show (SocketAddress f)) => Show (AddressInfo f t p)
newtype AddressInfoException
= AddressInfoException CInt
deriving (Eq, Typeable)
instance Show AddressInfoException where
show e
| e == eaiAgain = "eaiAgain"
| e == eaiBadFlags = "eaiBadFlags"
| e == eaiFail = "eaiFail"
| e == eaiFamily = "eaiFamily"
| e == eaiMemory = "eaiMemory"
| e == eaiNoName = "eaiNoName"
| e == eaiService = "eaiService"
| e == eaiSocketType = "eaiSocketType"
| e == eaiSystem = "eaiSystem"
| otherwise = let AddressInfoException n = e
in "AddressInfoException " ++ show n
instance Exception AddressInfoException
eaiAgain :: AddressInfoException
eaiAgain = AddressInfoException (-3)
{-# LINE 113 "src/System/Socket/Internal/AddressInfo.hsc" #-}
eaiBadFlags :: AddressInfoException
eaiBadFlags = AddressInfoException (-1)
{-# LINE 117 "src/System/Socket/Internal/AddressInfo.hsc" #-}
eaiFail :: AddressInfoException
eaiFail = AddressInfoException (-4)
{-# LINE 121 "src/System/Socket/Internal/AddressInfo.hsc" #-}
eaiFamily :: AddressInfoException
eaiFamily = AddressInfoException (-6)
{-# LINE 125 "src/System/Socket/Internal/AddressInfo.hsc" #-}
eaiMemory :: AddressInfoException
eaiMemory = AddressInfoException (-10)
{-# LINE 129 "src/System/Socket/Internal/AddressInfo.hsc" #-}
eaiNoName :: AddressInfoException
eaiNoName = AddressInfoException (-2)
{-# LINE 133 "src/System/Socket/Internal/AddressInfo.hsc" #-}
eaiService :: AddressInfoException
eaiService = AddressInfoException (-8)
{-# LINE 137 "src/System/Socket/Internal/AddressInfo.hsc" #-}
eaiSocketType :: AddressInfoException
eaiSocketType = AddressInfoException (-7)
{-# LINE 141 "src/System/Socket/Internal/AddressInfo.hsc" #-}
eaiSystem :: AddressInfoException
eaiSystem = AddressInfoException (-11)
{-# LINE 145 "src/System/Socket/Internal/AddressInfo.hsc" #-}
newtype AddressInfoFlags
= AddressInfoFlags CInt
deriving (Eq, Show, Bits)
instance Sem.Semigroup AddressInfoFlags where
(AddressInfoFlags a) <> (AddressInfoFlags b)
= AddressInfoFlags (a .|. b)
instance Data.Monoid.Monoid AddressInfoFlags where
mempty = AddressInfoFlags 0
mappend = (Sem.<>)
aiAddressConfig :: AddressInfoFlags
aiAddressConfig = AddressInfoFlags (32)
{-# LINE 164 "src/System/Socket/Internal/AddressInfo.hsc" #-}
aiAll :: AddressInfoFlags
aiAll = AddressInfoFlags (16)
{-# LINE 170 "src/System/Socket/Internal/AddressInfo.hsc" #-}
aiCanonicalName :: AddressInfoFlags
aiCanonicalName = AddressInfoFlags (2)
{-# LINE 174 "src/System/Socket/Internal/AddressInfo.hsc" #-}
aiNumericHost :: AddressInfoFlags
aiNumericHost = AddressInfoFlags (4)
{-# LINE 178 "src/System/Socket/Internal/AddressInfo.hsc" #-}
aiNumericService :: AddressInfoFlags
aiNumericService = AddressInfoFlags (1024)
{-# LINE 182 "src/System/Socket/Internal/AddressInfo.hsc" #-}
aiPassive :: AddressInfoFlags
aiPassive = AddressInfoFlags (1)
{-# LINE 186 "src/System/Socket/Internal/AddressInfo.hsc" #-}
aiV4Mapped :: AddressInfoFlags
aiV4Mapped = AddressInfoFlags (8)
{-# LINE 191 "src/System/Socket/Internal/AddressInfo.hsc" #-}
newtype NameInfoFlags
= NameInfoFlags CInt
deriving (Eq, Show, Bits)
instance Sem.Semigroup NameInfoFlags where
(NameInfoFlags a) <> (NameInfoFlags b)
= NameInfoFlags (a .|. b)
instance Monoid NameInfoFlags where
mempty = NameInfoFlags 0
mappend = (Sem.<>)
niNameRequired :: NameInfoFlags
niNameRequired = NameInfoFlags (8)
{-# LINE 210 "src/System/Socket/Internal/AddressInfo.hsc" #-}
niDatagram :: NameInfoFlags
niDatagram = NameInfoFlags (16)
{-# LINE 214 "src/System/Socket/Internal/AddressInfo.hsc" #-}
niNoFullyQualifiedDomainName :: NameInfoFlags
niNoFullyQualifiedDomainName = NameInfoFlags (4)
{-# LINE 218 "src/System/Socket/Internal/AddressInfo.hsc" #-}
niNumericHost :: NameInfoFlags
niNumericHost = NameInfoFlags (1)
{-# LINE 222 "src/System/Socket/Internal/AddressInfo.hsc" #-}
niNumericService :: NameInfoFlags
niNumericService = NameInfoFlags (2)
{-# LINE 226 "src/System/Socket/Internal/AddressInfo.hsc" #-}
class (Family f) => HasAddressInfo f where
getAddressInfo :: (Type t, Protocol p) => Maybe BS.ByteString -> Maybe BS.ByteString -> AddressInfoFlags -> IO [AddressInfo f t p]
instance HasAddressInfo Inet where
getAddressInfo = getAddressInfo'
instance HasAddressInfo Inet6 where
getAddressInfo = getAddressInfo'
getAddressInfo' :: forall f t p. (Family f, Storable (SocketAddress f), Type t, Protocol p) => Maybe BS.ByteString -> Maybe BS.ByteString -> AddressInfoFlags -> IO [AddressInfo f t p]
getAddressInfo' mnode mservice (AddressInfoFlags flags) = do
alloca $ \resultPtrPtr-> do
poke resultPtrPtr nullPtr
allocaBytes ((48)) $ \addrInfoPtr-> do
{-# LINE 271 "src/System/Socket/Internal/AddressInfo.hsc" #-}
c_memset addrInfoPtr 0 (48)
{-# LINE 273 "src/System/Socket/Internal/AddressInfo.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
peekAddressInfos resultPtr
else do
throwIO (AddressInfoException e)
)
where
ai_flags = ((\hsc_ptr -> hsc_ptr `plusPtr` 0)) :: Ptr (AddressInfo a t p) -> Ptr CInt
{-# LINE 292 "src/System/Socket/Internal/AddressInfo.hsc" #-}
ai_family = ((\hsc_ptr -> hsc_ptr `plusPtr` 4)) :: Ptr (AddressInfo a t p) -> Ptr CInt
{-# LINE 293 "src/System/Socket/Internal/AddressInfo.hsc" #-}
ai_socktype = ((\hsc_ptr -> hsc_ptr `plusPtr` 8)) :: Ptr (AddressInfo a t p) -> Ptr CInt
{-# LINE 294 "src/System/Socket/Internal/AddressInfo.hsc" #-}
ai_protocol = ((\hsc_ptr -> hsc_ptr `plusPtr` 12)) :: Ptr (AddressInfo a t p) -> Ptr CInt
{-# LINE 295 "src/System/Socket/Internal/AddressInfo.hsc" #-}
ai_addr = ((\hsc_ptr -> hsc_ptr `plusPtr` 24)) :: Ptr (AddressInfo a t p) -> Ptr (Ptr a)
{-# LINE 296 "src/System/Socket/Internal/AddressInfo.hsc" #-}
ai_canonname = ((\hsc_ptr -> hsc_ptr `plusPtr` 32)) :: Ptr (AddressInfo a t p) -> Ptr CString
{-# LINE 297 "src/System/Socket/Internal/AddressInfo.hsc" #-}
ai_next = ((\hsc_ptr -> hsc_ptr `plusPtr` 40)) :: Ptr (AddressInfo a t p) -> Ptr (Ptr (AddressInfo a t p))
{-# LINE 298 "src/System/Socket/Internal/AddressInfo.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
peekAddressInfos 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) >>= peekAddressInfos
return ((AddressInfo (AddressInfoFlags flag) addr cname):as)
data NameInfo
= NameInfo
{ hostName :: BS.ByteString
, serviceName :: BS.ByteString
} deriving (Eq, Show)
class (Family f) => HasNameInfo f where
getNameInfo :: SocketAddress f -> NameInfoFlags -> IO NameInfo
instance HasNameInfo Inet where
getNameInfo = getNameInfo'
instance HasNameInfo Inet6 where
getNameInfo = getNameInfo'
getNameInfo' :: Storable a => a -> NameInfoFlags -> IO NameInfo
getNameInfo' addr (NameInfoFlags flags) =
alloca $ \addrPtr->
allocaBytes (1025) $ \hostPtr->
{-# LINE 344 "src/System/Socket/Internal/AddressInfo.hsc" #-}
allocaBytes (32) $ \servPtr-> do
{-# LINE 345 "src/System/Socket/Internal/AddressInfo.hsc" #-}
poke addrPtr addr
e <- c_getnameinfo addrPtr (fromIntegral $ sizeOf addr)
hostPtr (1025)
{-# LINE 348 "src/System/Socket/Internal/AddressInfo.hsc" #-}
servPtr (32)
{-# LINE 349 "src/System/Socket/Internal/AddressInfo.hsc" #-}
flags
if e == 0 then do
host <- BS.packCString hostPtr
serv <- BS.packCString servPtr
return $ NameInfo host serv
else do
throwIO (AddressInfoException e)