{-# LANGUAGE CPP #-}
--------------------------------------------------------------------------------
module Network.WebSockets.Connection.Options
    ( ConnectionOptions (..)
    , defaultConnectionOptions

    , CompressionOptions (..)
    , PermessageDeflate (..)
    , defaultPermessageDeflate

    , SizeLimit (..)
    , atMostSizeLimit
    ) where


--------------------------------------------------------------------------------
import           Data.Int    (Int64)
import           Data.Monoid (Monoid (..))
import           Prelude


--------------------------------------------------------------------------------
-- | Set options for a 'Connection'.  Please do not use this constructor
-- directly, but rather use 'defaultConnectionOptions' and then set the fields
-- you want, e.g.:
--
-- > myOptions = defaultConnectionOptions {connectionStrictUnicode = True}
--
-- This way your code does not break if the library introduces new fields.
data ConnectionOptions = ConnectionOptions
    { ConnectionOptions -> IO ()
connectionOnPong                :: !(IO ())
      -- ^ Whenever a 'pong' is received, this IO action is executed. It can be
      -- used to tickle connections or fire missiles.
    , ConnectionOptions -> CompressionOptions
connectionCompressionOptions    :: !CompressionOptions
      -- ^ Enable 'PermessageDeflate'.
    , ConnectionOptions -> Bool
connectionStrictUnicode         :: !Bool
      -- ^ Enable strict unicode on the connection.  This means that if a client
      -- (or server) sends invalid UTF-8, we will throw a 'UnicodeException'
      -- rather than replacing it by the unicode replacement character U+FFFD.
    , ConnectionOptions -> SizeLimit
connectionFramePayloadSizeLimit :: !SizeLimit
      -- ^ The maximum size for incoming frame payload size in bytes.  If a
      -- frame exceeds this limit, a 'ParseException' is thrown.
    , ConnectionOptions -> SizeLimit
connectionMessageDataSizeLimit  :: !SizeLimit
      -- ^ 'connectionFrameSizeLimit' is often not enough since a malicious
      -- client can send many small frames to create a huge message.  This limit
      -- allows you to protect from that.  If a message exceeds this limit, a
      -- 'ParseException' is thrown.
      --
      -- Note that, if compression is enabled, we check the size of the
      -- compressed messages, as well as the size of the uncompressed messages
      -- as we are deflating them to ensure we don't use too much memory in any
      -- case.
    }


--------------------------------------------------------------------------------
-- | The default connection options:
--
-- * Nothing happens when a pong is received.
-- * Compression is disabled.
-- * Lenient unicode decoding.
defaultConnectionOptions :: ConnectionOptions
defaultConnectionOptions :: ConnectionOptions
defaultConnectionOptions = ConnectionOptions :: IO ()
-> CompressionOptions
-> Bool
-> SizeLimit
-> SizeLimit
-> ConnectionOptions
ConnectionOptions
    { connectionOnPong :: IO ()
connectionOnPong                = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    , connectionCompressionOptions :: CompressionOptions
connectionCompressionOptions    = CompressionOptions
NoCompression
    , connectionStrictUnicode :: Bool
connectionStrictUnicode         = Bool
False
    , connectionFramePayloadSizeLimit :: SizeLimit
connectionFramePayloadSizeLimit = SizeLimit
forall a. Monoid a => a
mempty
    , connectionMessageDataSizeLimit :: SizeLimit
connectionMessageDataSizeLimit  = SizeLimit
forall a. Monoid a => a
mempty
    }


--------------------------------------------------------------------------------
data CompressionOptions
    = NoCompression
    | PermessageDeflateCompression PermessageDeflate
    deriving (CompressionOptions -> CompressionOptions -> Bool
(CompressionOptions -> CompressionOptions -> Bool)
-> (CompressionOptions -> CompressionOptions -> Bool)
-> Eq CompressionOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompressionOptions -> CompressionOptions -> Bool
$c/= :: CompressionOptions -> CompressionOptions -> Bool
== :: CompressionOptions -> CompressionOptions -> Bool
$c== :: CompressionOptions -> CompressionOptions -> Bool
Eq, Int -> CompressionOptions -> ShowS
[CompressionOptions] -> ShowS
CompressionOptions -> String
(Int -> CompressionOptions -> ShowS)
-> (CompressionOptions -> String)
-> ([CompressionOptions] -> ShowS)
-> Show CompressionOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompressionOptions] -> ShowS
$cshowList :: [CompressionOptions] -> ShowS
show :: CompressionOptions -> String
$cshow :: CompressionOptions -> String
showsPrec :: Int -> CompressionOptions -> ShowS
$cshowsPrec :: Int -> CompressionOptions -> ShowS
Show)


--------------------------------------------------------------------------------
-- | Four extension parameters are defined for "permessage-deflate" to
-- help endpoints manage per-connection resource usage.
--
-- - "server_no_context_takeover"
-- - "client_no_context_takeover"
-- - "server_max_window_bits"
-- - "client_max_window_bits"
data PermessageDeflate = PermessageDeflate
    { PermessageDeflate -> Bool
serverNoContextTakeover :: Bool
    , PermessageDeflate -> Bool
clientNoContextTakeover :: Bool
    , PermessageDeflate -> Int
serverMaxWindowBits     :: Int
    , PermessageDeflate -> Int
clientMaxWindowBits     :: Int
    , PermessageDeflate -> Int
pdCompressionLevel      :: Int
    } deriving (PermessageDeflate -> PermessageDeflate -> Bool
(PermessageDeflate -> PermessageDeflate -> Bool)
-> (PermessageDeflate -> PermessageDeflate -> Bool)
-> Eq PermessageDeflate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PermessageDeflate -> PermessageDeflate -> Bool
$c/= :: PermessageDeflate -> PermessageDeflate -> Bool
== :: PermessageDeflate -> PermessageDeflate -> Bool
$c== :: PermessageDeflate -> PermessageDeflate -> Bool
Eq, Int -> PermessageDeflate -> ShowS
[PermessageDeflate] -> ShowS
PermessageDeflate -> String
(Int -> PermessageDeflate -> ShowS)
-> (PermessageDeflate -> String)
-> ([PermessageDeflate] -> ShowS)
-> Show PermessageDeflate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PermessageDeflate] -> ShowS
$cshowList :: [PermessageDeflate] -> ShowS
show :: PermessageDeflate -> String
$cshow :: PermessageDeflate -> String
showsPrec :: Int -> PermessageDeflate -> ShowS
$cshowsPrec :: Int -> PermessageDeflate -> ShowS
Show)


--------------------------------------------------------------------------------
defaultPermessageDeflate :: PermessageDeflate
defaultPermessageDeflate :: PermessageDeflate
defaultPermessageDeflate = Bool -> Bool -> Int -> Int -> Int -> PermessageDeflate
PermessageDeflate Bool
False Bool
False Int
15 Int
15 Int
8


--------------------------------------------------------------------------------
-- | A size limit, in bytes.  The 'Monoid' instance takes the minimum limit.
data SizeLimit
    = NoSizeLimit
    | SizeLimit !Int64
    deriving (SizeLimit -> SizeLimit -> Bool
(SizeLimit -> SizeLimit -> Bool)
-> (SizeLimit -> SizeLimit -> Bool) -> Eq SizeLimit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SizeLimit -> SizeLimit -> Bool
$c/= :: SizeLimit -> SizeLimit -> Bool
== :: SizeLimit -> SizeLimit -> Bool
$c== :: SizeLimit -> SizeLimit -> Bool
Eq, Int -> SizeLimit -> ShowS
[SizeLimit] -> ShowS
SizeLimit -> String
(Int -> SizeLimit -> ShowS)
-> (SizeLimit -> String)
-> ([SizeLimit] -> ShowS)
-> Show SizeLimit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SizeLimit] -> ShowS
$cshowList :: [SizeLimit] -> ShowS
show :: SizeLimit -> String
$cshow :: SizeLimit -> String
showsPrec :: Int -> SizeLimit -> ShowS
$cshowsPrec :: Int -> SizeLimit -> ShowS
Show)


--------------------------------------------------------------------------------
instance Monoid SizeLimit where
    mempty :: SizeLimit
mempty = SizeLimit
NoSizeLimit

#if !MIN_VERSION_base(4,11,0)
    mappend NoSizeLimit   y             = y
    mappend x             NoSizeLimit   = x
    mappend (SizeLimit x) (SizeLimit y) = SizeLimit (min x y)
#else
instance Semigroup SizeLimit where
    <> :: SizeLimit -> SizeLimit -> SizeLimit
(<>)    SizeLimit
NoSizeLimit   SizeLimit
y             = SizeLimit
y
    (<>)    SizeLimit
x             SizeLimit
NoSizeLimit   = SizeLimit
x
    (<>)    (SizeLimit Int64
x) (SizeLimit Int64
y) = Int64 -> SizeLimit
SizeLimit (Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min Int64
x Int64
y)
#endif

--------------------------------------------------------------------------------
atMostSizeLimit :: Int64 -> SizeLimit -> Bool
atMostSizeLimit :: Int64 -> SizeLimit -> Bool
atMostSizeLimit Int64
_ SizeLimit
NoSizeLimit   = Bool
True
atMostSizeLimit Int64
s (SizeLimit Int64
l) = Int64
s Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
l
{-# INLINE atMostSizeLimit #-}