{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-deprecations #-}

-- |
--
-- Module      : Network.Wai.Handler.Hal
-- Copyright   : (C) 2021 Bellroy Pty Ltd
-- License     : BSD-3-Clause
-- Maintainer  : Bellroy Tech Team <haskell@bellroy.com>
-- Stability   : experimental
--
-- Lifts an 'Wai.Application' so that it can be run using
-- 'AWS.Lambda.Runtime.mRuntime' or
-- 'AWS.Lambda.Runtime.mRuntimeWithContext''. The glue code will look
-- something like this:
--
-- @
-- import AWS.Lambda.Runtime ('AWS.Lambda.Runtime.mRuntime')
-- import Network.Wai (Application)
-- import qualified Network.Wai.Handler.Hal as WaiHandler
--
-- app :: Application
-- app = undefined -- From Servant or wherever else
--
-- main :: IO ()
-- main = 'AWS.Lambda.Runtime.mRuntime' $ WaiHandler.'run' app
-- @
module Network.Wai.Handler.Hal
  ( run,
    runWithContext,
    Options (..),
    defaultOptions,
    toWaiRequest,
    fromWaiResponse,
  )
where

import AWS.Lambda.Context (LambdaContext)
import qualified AWS.Lambda.Events.ApiGateway.ProxyRequest as HalRequest
  ( RequestContext (identity),
  )
import qualified AWS.Lambda.Events.ApiGateway.ProxyRequest as HalRequest hiding
  ( RequestContext (..),
  )
import qualified AWS.Lambda.Events.ApiGateway.ProxyResponse as HalResponse
import Control.Exception (IOException, tryJust)
import Control.Monad.IO.Class (MonadIO (..))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Builder.Extra as Builder
import qualified Data.ByteString.Lazy as BL
import qualified Data.CaseInsensitive as CI
import Data.Function ((&))
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as H
import qualified Data.IORef as IORef
import Data.List (foldl', sort)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Vault.Lazy (Key, Vault)
import qualified Data.Vault.Lazy as Vault
import Network.HTTP.Types.Header
  ( HeaderName,
    ResponseHeaders,
    hContentType,
    hHost,
    hRange,
    hReferer,
    hUserAgent,
  )
import Network.HTTP.Types.URI
  ( Query,
    QueryItem,
    encodePath,
    queryTextToQuery,
    renderQuery,
  )
import Network.HTTP.Types.Version (HttpVersion (..))
import Network.Socket (PortNumber)
import qualified Network.Socket as NS
import qualified Network.Wai as Wai
import qualified Network.Wai.Internal as Wai
import System.IO
  ( IOMode (..),
    SeekMode (..),
    hPutStrLn,
    hSeek,
    stderr,
    withFile,
  )

-- | Convert a WAI 'Wai.Application' into a function that can
-- be run by hal's 'AWS.Lambda.Runtime.mRuntime'. This is the simplest
-- form, and probably all that you'll need. See 'runWithContext' if
-- you have more complex needs.
run ::
  (MonadIO m) =>
  Wai.Application ->
  HalRequest.ProxyRequest HalRequest.NoAuthorizer ->
  m HalResponse.ProxyResponse
run :: forall (m :: * -> *).
MonadIO m =>
Application -> ProxyRequest NoAuthorizer -> m ProxyResponse
run Application
app ProxyRequest NoAuthorizer
req = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  Request
waiReq <- forall a. Options -> ProxyRequest a -> IO Request
toWaiRequest Options
defaultOptions ProxyRequest NoAuthorizer
req
  IORef (Maybe Response)
responseRef <- forall a. a -> IO (IORef a)
IORef.newIORef forall a. Maybe a
Nothing
  ResponseReceived
Wai.ResponseReceived <- Application
app Request
waiReq forall a b. (a -> b) -> a -> b
$ \Response
waiResp ->
    ResponseReceived
Wai.ResponseReceived forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. IORef a -> a -> IO ()
IORef.writeIORef IORef (Maybe Response)
responseRef (forall a. a -> Maybe a
Just Response
waiResp)
  Just Response
waiResp <- forall a. IORef a -> IO a
IORef.readIORef IORef (Maybe Response)
responseRef
  Options -> Response -> IO ProxyResponse
fromWaiResponse Options
defaultOptions Response
waiResp

-- | Options that can be used to customize the behaviour of 'runWithContext'.
-- 'defaultOptions' provides sensible defaults.
data Options = Options
  { -- | Vault of values to share between the application and any
    -- middleware. You can pass in @Data.Vault.Lazy.'Vault.empty'@, or
    -- 'mempty' if you don't want to depend on @vault@ directly.
    Options -> Vault
vault :: Vault,
    -- | API Gateway doesn't tell us the port it's listening on, so you
    -- have to tell it yourself. This is almost always going to be 443
    -- (HTTPS).
    Options -> PortNumber
portNumber :: PortNumber,
    -- | Binary responses need to be encoded as base64. This option lets you
    -- customize which mime types are considered binary data.
    --
    -- The following mime types are __not__ considered binary by default:
    --
    -- * @application/json@
    -- * @application/xml@
    -- * anything starting with @text/@
    -- * anything ending with @+json@
    -- * anything ending with @+xml@
    Options -> Text -> Bool
binaryMimeType :: Text -> Bool
  }

-- | Default options for running 'Wai.Application's on Lambda.
defaultOptions :: Options
defaultOptions :: Options
defaultOptions =
  Options
    { vault :: Vault
vault = Vault
Vault.empty,
      portNumber :: PortNumber
portNumber = PortNumber
443,
      binaryMimeType :: Text -> Bool
binaryMimeType = \Text
mime -> case Text
mime of
        Text
"application/json" -> Bool
False
        Text
"application/xml" -> Bool
False
        Text
_ | Text
"text/" Text -> Text -> Bool
`T.isPrefixOf` Text
mime -> Bool
False
        Text
_ | Text
"+json" Text -> Text -> Bool
`T.isSuffixOf` Text
mime -> Bool
False
        Text
_ | Text
"+xml" Text -> Text -> Bool
`T.isSuffixOf` Text
mime -> Bool
False
        Text
_ -> Bool
True
    }

-- | Convert a WAI 'Wai.Application' into a function that can
-- be run by hal's 'AWS.Lambda.Runtime.mRuntimeWithContext''. This
-- function exposes all the configurable knobs.
runWithContext ::
  (MonadIO m) =>
  -- | Configuration options. 'defaultOptions' provides sensible defaults.
  Options ->
  -- | We pass two 'Vault' keys to the callback that provides the
  -- 'Wai.Application'. This allows the application to look into the
  -- 'Vault' part of each request and read @hal@ data structures, if
  -- necessary:
  --
  -- * The @'Key' 'LambdaContext'@ provides
  --   information about the Lambda invocation, function, and
  --   execution environment; and
  --
  -- * The @'Key' ('HalRequest.ProxyRequest'
  -- 'HalRequest.NoAuthorizer')@ provides the unmodified API Gateway
  -- representation of the HTTP request.
  ( Key LambdaContext ->
    Key (HalRequest.ProxyRequest HalRequest.NoAuthorizer) ->
    Wai.Application
  ) ->
  LambdaContext ->
  -- | We force 'HalRequest.NoAuthorizer' because it's a type alias
  -- for 'Data.Aeson.Value' (i.e., should always parse), and it avoids
  -- an "ambiguous type variable" error at the use site.
  HalRequest.ProxyRequest HalRequest.NoAuthorizer ->
  m HalResponse.ProxyResponse
runWithContext :: forall (m :: * -> *).
MonadIO m =>
Options
-> (Key LambdaContext
    -> Key (ProxyRequest NoAuthorizer) -> Application)
-> LambdaContext
-> ProxyRequest NoAuthorizer
-> m ProxyResponse
runWithContext Options
opts Key LambdaContext -> Key (ProxyRequest NoAuthorizer) -> Application
app LambdaContext
ctx ProxyRequest NoAuthorizer
req = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  Key LambdaContext
contextKey <- forall a. IO (Key a)
Vault.newKey
  Key (ProxyRequest NoAuthorizer)
requestKey <- forall a. IO (Key a)
Vault.newKey
  let vault' :: Vault
vault' =
        Options -> Vault
vault Options
opts
          forall a b. a -> (a -> b) -> b
& forall a. Key a -> a -> Vault -> Vault
Vault.insert Key LambdaContext
contextKey LambdaContext
ctx
          forall a b. a -> (a -> b) -> b
& forall a. Key a -> a -> Vault -> Vault
Vault.insert Key (ProxyRequest NoAuthorizer)
requestKey ProxyRequest NoAuthorizer
req
      opts' :: Options
opts' = Options
opts {vault :: Vault
vault = Vault
vault'}
  Request
waiReq <- forall a. Options -> ProxyRequest a -> IO Request
toWaiRequest Options
opts' ProxyRequest NoAuthorizer
req
  IORef (Maybe Response)
responseRef <- forall a. a -> IO (IORef a)
IORef.newIORef forall a. Maybe a
Nothing
  ResponseReceived
Wai.ResponseReceived <- Key LambdaContext -> Key (ProxyRequest NoAuthorizer) -> Application
app Key LambdaContext
contextKey Key (ProxyRequest NoAuthorizer)
requestKey Request
waiReq forall a b. (a -> b) -> a -> b
$ \Response
waiResp ->
    ResponseReceived
Wai.ResponseReceived forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. IORef a -> a -> IO ()
IORef.writeIORef IORef (Maybe Response)
responseRef (forall a. a -> Maybe a
Just Response
waiResp)
  Just Response
waiResp <- forall a. IORef a -> IO a
IORef.readIORef IORef (Maybe Response)
responseRef
  Options -> Response -> IO ProxyResponse
fromWaiResponse Options
opts' Response
waiResp

-- | Convert the request sent to a Lambda serving an API Gateway proxy
-- integration into a WAI request.
--
-- __Note:__ We aren't told the HTTP version the client is using, so
-- we assume HTTP 1.1.
toWaiRequest ::
  Options ->
  HalRequest.ProxyRequest a ->
  IO Wai.Request
toWaiRequest :: forall a. Options -> ProxyRequest a -> IO Request
toWaiRequest Options
opts ProxyRequest a
req = do
  let port :: PortNumber
port = Options -> PortNumber
portNumber Options
opts
      pathSegments :: [Text]
pathSegments = Text -> Text -> [Text]
T.splitOn Text
"/" forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile (forall a. Eq a => a -> a -> Bool
== Char
'/') forall a b. (a -> b) -> a -> b
$ forall a. ProxyRequest a -> Text
HalRequest.path ProxyRequest a
req
      query :: Query
query = forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text [Text] -> Query
constructQuery forall a b. (a -> b) -> a -> b
$ forall a. ProxyRequest a -> HashMap Text [Text]
HalRequest.multiValueQueryStringParameters ProxyRequest a
req
      hints :: AddrInfo
hints =
        AddrInfo
NS.defaultHints
          { addrFlags :: [AddrInfoFlag]
NS.addrFlags = [AddrInfoFlag
NS.AI_NUMERICHOST],
            addrFamily :: Family
NS.addrFamily = Family
NS.AF_INET,
            addrSocketType :: SocketType
NS.addrSocketType = SocketType
NS.Stream
          }
      sourceIp :: String
sourceIp =
        Text -> String
T.unpack
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity -> Text
HalRequest.sourceIp
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RequestContext a -> Identity
HalRequest.identity
          forall a b. (a -> b) -> a -> b
$ forall a. ProxyRequest a -> RequestContext a
HalRequest.requestContext ProxyRequest a
req
  -- Test invokes from the API Gateway console pass a "sourceIp" field
  -- of "test-invoke-source-ip". If the getAddrInfo call fails, just
  -- assume localhost.
  SockAddr
sourceHost <-
    forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust
      (forall a. a -> Maybe a
Just @IOException)
      (Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
NS.getAddrInfo (forall a. a -> Maybe a
Just AddrInfo
hints) (forall a. a -> Maybe a
Just String
sourceIp) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show PortNumber
port))
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right (AddrInfo
s : [AddrInfo]
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ AddrInfo -> SockAddr
NS.addrAddress AddrInfo
s
        Either IOException [AddrInfo]
_ -> do
          Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$
            forall a. Monoid a => [a] -> a
mconcat
              [ String
"Cannot convert sourceIp ",
                forall a. Show a => a -> String
show String
sourceIp,
                String
" to address; assuming 127.0.0.1"
              ]
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. PortNumber -> HostAddress -> SockAddr
NS.SockAddrInet PortNumber
port forall a b. (a -> b) -> a -> b
$ (Word8, Word8, Word8, Word8) -> HostAddress
NS.tupleToHostAddress (Word8
127, Word8
0, Word8
0, Word8
1)
  IO ByteString
body <- ByteString -> IO (IO ByteString)
returnChunks forall a b. (a -> b) -> a -> b
$ forall a. ProxyRequest a -> ByteString
HalRequest.body ProxyRequest a
req
  let waiReq :: Request
waiReq =
        Wai.Request
          { requestMethod :: ByteString
Wai.requestMethod = Text -> ByteString
T.encodeUtf8 forall a b. (a -> b) -> a -> b
$ forall a. ProxyRequest a -> Text
HalRequest.httpMethod ProxyRequest a
req,
            httpVersion :: HttpVersion
Wai.httpVersion = Int -> Int -> HttpVersion
HttpVersion Int
1 Int
1,
            rawPathInfo :: ByteString
Wai.rawPathInfo =
              ByteString -> ByteString
BL.toStrict
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString
                forall a b. (a -> b) -> a -> b
$ [Text] -> Query -> Builder
encodePath [Text]
pathSegments [],
            rawQueryString :: ByteString
Wai.rawQueryString = case Query
query of
              [] -> ByteString
""
              Query
_ -> Bool -> Query -> ByteString
renderQuery Bool
True Query
query,
            requestHeaders :: [Header]
Wai.requestHeaders =
              forall a. Ord a => [a] -> [a]
sort
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
                  ( \(CI Text
hName, [Text]
hValues) ->
                      (forall s2 s1. FoldCase s2 => (s1 -> s2) -> CI s1 -> CI s2
CI.map Text -> ByteString
T.encodeUtf8 CI Text
hName,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
hValues
                  )
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
H.toList
                forall a b. (a -> b) -> a -> b
$ forall a. ProxyRequest a -> HashMap (CI Text) [Text]
HalRequest.multiValueHeaders ProxyRequest a
req,
            isSecure :: Bool
Wai.isSecure = Bool
True,
            remoteHost :: SockAddr
Wai.remoteHost = SockAddr
sourceHost,
            pathInfo :: [Text]
Wai.pathInfo = [Text]
pathSegments,
            queryString :: Query
Wai.queryString = Query
query,
            requestBody :: IO ByteString
Wai.requestBody = IO ByteString
body,
            vault :: Vault
Wai.vault = Options -> Vault
vault Options
opts,
            requestBodyLength :: RequestBodyLength
Wai.requestBodyLength =
              Word64 -> RequestBodyLength
Wai.KnownLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length forall a b. (a -> b) -> a -> b
$ forall a. ProxyRequest a -> ByteString
HalRequest.body ProxyRequest a
req,
            requestHeaderHost :: Maybe ByteString
Wai.requestHeaderHost = forall a. HeaderName -> ProxyRequest a -> Maybe ByteString
getHeader HeaderName
hHost ProxyRequest a
req,
            requestHeaderRange :: Maybe ByteString
Wai.requestHeaderRange = forall a. HeaderName -> ProxyRequest a -> Maybe ByteString
getHeader HeaderName
hRange ProxyRequest a
req,
            requestHeaderReferer :: Maybe ByteString
Wai.requestHeaderReferer = forall a. HeaderName -> ProxyRequest a -> Maybe ByteString
getHeader HeaderName
hReferer ProxyRequest a
req,
            requestHeaderUserAgent :: Maybe ByteString
Wai.requestHeaderUserAgent = forall a. HeaderName -> ProxyRequest a -> Maybe ByteString
getHeader HeaderName
hUserAgent ProxyRequest a
req
          }
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Request
waiReq

-- | Unpack a lazy 'BL.ByteString' into its chunks, and return an IO
-- action which returns each chunk in sequence, and returns 'B.empty'
-- forever after the bytestring is exhausted.
returnChunks :: BL.ByteString -> IO (IO B.ByteString)
returnChunks :: ByteString -> IO (IO ByteString)
returnChunks ByteString
bs = do
  IORef [ByteString]
chunkRef <- forall a. a -> IO (IORef a)
IORef.newIORef forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BL.toChunks ByteString
bs
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. IORef a -> (a -> (a, b)) -> IO b
IORef.atomicModifyIORef' IORef [ByteString]
chunkRef forall a b. (a -> b) -> a -> b
$
    \case
      [] -> forall a. Monoid a => a
mempty
      (ByteString
ch : [ByteString]
chs) -> ([ByteString]
chs, ByteString
ch)

constructQuery :: HashMap Text [Text] -> Query
constructQuery :: HashMap Text [Text] -> Query
constructQuery = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text, [Text]) -> Query
expandParamList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
H.toList
  where
    expandParamList :: (Text, [Text]) -> [QueryItem]
    expandParamList :: (Text, [Text]) -> Query
expandParamList (Text
param, [Text]
values) =
      QueryText -> Query
queryTextToQuery forall a b. (a -> b) -> a -> b
$ case [Text]
values of
        [] -> [(Text
param, forall a. Maybe a
Nothing)]
        [Text]
_ -> (Text
param,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
values

getHeader :: HeaderName -> HalRequest.ProxyRequest a -> Maybe ByteString
getHeader :: forall a. HeaderName -> ProxyRequest a -> Maybe ByteString
getHeader HeaderName
h =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
T.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup (forall s2 s1. FoldCase s2 => (s1 -> s2) -> CI s1 -> CI s2
CI.map ByteString -> Text
T.decodeUtf8 HeaderName
h) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ProxyRequest a -> HashMap (CI Text) Text
HalRequest.headers

-- | Convert a WAI 'Wai.Response' into a hal
-- 'HalResponse.ProxyResponse'.
fromWaiResponse :: Options -> Wai.Response -> IO HalResponse.ProxyResponse
fromWaiResponse :: Options -> Response -> IO ProxyResponse
fromWaiResponse Options
opts (Wai.ResponseFile Status
status [Header]
headers String
path Maybe FilePart
mFilePart) = do
  ByteString
fileData <- String -> Maybe FilePart -> IO ByteString
readFilePart String
path Maybe FilePart
mFilePart
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Header] -> ProxyResponse -> ProxyResponse
addHeaders [Header]
headers
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> ProxyBody -> ProxyResponse
HalResponse.response Status
status
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Text -> ByteString -> ProxyBody
createProxyBody Options
opts ([Header] -> Text
getContentType [Header]
headers)
    forall a b. (a -> b) -> a -> b
$ ByteString
fileData
fromWaiResponse Options
opts (Wai.ResponseBuilder Status
status [Header]
headers Builder
builder) =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Header] -> ProxyResponse -> ProxyResponse
addHeaders [Header]
headers
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> ProxyBody -> ProxyResponse
HalResponse.response Status
status
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Text -> ByteString -> ProxyBody
createProxyBody Options
opts ([Header] -> Text
getContentType [Header]
headers)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict
    forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
Builder.toLazyByteString Builder
builder
fromWaiResponse Options
opts (Wai.ResponseStream Status
status [Header]
headers StreamingBody
stream) = do
  IORef Builder
builderRef <- forall a. a -> IO (IORef a)
IORef.newIORef forall a. Monoid a => a
mempty
  let addChunk :: Builder -> IO ()
addChunk Builder
chunk = forall a. IORef a -> (a -> a) -> IO ()
IORef.modifyIORef IORef Builder
builderRef (forall a. Semigroup a => a -> a -> a
<> Builder
chunk)
      flush :: IO ()
flush = forall a. IORef a -> (a -> a) -> IO ()
IORef.modifyIORef IORef Builder
builderRef (forall a. Semigroup a => a -> a -> a
<> Builder
Builder.flush)
  StreamingBody
stream Builder -> IO ()
addChunk IO ()
flush
  Builder
builder <- forall a. IORef a -> IO a
IORef.readIORef IORef Builder
builderRef
  Options -> Response -> IO ProxyResponse
fromWaiResponse Options
opts (Status -> [Header] -> Builder -> Response
Wai.ResponseBuilder Status
status [Header]
headers Builder
builder)
fromWaiResponse Options
opts (Wai.ResponseRaw IO ByteString -> (ByteString -> IO ()) -> IO ()
_ Response
resp) = Options -> Response -> IO ProxyResponse
fromWaiResponse Options
opts Response
resp

readFilePart :: FilePath -> Maybe Wai.FilePart -> IO ByteString
readFilePart :: String -> Maybe FilePart -> IO ByteString
readFilePart String
path Maybe FilePart
mPart = forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
path IOMode
ReadMode forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
  case Maybe FilePart
mPart of
    Maybe FilePart
Nothing -> Handle -> IO ByteString
B.hGetContents Handle
h
    Just (Wai.FilePart Integer
offset Integer
count Integer
_) -> do
      Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
AbsoluteSeek Integer
offset
      Handle -> Int -> IO ByteString
B.hGet Handle
h forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
count

createProxyBody :: Options -> Text -> ByteString -> HalResponse.ProxyBody
createProxyBody :: Options -> Text -> ByteString -> ProxyBody
createProxyBody Options
opts Text
contentType ByteString
body
  | Options -> Text -> Bool
binaryMimeType Options
opts Text
contentType =
      Text -> Text -> Bool -> ProxyBody
HalResponse.ProxyBody Text
contentType (ByteString -> Text
T.decodeUtf8 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B64.encode ByteString
body) Bool
True
  | Bool
otherwise =
      Text -> Text -> Bool -> ProxyBody
HalResponse.ProxyBody Text
contentType (ByteString -> Text
T.decodeUtf8 ByteString
body) Bool
False

addHeaders ::
  ResponseHeaders -> HalResponse.ProxyResponse -> HalResponse.ProxyResponse
addHeaders :: [Header] -> ProxyResponse -> ProxyResponse
addHeaders [Header]
headers ProxyResponse
response = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ProxyResponse -> Header -> ProxyResponse
addHeader ProxyResponse
response [Header]
headers
  where
    addHeader :: ProxyResponse -> Header -> ProxyResponse
addHeader ProxyResponse
r (HeaderName
hName, ByteString
hValue) =
      Text -> Text -> ProxyResponse -> ProxyResponse
HalResponse.addHeader
        (ByteString -> Text
T.decodeUtf8 forall a b. (a -> b) -> a -> b
$ forall s. CI s -> s
CI.original HeaderName
hName)
        (ByteString -> Text
T.decodeUtf8 ByteString
hValue)
        ProxyResponse
r

-- | Try to find the content-type of a response, given the response
-- headers. If we can't, return @"application/octet-stream"@.
getContentType :: ResponseHeaders -> Text
getContentType :: [Header] -> Text
getContentType =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"application/octet-stream" ByteString -> Text
T.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
hContentType