{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Network.Wai.Handler.Warp.HTTP2.PushPromise where

import qualified Control.Exception as E
import qualified Network.HTTP.Types as H
import qualified Network.HTTP2.Server as H2

import Network.Wai
import Network.Wai.Handler.Warp.FileInfoCache
import Network.Wai.Handler.Warp.HTTP2.Request (getHTTP2Data)
import Network.Wai.Handler.Warp.HTTP2.Types
import Network.Wai.Handler.Warp.Imports
import Network.Wai.Handler.Warp.Types

fromPushPromises :: InternalInfo -> Request -> IO [H2.PushPromise]
fromPushPromises :: InternalInfo -> Request -> IO [PushPromise]
fromPushPromises InternalInfo
ii Request
req = do
    Maybe HTTP2Data
mh2data <- Request -> IO (Maybe HTTP2Data)
getHTTP2Data Request
req
    let pp :: [PushPromise]
pp = case Maybe HTTP2Data
mh2data of
          Maybe HTTP2Data
Nothing     -> []
          Just HTTP2Data
h2data -> HTTP2Data -> [PushPromise]
http2dataPushPromise HTTP2Data
h2data
    [Maybe PushPromise] -> [PushPromise]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe PushPromise] -> [PushPromise])
-> IO [Maybe PushPromise] -> IO [PushPromise]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PushPromise -> IO (Maybe PushPromise))
-> [PushPromise] -> IO [Maybe PushPromise]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (InternalInfo -> PushPromise -> IO (Maybe PushPromise)
fromPushPromise InternalInfo
ii) [PushPromise]
pp

fromPushPromise :: InternalInfo -> PushPromise -> IO (Maybe H2.PushPromise)
fromPushPromise :: InternalInfo -> PushPromise -> IO (Maybe PushPromise)
fromPushPromise InternalInfo
ii (PushPromise ByteString
path FilePath
file ResponseHeaders
rsphdr Weight
w) = do
    Either IOException FileInfo
efinfo <- IO FileInfo -> IO (Either IOException FileInfo)
forall e a. Exception e => IO a -> IO (Either e a)
E.try (IO FileInfo -> IO (Either IOException FileInfo))
-> IO FileInfo -> IO (Either IOException FileInfo)
forall a b. (a -> b) -> a -> b
$ InternalInfo -> FilePath -> IO FileInfo
getFileInfo InternalInfo
ii FilePath
file
    case Either IOException FileInfo
efinfo of
      Left (IOException
_ex :: E.IOException) -> Maybe PushPromise -> IO (Maybe PushPromise)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PushPromise
forall a. Maybe a
Nothing
      Right FileInfo
finfo -> do
          let !siz :: ByteCount
siz = Integer -> ByteCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> ByteCount) -> Integer -> ByteCount
forall a b. (a -> b) -> a -> b
$ FileInfo -> Integer
fileInfoSize FileInfo
finfo
              !fileSpec :: FileSpec
fileSpec = FilePath -> ByteCount -> ByteCount -> FileSpec
H2.FileSpec FilePath
file ByteCount
0 ByteCount
siz
              !rsp :: Response
rsp = Status -> ResponseHeaders -> FileSpec -> Response
H2.responseFile Status
H.ok200 ResponseHeaders
rsphdr FileSpec
fileSpec
              !pp :: PushPromise
pp = ByteString -> Response -> Weight -> PushPromise
H2.pushPromise ByteString
path Response
rsp Weight
w
          Maybe PushPromise -> IO (Maybe PushPromise)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PushPromise -> IO (Maybe PushPromise))
-> Maybe PushPromise -> IO (Maybe PushPromise)
forall a b. (a -> b) -> a -> b
$ PushPromise -> Maybe PushPromise
forall a. a -> Maybe a
Just PushPromise
pp