{-# 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] }