    {-# LANGUAGE BangPatterns       #-}
    {-# LANGUAGE CPP                #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE OverloadedStrings  #-}

    module Snap.Internal.Http.Server.Address
      ( getHostAddr
      , getHostAddrImpl
      , getSockAddr
      , getSockAddrImpl
      , getAddress
      , getAddressImpl
      , AddressNotSupportedException(..)
      ) where

    ------------------------------------------------------------------------------
    #if !MIN_VERSION_base(4,8,0)
    import           Control.Applicative   ((<$>))
    #endif
    import           Control.Exception     (Exception, throwIO)
    import           Control.Monad         (liftM)
    import           Data.ByteString.Char8 (ByteString)
    import qualified Data.ByteString.Char8 as S
    import           Data.Maybe            (fromMaybe)
    import qualified Data.Text             as T
    import qualified Data.Text.Encoding    as T
    import           Data.Typeable         (Typeable)
    import           Network.Socket        (AddrInfo (addrAddress, addrFamily, addrFlags, addrSocketType), AddrInfoFlag (AI_NUMERICSERV, AI_PASSIVE), Family (AF_INET, AF_INET6), HostName, NameInfoFlag (NI_NUMERICHOST), ServiceName, SockAddr (SockAddrInet, SockAddrInet6, SockAddrUnix), SocketType (Stream), defaultHints, getAddrInfo, getNameInfo)

    ------------------------------------------------------------------------------
    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

    ------------------------------------------------------------------------------
    getHostAddr :: SockAddr -> IO String
    getHostAddr :: SockAddr -> IO String
    getHostAddr = ([NameInfoFlag]
     -> Bool -> Bool -> SockAddr -> IO (Maybe String, Maybe String))
    -> SockAddr -> IO String
    getHostAddrImpl [NameInfoFlag]
    -> Bool -> Bool -> SockAddr -> IO (Maybe String, Maybe String)
    getNameInfo

    ------------------------------------------------------------------------------
    getHostAddrImpl :: ([NameInfoFlag]
                        -> Bool
                        -> Bool
                        -> SockAddr
                        -> IO (Maybe HostName, Maybe ServiceName))
                    -> SockAddr
                    -> IO String
    getHostAddrImpl :: ([NameInfoFlag]
     -> Bool -> Bool -> SockAddr -> IO (Maybe String, Maybe String))
    -> SockAddr -> IO String
    getHostAddrImpl ![NameInfoFlag]
    -> Bool -> Bool -> SockAddr -> IO (Maybe String, Maybe String)
    _getNameInfo SockAddr
    addr =
        (String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    "" (Maybe String -> String)
    -> ((Maybe String, Maybe String) -> Maybe String)
    -> (Maybe String, Maybe String)
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Maybe String, Maybe String) -> Maybe String
    forall a b. (a, b) -> a
    fst) ((Maybe String, Maybe String) -> String)
    -> IO (Maybe String, Maybe String) -> IO String
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` [NameInfoFlag]
    -> Bool -> Bool -> SockAddr -> IO (Maybe String, Maybe String)
    _getNameInfo [NameInfoFlag
    NI_NUMERICHOST] Bool
    True Bool
    False SockAddr
    addr

    ------------------------------------------------------------------------------
    getAddress :: SockAddr -> IO (Int, ByteString)
    getAddress :: SockAddr -> IO (Int, ByteString)
    getAddress = (SockAddr -> IO String) -> SockAddr -> IO (Int, ByteString)
    getAddressImpl SockAddr -> IO String
    getHostAddr

    ------------------------------------------------------------------------------
    getAddressImpl :: (SockAddr -> IO String) -> SockAddr -> IO (Int, ByteString)
    getAddressImpl :: (SockAddr -> IO String) -> SockAddr -> IO (Int, ByteString)
    getAddressImpl !SockAddr -> IO String
    _getHostAddr SockAddr
    addr =
      case SockAddr
    addr of
        SockAddrInet PortNumber
    p HostAddress
    _      -> Int -> IO (Int, ByteString)
    forall {a}. a -> IO (a, ByteString)
    host (PortNumber -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral PortNumber
    p)
        SockAddrInet6 PortNumber
    p HostAddress
    _ HostAddress6
    _ HostAddress
    _ -> Int -> IO (Int, ByteString)
    forall {a}. a -> IO (a, ByteString)
    host (PortNumber -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral PortNumber
    p)
        SockAddrUnix String
    path     -> (Int, ByteString) -> IO (Int, ByteString)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (-Int
    1, String -> ByteString
    prefix String
    path)
    #if MIN_VERSION_network(2,6,0)
        SockAddr
    _                     -> String -> IO (Int, ByteString)
    forall a. String -> IO a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Unsupported address type"
    #endif
      where
        prefix :: String -> ByteString
    prefix String
    path = Text -> ByteString
    T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
    forall a b. (a -> b) -> a -> b
    $! String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ String
    "unix:" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    path
        host :: a -> IO (a, ByteString)
    host a
    port   = (,) a
    port (ByteString -> (a, ByteString))
    -> (String -> ByteString) -> String -> (a, ByteString)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ByteString
    S.pack (String -> (a, ByteString)) -> IO String -> IO (a, ByteString)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SockAddr -> IO String
    _getHostAddr SockAddr
    addr

    ------------------------------------------------------------------------------
    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 =
        case () of
          !()
    _ | ByteString
    s ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "*" -> (AddrInfo -> Bool)
    -> Maybe AddrInfo
    -> Maybe String
    -> Maybe String
    -> IO (Family, SockAddr)
    getAddrs AddrInfo -> Bool
    isIPv4 (AddrInfo -> Maybe AddrInfo
    forall a. a -> Maybe a
    Just AddrInfo
    wildhints) Maybe String
    forall a. Maybe a
    Nothing (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)
             | ByteString
    s ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "::" -> (AddrInfo -> Bool)
    -> Maybe AddrInfo
    -> Maybe String
    -> Maybe String
    -> IO (Family, SockAddr)
    getAddrs AddrInfo -> Bool
    isIPv6 (AddrInfo -> Maybe AddrInfo
    forall a. a -> Maybe a
    Just AddrInfo
    wildhints) Maybe String
    forall a. Maybe a
    Nothing (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)
             | Bool
    otherwise -> (AddrInfo -> Bool)
    -> Maybe AddrInfo
    -> Maybe String
    -> Maybe String
    -> IO (Family, SockAddr)
    getAddrs (Bool -> AddrInfo -> Bool
    forall a b. a -> b -> a
    const Bool
    True) (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)

      where
        isIPv4 :: AddrInfo -> Bool
    isIPv4 AddrInfo
    ai = AddrInfo -> Family
    addrFamily AddrInfo
    ai Family -> Family -> Bool
    forall a. Eq a => a -> a -> Bool
    == Family
    AF_INET
        isIPv6 :: AddrInfo -> Bool
    isIPv6 AddrInfo
    ai = AddrInfo -> Family
    addrFamily AddrInfo
    ai Family -> Family -> Bool
    forall a. Eq a => a -> a -> Bool
    == Family
    AF_INET6

        getAddrs :: (AddrInfo -> Bool)
    -> Maybe AddrInfo
    -> Maybe String
    -> Maybe String
    -> IO (Family, SockAddr)
    getAddrs AddrInfo -> Bool
    flt Maybe AddrInfo
    a Maybe String
    b Maybe String
    c = do
            ais <- (AddrInfo -> Bool) -> [AddrInfo] -> [AddrInfo]
    forall a. (a -> Bool) -> [a] -> [a]
    filter AddrInfo -> Bool
    flt ([AddrInfo] -> [AddrInfo]) -> IO [AddrInfo] -> IO [AddrInfo]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
    _getAddrInfo Maybe AddrInfo
    a Maybe String
    b Maybe String
    c
            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)

        wildhints :: AddrInfo
    wildhints = AddrInfo
    hints { addrFlags = [AI_NUMERICSERV, AI_PASSIVE] }
        hints :: AddrInfo
    hints = AddrInfo
    defaultHints { addrFlags = [AI_NUMERICSERV]
                             , addrSocketType = Stream
                             }