{-# LANGUAGE CPP #-}
module Data.Streaming.Network.Internal
    ( ServerSettings (..)
    , ClientSettings (..)
    , HostPreference (..)
    , Message (..)
    , AppData (..)
#if !WINDOWS
    , ServerSettingsUnix (..)
    , ClientSettingsUnix (..)
    , AppDataUnix (..)
#endif
    ) where

import Data.String (IsString (..))
import Data.ByteString (ByteString)
import Network.Socket (Socket, SockAddr, Family)

-- | Settings for a TCP server. It takes a port to listen on, and an optional
-- hostname to bind to.
data ServerSettings = ServerSettings
    { ServerSettings -> Int
serverPort :: !Int
    , ServerSettings -> HostPreference
serverHost :: !HostPreference
    , ServerSettings -> Maybe Socket
serverSocket :: !(Maybe Socket) -- ^ listening socket
    , ServerSettings -> Socket -> IO ()
serverAfterBind :: !(Socket -> IO ())
    , ServerSettings -> Bool
serverNeedLocalAddr :: !Bool
    , ServerSettings -> Int
serverReadBufferSize :: !Int
    }

-- | Settings for a TCP client, specifying how to connect to the server.
data ClientSettings = ClientSettings
    { ClientSettings -> Int
clientPort :: !Int
    , ClientSettings -> ByteString
clientHost :: !ByteString
    , ClientSettings -> Family
clientAddrFamily :: !Family
    , ClientSettings -> Int
clientReadBufferSize :: !Int
    }

-- | Which host to bind.
--
-- Note: The @IsString@ instance recognizes the following special values:
--
-- * @*@ means @HostAny@ - "any IPv4 or IPv6 hostname"
--
-- * @*4@ means @HostIPv4@ - "any IPv4 or IPv6 hostname, IPv4 preferred"
--
-- * @!4@ means @HostIPv4Only@ - "any IPv4 hostname"
--
-- * @*6@ means @HostIPv6@@ - "any IPv4 or IPv6 hostname, IPv6 preferred"
--
-- * @!6@ means @HostIPv6Only@ - "any IPv6 hostname"
--
-- Note that the permissive @*@ values allow binding to an IPv4 or an
-- IPv6 hostname, which means you might be able to successfully bind
-- to a port more times than you expect (eg once on the IPv4 localhost
-- 127.0.0.1 and again on the IPv6 localhost 0:0:0:0:0:0:0:1).
--
-- Any other value is treated as a hostname. As an example, to bind to the
-- IPv4 local host only, use \"127.0.0.1\".
data HostPreference =
    HostAny
  | HostIPv4
  | HostIPv4Only
  | HostIPv6
  | HostIPv6Only
  | Host String
    deriving (HostPreference -> HostPreference -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HostPreference -> HostPreference -> Bool
$c/= :: HostPreference -> HostPreference -> Bool
== :: HostPreference -> HostPreference -> Bool
$c== :: HostPreference -> HostPreference -> Bool
Eq, Eq HostPreference
HostPreference -> HostPreference -> Bool
HostPreference -> HostPreference -> Ordering
HostPreference -> HostPreference -> HostPreference
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HostPreference -> HostPreference -> HostPreference
$cmin :: HostPreference -> HostPreference -> HostPreference
max :: HostPreference -> HostPreference -> HostPreference
$cmax :: HostPreference -> HostPreference -> HostPreference
>= :: HostPreference -> HostPreference -> Bool
$c>= :: HostPreference -> HostPreference -> Bool
> :: HostPreference -> HostPreference -> Bool
$c> :: HostPreference -> HostPreference -> Bool
<= :: HostPreference -> HostPreference -> Bool
$c<= :: HostPreference -> HostPreference -> Bool
< :: HostPreference -> HostPreference -> Bool
$c< :: HostPreference -> HostPreference -> Bool
compare :: HostPreference -> HostPreference -> Ordering
$ccompare :: HostPreference -> HostPreference -> Ordering
Ord, Int -> HostPreference -> ShowS
[HostPreference] -> ShowS
HostPreference -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HostPreference] -> ShowS
$cshowList :: [HostPreference] -> ShowS
show :: HostPreference -> String
$cshow :: HostPreference -> String
showsPrec :: Int -> HostPreference -> ShowS
$cshowsPrec :: Int -> HostPreference -> ShowS
Show, ReadPrec [HostPreference]
ReadPrec HostPreference
Int -> ReadS HostPreference
ReadS [HostPreference]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HostPreference]
$creadListPrec :: ReadPrec [HostPreference]
readPrec :: ReadPrec HostPreference
$creadPrec :: ReadPrec HostPreference
readList :: ReadS [HostPreference]
$creadList :: ReadS [HostPreference]
readsPrec :: Int -> ReadS HostPreference
$creadsPrec :: Int -> ReadS HostPreference
Read)

instance IsString HostPreference where
    fromString :: String -> HostPreference
fromString String
"*" = HostPreference
HostAny
    fromString String
"*4" = HostPreference
HostIPv4
    fromString String
"!4" = HostPreference
HostIPv4Only
    fromString String
"*6" = HostPreference
HostIPv6
    fromString String
"!6" = HostPreference
HostIPv6Only
    fromString String
s = String -> HostPreference
Host String
s

#if !WINDOWS
-- | Settings for a Unix domain sockets server.
data ServerSettingsUnix = ServerSettingsUnix
    { ServerSettingsUnix -> String
serverPath :: !FilePath
    , ServerSettingsUnix -> Socket -> IO ()
serverAfterBindUnix :: !(Socket -> IO ())
    , ServerSettingsUnix -> Int
serverReadBufferSizeUnix :: !Int
    }

-- | Settings for a Unix domain sockets client.
data ClientSettingsUnix = ClientSettingsUnix
    { ClientSettingsUnix -> String
clientPath :: !FilePath
    , ClientSettingsUnix -> Int
clientReadBufferSizeUnix :: !Int
    }

-- | The data passed to a Unix domain sockets @Application@.
data AppDataUnix = AppDataUnix
    { AppDataUnix -> IO ByteString
appReadUnix :: !(IO ByteString)
    , AppDataUnix -> ByteString -> IO ()
appWriteUnix :: !(ByteString -> IO ())
    }
#endif

-- | Representation of a single UDP message
data Message = Message { Message -> ByteString
msgData :: {-# UNPACK #-} !ByteString
                       , Message -> SockAddr
msgSender :: !SockAddr
                       }

-- | The data passed to an @Application@.
data AppData = AppData
    { AppData -> IO ByteString
appRead' :: !(IO ByteString)
    , AppData -> ByteString -> IO ()
appWrite' :: !(ByteString -> IO ())
    , AppData -> SockAddr
appSockAddr' :: !SockAddr
    , AppData -> Maybe SockAddr
appLocalAddr' :: !(Maybe SockAddr)
    , AppData -> IO ()
appCloseConnection' :: !(IO ())
    , AppData -> Maybe Socket
appRawSocket' :: Maybe Socket
    }