{-# LINE 1 "src/System/Socket/Internal/AddressInfo.hsc" #-} {-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables, StandaloneDeriving, {-# LINE 2 "src/System/Socket/Internal/AddressInfo.hsc" #-} FlexibleContexts, TypeFamilies, GeneralizedNewtypeDeriving #-} -------------------------------------------------------------------------------- -- | -- Module : System.Socket.Internal.AddressInfo -- Copyright : (c) Lars Petersen 2015 -- License : MIT -- -- Maintainer : info@lars-petersen.net -- Stability : experimental -------------------------------------------------------------------------------- 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.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 63 "src/System/Socket/Internal/AddressInfo.hsc" #-} {-# LINE 67 "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) ------------------------------------------------------------------------------- -- AddressInfoException ------------------------------------------------------------------------------- -- | Contains the error code that can be matched against. -- -- Hint: Use guards or @MultiWayIf@ to match against specific exceptions: -- -- > if | e == eaiFail -> ... -- > | e == eaiNoName -> ... -- > | otherwise -> ... 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 -- | > AddressInfoException "Temporary failure in name resolution" eaiAgain :: AddressInfoException eaiAgain = AddressInfoException (-3) {-# LINE 112 "src/System/Socket/Internal/AddressInfo.hsc" #-} -- | > AddressInfoException "Bad value for ai_flags" eaiBadFlags :: AddressInfoException eaiBadFlags = AddressInfoException (-1) {-# LINE 116 "src/System/Socket/Internal/AddressInfo.hsc" #-} -- | > AddressInfoException "Non-recoverable failure in name resolution" eaiFail :: AddressInfoException eaiFail = AddressInfoException (-4) {-# LINE 120 "src/System/Socket/Internal/AddressInfo.hsc" #-} -- | > AddressInfoException "ai_family not supported" eaiFamily :: AddressInfoException eaiFamily = AddressInfoException (-6) {-# LINE 124 "src/System/Socket/Internal/AddressInfo.hsc" #-} -- | > AddressInfoException "Memory allocation failure" eaiMemory :: AddressInfoException eaiMemory = AddressInfoException (-10) {-# LINE 128 "src/System/Socket/Internal/AddressInfo.hsc" #-} -- | > AddressInfoException "No such host is known" eaiNoName :: AddressInfoException eaiNoName = AddressInfoException (-2) {-# LINE 132 "src/System/Socket/Internal/AddressInfo.hsc" #-} -- | > AddressInfoException "Servname not supported for ai_socktype" eaiService :: AddressInfoException eaiService = AddressInfoException (-8) {-# LINE 136 "src/System/Socket/Internal/AddressInfo.hsc" #-} -- | > AddressInfoException "ai_socktype not supported" eaiSocketType :: AddressInfoException eaiSocketType = AddressInfoException (-7) {-# LINE 140 "src/System/Socket/Internal/AddressInfo.hsc" #-} -- | > AddressInfoException "System error" eaiSystem :: AddressInfoException eaiSystem = AddressInfoException (-11) {-# LINE 144 "src/System/Socket/Internal/AddressInfo.hsc" #-} -- | Use the `Data.Monoid.Monoid` instance to combine several flags: -- -- > mconcat [aiAddressConfig, aiV4Mapped] newtype AddressInfoFlags = AddressInfoFlags CInt deriving (Eq, Show, Bits) instance Data.Monoid.Monoid AddressInfoFlags where mempty = AddressInfoFlags 0 mappend (AddressInfoFlags a) (AddressInfoFlags b) = AddressInfoFlags (a .|. b) -- | @AI_ADDRCONFIG@: aiAddressConfig :: AddressInfoFlags aiAddressConfig = AddressInfoFlags (32) {-# LINE 161 "src/System/Socket/Internal/AddressInfo.hsc" #-} -- | @AI_ALL@: Return both IPv4 (as v4-mapped IPv6 address) and IPv6 addresses -- when `aiV4Mapped` is set independent of whether IPv6 addresses exist for -- this name. aiAll :: AddressInfoFlags aiAll = AddressInfoFlags (16) {-# LINE 167 "src/System/Socket/Internal/AddressInfo.hsc" #-} -- | @AI_CANONNAME@: aiCanonicalName :: AddressInfoFlags aiCanonicalName = AddressInfoFlags (2) {-# LINE 171 "src/System/Socket/Internal/AddressInfo.hsc" #-} -- | @AI_NUMERICHOST@: aiNumericHost :: AddressInfoFlags aiNumericHost = AddressInfoFlags (4) {-# LINE 175 "src/System/Socket/Internal/AddressInfo.hsc" #-} -- | @AI_NUMERICSERV@: aiNumericService :: AddressInfoFlags aiNumericService = AddressInfoFlags (1024) {-# LINE 179 "src/System/Socket/Internal/AddressInfo.hsc" #-} -- | @AI_PASSIVE@: aiPassive :: AddressInfoFlags aiPassive = AddressInfoFlags (1) {-# LINE 183 "src/System/Socket/Internal/AddressInfo.hsc" #-} -- | @AI_V4MAPPED@: Return mapped IPv4 addresses if no IPv6 addresses could be found -- or if `aiAll` flag is set. aiV4Mapped :: AddressInfoFlags aiV4Mapped = AddressInfoFlags (8) {-# LINE 188 "src/System/Socket/Internal/AddressInfo.hsc" #-} -- | Use the `Data.Monoid.Monoid` instance to combine several flags: -- -- > mconcat [niNameRequired, niNoFullyQualifiedDomainName] newtype NameInfoFlags = NameInfoFlags CInt deriving (Eq, Show, Bits) instance Monoid NameInfoFlags where mempty = NameInfoFlags 0 mappend (NameInfoFlags a) (NameInfoFlags b) = NameInfoFlags (a .|. b) -- | @NI_NAMEREQD@: Throw an exception if the hostname cannot be determined. niNameRequired :: NameInfoFlags niNameRequired = NameInfoFlags (8) {-# LINE 205 "src/System/Socket/Internal/AddressInfo.hsc" #-} -- | @NI_DGRAM@: Service is datagram based (i.e. `System.Socket.Protocol.UDP.UDP`) rather than stream based (i.e. `System.Socket.Protocol.TCP.TCP`). niDatagram :: NameInfoFlags niDatagram = NameInfoFlags (16) {-# LINE 209 "src/System/Socket/Internal/AddressInfo.hsc" #-} -- | @NI_NOFQDN@: Return only the hostname part of the fully qualified domain name for local hosts. niNoFullyQualifiedDomainName :: NameInfoFlags niNoFullyQualifiedDomainName = NameInfoFlags (4) {-# LINE 213 "src/System/Socket/Internal/AddressInfo.hsc" #-} -- | @NI_NUMERICHOST@: Return the numeric form of the host address. niNumericHost :: NameInfoFlags niNumericHost = NameInfoFlags (1) {-# LINE 217 "src/System/Socket/Internal/AddressInfo.hsc" #-} -- | @NI_NUMERICSERV@: Return the numeric form of the service address. niNumericService :: NameInfoFlags niNumericService = NameInfoFlags (2) {-# LINE 221 "src/System/Socket/Internal/AddressInfo.hsc" #-} -- | This class is for address families that support name resolution. class (Family f) => HasAddressInfo f where -- | Maps names to addresses (i.e. by DNS lookup). -- -- The operation throws `AddressInfoException`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. -- -- > getAddressInfo (Just "www.haskell.org") (Just "https") mempty :: IO [AddressInfo Inet Stream TCP] -- > > [AddressInfo {addressInfoFlags = AddressInfoFlags 0, socketAddress = SocketAddressInet {inetAddress = InetAddress 162.242.239.16, inetPort = InetPort 443}, canonicalName = Nothing}] -- -- > > getAddressInfo (Just "www.haskell.org") (Just "80") aiV4Mapped :: IO [AddressInfo Inet6 Stream TCP] -- > [AddressInfo { -- > addressInfoFlags = AddressInfoFlags 8, -- > socketAddress = SocketAddressInet6 {inet6Address = Inet6Address 2400:cb00:2048:0001:0000:0000:6ca2:cc3c, inet6Port = Inet6Port 80, inet6FlowInfo = Inet6FlowInfo 0, inet6ScopeId = Inet6ScopeId 0}, -- > canonicalName = Nothing }] -- -- > > getAddressInfo (Just "darcs.haskell.org") Nothing aiV4Mapped :: IO [AddressInfo Inet6 Stream TCP] -- > [AddressInfo { -- > addressInfoFlags = AddressInfoFlags 8, -- > socketAddress = SocketAddressInet6 {inet6Address = Inet6Address 0000:0000:0000:0000:0000:ffff:17fd:e1ad, inet6Port = Inet6Port 0, inet6FlowInfo = Inet6FlowInfo 0, inet6ScopeId = Inet6ScopeId 0}, -- > canonicalName = Nothing }] -- > > getAddressInfo (Just "darcs.haskell.org") Nothing mempty :: IO [AddressInfo Inet6 Stream TCP] -- > *** Exception: AddressInfoException "Name or service not known" 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 266 "src/System/Socket/Internal/AddressInfo.hsc" #-} -- properly initialize the struct c_memset addrInfoPtr 0 (48) {-# LINE 268 "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 287 "src/System/Socket/Internal/AddressInfo.hsc" #-} ai_family = ((\hsc_ptr -> hsc_ptr `plusPtr` 4)) :: Ptr (AddressInfo a t p) -> Ptr CInt {-# LINE 288 "src/System/Socket/Internal/AddressInfo.hsc" #-} ai_socktype = ((\hsc_ptr -> hsc_ptr `plusPtr` 8)) :: Ptr (AddressInfo a t p) -> Ptr CInt {-# LINE 289 "src/System/Socket/Internal/AddressInfo.hsc" #-} ai_protocol = ((\hsc_ptr -> hsc_ptr `plusPtr` 12)) :: Ptr (AddressInfo a t p) -> Ptr CInt {-# LINE 290 "src/System/Socket/Internal/AddressInfo.hsc" #-} ai_addr = ((\hsc_ptr -> hsc_ptr `plusPtr` 24)) :: Ptr (AddressInfo a t p) -> Ptr (Ptr a) {-# LINE 291 "src/System/Socket/Internal/AddressInfo.hsc" #-} ai_canonname = ((\hsc_ptr -> hsc_ptr `plusPtr` 32)) :: Ptr (AddressInfo a t p) -> Ptr CString {-# LINE 292 "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 293 "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) -- | A `NameInfo` consists of host and service name. data NameInfo = NameInfo { hostName :: BS.ByteString , serviceName :: BS.ByteString } deriving (Eq, Show) -- | This class is for address families that support reverse name resolution. class (Family f) => HasNameInfo f where -- | (Reverse-)map an address back to a human-readable host- and service name. -- -- The operation throws `AddressInfoException`s. -- -- > > getNameInfo (SocketAddressInet inetLoopback 80) mempty -- > NameInfo {hostName = "localhost.localdomain", serviceName = "http"} 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 339 "src/System/Socket/Internal/AddressInfo.hsc" #-} allocaBytes (32) $ \servPtr-> do {-# LINE 340 "src/System/Socket/Internal/AddressInfo.hsc" #-} poke addrPtr addr e <- c_getnameinfo addrPtr (fromIntegral $ sizeOf addr) hostPtr (1025) {-# LINE 343 "src/System/Socket/Internal/AddressInfo.hsc" #-} servPtr (32) {-# LINE 344 "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)