module Snap.Internal.Http.Server.Address
( getHostAddr
, getSockAddr
, getAddress
) where
import Network.Socket
import Data.Maybe
import Control.Monad
import Control.Exception
import Data.Typeable
import Data.ByteString (ByteString)
import qualified Data.ByteString as S
import Data.ByteString.Char8 ()
import Data.ByteString.Internal (c2w, w2c)
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 == "*" = ipV4Addr p iNADDR_ANY
getSockAddr p s | s == "::" = ipV6Addr p iN6ADDR_ANY
getSockAddr p s = do
let hints = defaultHints { addrFlags = [AI_NUMERICHOST] }
ai <- getAddrInfo (Just hints) (Just $ map w2c $ S.unpack s) Nothing
if ai == [] then throwIO $ AddressNotSupportedException $ show s
else do
case addrAddress $ head ai of
SockAddrInet _ h -> ipV4Addr p h
SockAddrInet6 _ _ h _ -> ipV6Addr p h
x -> throwIO $ AddressNotSupportedException $ show x
ipV4Addr :: Int -> HostAddress -> IO (Family, SockAddr)
ipV4Addr p h = return (AF_INET, SockAddrInet (fromIntegral p) h)
ipV6Addr :: Int -> HostAddress6 -> IO (Family, SockAddr)
ipV6Addr p h = return (AF_INET6, SockAddrInet6 (fromIntegral p) 0 h 0)