-- copy of all/alarm/alarm-log-server-chronicle/app/UnzipRequest.hs
{-# LANGUAGE OverloadedStrings #-}
-- See module description for the reasong for ignoring deprecations.
{-# OPTIONS_GHC -Wno-deprecations #-}

-- | Quarantines a function that uses a deprecated requestBody field.
-- We use Network.Wai's requestBody to create a response but it is deprecated.
-- But we are using it for the same purpose as they are, and they disable deprecations to work around their own deprecated field, so we do the same.
-- See https://github.com/yesodweb/wai/blob/e15f41ba20dbd94b511048692541ca89117f1f7c/wai/Network/Wai.hs#L34-L35
module Inferno.VersionControl.Server.UnzipRequest where

import Codec.Compression.GZip (decompress)
import qualified Data.ByteString.Lazy as BL
import Network.Wai

ungzipRequest :: Middleware
ungzipRequest :: Middleware
ungzipRequest Application
app Request
req = Application
app Request
req'
  where
    req' :: Request
req'
      | Just ByteString
"gzip" <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"Content-encoding" (Request -> RequestHeaders
requestHeaders Request
req) = Request -> Request
go Request
req
      | Bool
otherwise = Request
req
    go :: Request -> Request
go Request
r = Request
r {requestBody :: IO ByteString
requestBody = ByteString -> ByteString
decompressNonEmpty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Request -> IO ByteString
strictRequestBody Request
r)}
    decompressNonEmpty :: ByteString -> ByteString
decompressNonEmpty ByteString
"" = ByteString
"" -- Necessary 'cause the IO gets pulled until requestBody gives ""
    decompressNonEmpty ByteString
x = ByteString -> ByteString
BL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
decompress forall a b. (a -> b) -> a -> b
$ ByteString
x