module Network.HTTP2.Server.Config where

import Data.IORef
import Foreign.Marshal.Alloc (mallocBytes, free)
import Network.Socket
import Network.Socket.ByteString (sendAll)

import Network.HPACK
import Network.HTTP2.Server.API
import Network.HTTP2.Server.File
import Network.HTTP2.Server.ReadN

{-# DEPRECATED makeSimpleConfig "Use allocSimpleConfig instead" #-}
-- | Making configuration whose IO is not efficient.
--   A write buffer is allocated internally.
--   That should be deallocated by the returned action.
makeSimpleConfig :: Socket -> BufferSize -> IO (Config, IO ())
makeSimpleConfig :: Socket -> BufferSize -> IO (Config, IO ())
makeSimpleConfig Socket
s BufferSize
bufsiz = do
    Config
config <- Socket -> BufferSize -> IO Config
allocSimpleConfig Socket
s BufferSize
bufsiz
    (Config, IO ()) -> IO (Config, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Config
config, Config -> IO ()
freeSimpleConfig Config
config)

-- | Making simple configuration whose IO is not efficient.
--   A write buffer is allocated internally.
allocSimpleConfig :: Socket -> BufferSize -> IO Config
allocSimpleConfig :: Socket -> BufferSize -> IO Config
allocSimpleConfig Socket
s BufferSize
bufsiz = do
    Ptr Word8
buf <- BufferSize -> IO (Ptr Word8)
forall a. BufferSize -> IO (Ptr a)
mallocBytes BufferSize
bufsiz
    IORef (Maybe ByteString)
ref <- Maybe ByteString -> IO (IORef (Maybe ByteString))
forall a. a -> IO (IORef a)
newIORef Maybe ByteString
forall a. Maybe a
Nothing
    let config :: Config
config = Config :: Ptr Word8
-> BufferSize
-> (ByteString -> IO ())
-> (BufferSize -> IO ByteString)
-> PositionReadMaker
-> Config
Config {
            confWriteBuffer :: Ptr Word8
confWriteBuffer = Ptr Word8
buf
          , confBufferSize :: BufferSize
confBufferSize = BufferSize
bufsiz
          , confSendAll :: ByteString -> IO ()
confSendAll = Socket -> ByteString -> IO ()
sendAll Socket
s
          , confReadN :: BufferSize -> IO ByteString
confReadN = Socket -> IORef (Maybe ByteString) -> BufferSize -> IO ByteString
defaultReadN Socket
s IORef (Maybe ByteString)
ref
          , confPositionReadMaker :: PositionReadMaker
confPositionReadMaker = PositionReadMaker
defaultPositionReadMaker
          }
    Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
config

-- | Deallocating the resource of the simple configuration.
freeSimpleConfig :: Config -> IO ()
freeSimpleConfig :: Config -> IO ()
freeSimpleConfig Config
conf = Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
free (Ptr Word8 -> IO ()) -> Ptr Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ Config -> Ptr Word8
confWriteBuffer Config
conf