module Snap.Internal.Http.Server.Address
( getHostAddr
, getSockAddr
, getAddress
) where
import Control.Exception
import Control.Monad
import Data.ByteString (ByteString)
import qualified Data.ByteString as S
import Data.ByteString.Char8 ()
import Data.ByteString.Internal (c2w, w2c)
import Data.Maybe
import Data.Typeable
import Network.Socket
data AddressNotSupportedException = AddressNotSupportedException String
deriving (Typeable)
instance Show AddressNotSupportedException where
show (AddressNotSupportedException x) = "Address not supported: " ++ x
instance Exception AddressNotSupportedException
getHostAddr :: SockAddr -> IO String
getHostAddr addr =
(fromMaybe "" . fst) `liftM` getNameInfo [NI_NUMERICHOST] True False addr
getAddress :: SockAddr -> IO (Int, ByteString)
getAddress addr = do
port <- case addr of
SockAddrInet p _ -> return p
SockAddrInet6 p _ _ _ -> return p
x -> throwIO $ AddressNotSupportedException $ show x
host <- getHostAddr addr
return (fromIntegral port, S.pack $ map c2w host)
getSockAddr :: Int
-> ByteString
-> IO (Family, SockAddr)
getSockAddr p s | s == "*" =
return $! ( AF_INET
, SockAddrInet (fromIntegral p) iNADDR_ANY
)
getSockAddr p s | s == "::" =
return $! ( AF_INET6
, SockAddrInet6 (fromIntegral p) 0 iN6ADDR_ANY 0
)
getSockAddr p s = do
let hints = defaultHints { addrFlags = [AI_NUMERICSERV]
, addrSocketType = Stream }
ais <- getAddrInfo (Just hints) (Just $ map w2c $ S.unpack s)
(Just $ show p)
if null ais
then throwIO $ AddressNotSupportedException $ show s
else do
let ai = head ais
let fm = addrFamily ai
let sa = addrAddress ai
return (fm, sa)