    {-# 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]
    forall (t :: * -> *).
    GetAddrInfo t =>
    Maybe AddrInfo -> Maybe String -> Maybe String -> IO (t 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
        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 null ais
          then throwIO $ AddressNotSupportedException $ show s
          else do
            let !ai = [AddrInfo] -> AddrInfo
    forall a. HasCallStack => [a] -> a
    head [AddrInfo]
    ais
            let !fm = AddrInfo -> Family
    addrFamily AddrInfo
    ai
            let !sa = AddrInfo -> SockAddr
    addrAddress AddrInfo
    ai
            return (fm, sa)
      where
        hints :: AddrInfo
    hints = AddrInfo
    defaultHints { addrFlags = [AI_NUMERICSERV] }