{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
module System.IO.Streams.Network.Internal.Address
( getSockAddr
, getSockAddrImpl
, AddressNotSupportedException(..)
) where
import Control.Exception (Exception, throwIO)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as S
import Data.Typeable (Typeable)
import Network.Socket (AddrInfo (addrAddress, addrFamily, addrFlags), AddrInfoFlag (AI_NUMERICSERV), Family, SockAddr, defaultHints, getAddrInfo)
data AddressNotSupportedException = AddressNotSupportedException String
deriving (Typeable)
instance Show AddressNotSupportedException where
show :: AddressNotSupportedException -> String
show (AddressNotSupportedException String
x) = String
"Address not supported: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
instance Exception AddressNotSupportedException
getSockAddr :: Int
-> ByteString
-> IO (Family, SockAddr)
getSockAddr :: Int -> ByteString -> IO (Family, SockAddr)
getSockAddr = (Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo])
-> Int -> ByteString -> IO (Family, SockAddr)
getSockAddrImpl Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
getAddrInfo
getSockAddrImpl
:: (Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo])
-> Int -> ByteString -> IO (Family, SockAddr)
getSockAddrImpl :: (Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo])
-> Int -> ByteString -> IO (Family, SockAddr)
getSockAddrImpl !Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
_getAddrInfo Int
p ByteString
s = do
[AddrInfo]
ais <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
_getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints) (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ ByteString -> String
S.unpack ByteString
s)
(String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
p)
if [AddrInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [AddrInfo]
ais
then AddressNotSupportedException -> IO (Family, SockAddr)
forall e a. Exception e => e -> IO a
throwIO (AddressNotSupportedException -> IO (Family, SockAddr))
-> AddressNotSupportedException -> IO (Family, SockAddr)
forall a b. (a -> b) -> a -> b
$ String -> AddressNotSupportedException
AddressNotSupportedException (String -> AddressNotSupportedException)
-> String -> AddressNotSupportedException
forall a b. (a -> b) -> a -> b
$ ByteString -> String
forall a. Show a => a -> String
show ByteString
s
else do
let !ai :: AddrInfo
ai = [AddrInfo] -> AddrInfo
forall a. [a] -> a
head [AddrInfo]
ais
let !fm :: Family
fm = AddrInfo -> Family
addrFamily AddrInfo
ai
let !sa :: SockAddr
sa = AddrInfo -> SockAddr
addrAddress AddrInfo
ai
(Family, SockAddr) -> IO (Family, SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Family
fm, SockAddr
sa)
where
hints :: AddrInfo
hints = AddrInfo
defaultHints { addrFlags :: [AddrInfoFlag]
addrFlags = [AddrInfoFlag
AI_NUMERICSERV] }