{-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} module Network.Wai.Handler.Warp.HTTP2.PushPromise where import qualified Network.HTTP.Types as H import qualified Network.HTTP2.Server as H2 import qualified UnliftIO 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 = [PushPromise] -> (HTTP2Data -> [PushPromise]) -> Maybe HTTP2Data -> [PushPromise] forall b a. b -> (a -> b) -> Maybe a -> b maybe [] HTTP2Data -> [PushPromise] http2dataPushPromise Maybe HTTP2Data mh2data [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) forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 (m :: * -> *) a. MonadUnliftIO m => m a -> m (Either IOException a) UnliftIO.tryIO (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 :: UnliftIO.IOException) -> Maybe PushPromise -> IO (Maybe PushPromise) forall a. a -> IO a 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 a. a -> IO a 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