{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-deprecations #-}
module Network.Wai.Handler.Hal
( run,
runWithContext,
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')
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,
)
run ::
MonadIO m =>
Wai.Application ->
HalRequest.ProxyRequest HalRequest.NoAuthorizer ->
m HalResponse.ProxyResponse
run :: Application -> ProxyRequest NoAuthorizer -> m ProxyResponse
run Application
app ProxyRequest NoAuthorizer
req = IO ProxyResponse -> m ProxyResponse
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProxyResponse -> m ProxyResponse)
-> IO ProxyResponse -> m ProxyResponse
forall a b. (a -> b) -> a -> b
$ do
Request
waiReq <- Vault -> PortNumber -> ProxyRequest NoAuthorizer -> IO Request
forall a. Vault -> PortNumber -> ProxyRequest a -> IO Request
toWaiRequest Vault
Vault.empty PortNumber
443 ProxyRequest NoAuthorizer
req
IORef (Maybe Response)
responseRef <- Maybe Response -> IO (IORef (Maybe Response))
forall a. a -> IO (IORef a)
IORef.newIORef Maybe Response
forall a. Maybe a
Nothing
ResponseReceived
Wai.ResponseReceived <- Application
app Request
waiReq ((Response -> IO ResponseReceived) -> IO ResponseReceived)
-> (Response -> IO ResponseReceived) -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ \Response
waiResp ->
ResponseReceived
Wai.ResponseReceived ResponseReceived -> IO () -> IO ResponseReceived
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ IORef (Maybe Response) -> Maybe Response -> IO ()
forall a. IORef a -> a -> IO ()
IORef.writeIORef IORef (Maybe Response)
responseRef (Response -> Maybe Response
forall a. a -> Maybe a
Just Response
waiResp)
Just Response
waiResp <- IORef (Maybe Response) -> IO (Maybe Response)
forall a. IORef a -> IO a
IORef.readIORef IORef (Maybe Response)
responseRef
Response -> IO ProxyResponse
fromWaiResponse Response
waiResp
runWithContext ::
MonadIO m =>
Vault ->
PortNumber ->
( Key LambdaContext ->
Key (HalRequest.ProxyRequest HalRequest.NoAuthorizer) ->
Wai.Application
) ->
LambdaContext ->
HalRequest.ProxyRequest HalRequest.NoAuthorizer ->
m HalResponse.ProxyResponse
runWithContext :: Vault
-> PortNumber
-> (Key LambdaContext
-> Key (ProxyRequest NoAuthorizer) -> Application)
-> LambdaContext
-> ProxyRequest NoAuthorizer
-> m ProxyResponse
runWithContext Vault
vault PortNumber
port Key LambdaContext -> Key (ProxyRequest NoAuthorizer) -> Application
app LambdaContext
ctx ProxyRequest NoAuthorizer
req = IO ProxyResponse -> m ProxyResponse
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProxyResponse -> m ProxyResponse)
-> IO ProxyResponse -> m ProxyResponse
forall a b. (a -> b) -> a -> b
$ do
Key LambdaContext
contextKey <- IO (Key LambdaContext)
forall a. IO (Key a)
Vault.newKey
Key (ProxyRequest NoAuthorizer)
requestKey <- IO (Key (ProxyRequest NoAuthorizer))
forall a. IO (Key a)
Vault.newKey
let vault' :: Vault
vault' =
Vault
vault
Vault -> (Vault -> Vault) -> Vault
forall a b. a -> (a -> b) -> b
& Key LambdaContext -> LambdaContext -> Vault -> Vault
forall a. Key a -> a -> Vault -> Vault
Vault.insert Key LambdaContext
contextKey LambdaContext
ctx
Vault -> (Vault -> Vault) -> Vault
forall a b. a -> (a -> b) -> b
& Key (ProxyRequest NoAuthorizer)
-> ProxyRequest NoAuthorizer -> Vault -> Vault
forall a. Key a -> a -> Vault -> Vault
Vault.insert Key (ProxyRequest NoAuthorizer)
requestKey ProxyRequest NoAuthorizer
req
Request
waiReq <- Vault -> PortNumber -> ProxyRequest NoAuthorizer -> IO Request
forall a. Vault -> PortNumber -> ProxyRequest a -> IO Request
toWaiRequest Vault
vault' PortNumber
port ProxyRequest NoAuthorizer
req
IORef (Maybe Response)
responseRef <- Maybe Response -> IO (IORef (Maybe Response))
forall a. a -> IO (IORef a)
IORef.newIORef Maybe Response
forall a. Maybe a
Nothing
ResponseReceived
Wai.ResponseReceived <- Key LambdaContext -> Key (ProxyRequest NoAuthorizer) -> Application
app Key LambdaContext
contextKey Key (ProxyRequest NoAuthorizer)
requestKey Request
waiReq ((Response -> IO ResponseReceived) -> IO ResponseReceived)
-> (Response -> IO ResponseReceived) -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ \Response
waiResp ->
ResponseReceived
Wai.ResponseReceived ResponseReceived -> IO () -> IO ResponseReceived
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ IORef (Maybe Response) -> Maybe Response -> IO ()
forall a. IORef a -> a -> IO ()
IORef.writeIORef IORef (Maybe Response)
responseRef (Response -> Maybe Response
forall a. a -> Maybe a
Just Response
waiResp)
Just Response
waiResp <- IORef (Maybe Response) -> IO (Maybe Response)
forall a. IORef a -> IO a
IORef.readIORef IORef (Maybe Response)
responseRef
Response -> IO ProxyResponse
fromWaiResponse Response
waiResp
toWaiRequest ::
Vault ->
PortNumber ->
HalRequest.ProxyRequest a ->
IO Wai.Request
toWaiRequest :: Vault -> PortNumber -> ProxyRequest a -> IO Request
toWaiRequest Vault
vault PortNumber
port ProxyRequest a
req = do
let pathSegments :: [Text]
pathSegments = Text -> Text -> [Text]
T.splitOn Text
"/" (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ ProxyRequest a -> Text
forall a. ProxyRequest a -> Text
HalRequest.path ProxyRequest a
req
query :: Query
query = HashMap Text [Text] -> Query
constructQuery (HashMap Text [Text] -> Query) -> HashMap Text [Text] -> Query
forall a b. (a -> b) -> a -> b
$ ProxyRequest a -> HashMap Text [Text]
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
(Text -> String)
-> (RequestContext a -> Text) -> RequestContext a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity -> Text
HalRequest.sourceIp
(Identity -> Text)
-> (RequestContext a -> Identity) -> RequestContext a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestContext a -> Identity
forall a. RequestContext a -> Identity
HalRequest.identity
(RequestContext a -> String) -> RequestContext a -> String
forall a b. (a -> b) -> a -> b
$ ProxyRequest a -> RequestContext a
forall a. ProxyRequest a -> RequestContext a
HalRequest.requestContext ProxyRequest a
req
SockAddr
sourceHost <-
(IOException -> Maybe IOException)
-> IO [AddrInfo] -> IO (Either IOException [AddrInfo])
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust
(IOException -> Maybe IOException
forall a. a -> Maybe a
Just @IOException)
(Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
NS.getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints) (String -> Maybe String
forall a. a -> Maybe a
Just String
sourceIp) (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ PortNumber -> String
forall a. Show a => a -> String
show PortNumber
port))
IO (Either IOException [AddrInfo])
-> (Either IOException [AddrInfo] -> IO SockAddr) -> IO SockAddr
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Right (AddrInfo
s : [AddrInfo]
_) -> SockAddr -> IO SockAddr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SockAddr -> IO SockAddr) -> SockAddr -> IO SockAddr
forall a b. (a -> b) -> a -> b
$ AddrInfo -> SockAddr
NS.addrAddress AddrInfo
s
Either IOException [AddrInfo]
_ -> do
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
[String] -> String
forall a. Monoid a => [a] -> a
mconcat
[ String
"Cannot convert sourceIp ",
String -> String
forall a. Show a => a -> String
show String
sourceIp,
String
" to address; assuming 127.0.0.1"
]
SockAddr -> IO SockAddr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SockAddr -> IO SockAddr)
-> (HostAddress -> SockAddr) -> HostAddress -> IO SockAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PortNumber -> HostAddress -> SockAddr
NS.SockAddrInet PortNumber
port (HostAddress -> IO SockAddr) -> HostAddress -> IO SockAddr
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 (ByteString -> IO (IO ByteString))
-> ByteString -> IO (IO ByteString)
forall a b. (a -> b) -> a -> b
$ ProxyRequest a -> ByteString
forall a. ProxyRequest a -> ByteString
HalRequest.body ProxyRequest a
req
let waiReq :: Request
waiReq =
Request :: ByteString
-> HttpVersion
-> ByteString
-> ByteString
-> RequestHeaders
-> Bool
-> SockAddr
-> [Text]
-> Query
-> IO ByteString
-> Vault
-> RequestBodyLength
-> Maybe ByteString
-> Maybe ByteString
-> Maybe ByteString
-> Maybe ByteString
-> Request
Wai.Request
{ requestMethod :: ByteString
Wai.requestMethod = Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ ProxyRequest a -> Text
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
(ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString
(Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ [Text] -> Query -> Builder
encodePath [Text]
pathSegments Query
query,
rawQueryString :: ByteString
Wai.rawQueryString = case Query
query of
[] -> ByteString
""
Query
_ -> Bool -> Query -> ByteString
renderQuery Bool
True Query
query,
requestHeaders :: RequestHeaders
Wai.requestHeaders =
((CI Text, [Text]) -> RequestHeaders)
-> [(CI Text, [Text])] -> RequestHeaders
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
( \(CI Text
hName, [Text]
hValues) ->
((Text -> ByteString) -> CI Text -> CI ByteString
forall s2 s1. FoldCase s2 => (s1 -> s2) -> CI s1 -> CI s2
CI.map Text -> ByteString
T.encodeUtf8 CI Text
hName,) (ByteString -> (CI ByteString, ByteString))
-> (Text -> ByteString) -> Text -> (CI ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> (CI ByteString, ByteString)) -> [Text] -> RequestHeaders
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
hValues
)
([(CI Text, [Text])] -> RequestHeaders)
-> (HashMap (CI Text) [Text] -> [(CI Text, [Text])])
-> HashMap (CI Text) [Text]
-> RequestHeaders
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap (CI Text) [Text] -> [(CI Text, [Text])]
forall k v. HashMap k v -> [(k, v)]
H.toList
(HashMap (CI Text) [Text] -> RequestHeaders)
-> HashMap (CI Text) [Text] -> RequestHeaders
forall a b. (a -> b) -> a -> b
$ ProxyRequest a -> HashMap (CI Text) [Text]
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 = Vault
vault,
requestBodyLength :: RequestBodyLength
Wai.requestBodyLength =
Word64 -> RequestBodyLength
Wai.KnownLength (Word64 -> RequestBodyLength)
-> (ByteString -> Word64) -> ByteString -> RequestBodyLength
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word64) -> (ByteString -> Int64) -> ByteString -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length (ByteString -> RequestBodyLength)
-> ByteString -> RequestBodyLength
forall a b. (a -> b) -> a -> b
$ ProxyRequest a -> ByteString
forall a. ProxyRequest a -> ByteString
HalRequest.body ProxyRequest a
req,
requestHeaderHost :: Maybe ByteString
Wai.requestHeaderHost = CI ByteString -> ProxyRequest a -> Maybe ByteString
forall a. CI ByteString -> ProxyRequest a -> Maybe ByteString
getHeader CI ByteString
hHost ProxyRequest a
req,
requestHeaderRange :: Maybe ByteString
Wai.requestHeaderRange = CI ByteString -> ProxyRequest a -> Maybe ByteString
forall a. CI ByteString -> ProxyRequest a -> Maybe ByteString
getHeader CI ByteString
hRange ProxyRequest a
req,
requestHeaderReferer :: Maybe ByteString
Wai.requestHeaderReferer = CI ByteString -> ProxyRequest a -> Maybe ByteString
forall a. CI ByteString -> ProxyRequest a -> Maybe ByteString
getHeader CI ByteString
hReferer ProxyRequest a
req,
requestHeaderUserAgent :: Maybe ByteString
Wai.requestHeaderUserAgent = CI ByteString -> ProxyRequest a -> Maybe ByteString
forall a. CI ByteString -> ProxyRequest a -> Maybe ByteString
getHeader CI ByteString
hUserAgent ProxyRequest a
req
}
Request -> IO Request
forall (f :: * -> *) a. Applicative f => a -> f a
pure Request
waiReq
returnChunks :: BL.ByteString -> IO (IO B.ByteString)
returnChunks :: ByteString -> IO (IO ByteString)
returnChunks ByteString
bs = do
IORef [ByteString]
chunkRef <- [ByteString] -> IO (IORef [ByteString])
forall a. a -> IO (IORef a)
IORef.newIORef ([ByteString] -> IO (IORef [ByteString]))
-> [ByteString] -> IO (IORef [ByteString])
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BL.toChunks ByteString
bs
IO ByteString -> IO (IO ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO ByteString -> IO (IO ByteString))
-> (([ByteString] -> ([ByteString], ByteString)) -> IO ByteString)
-> ([ByteString] -> ([ByteString], ByteString))
-> IO (IO ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef [ByteString]
-> ([ByteString] -> ([ByteString], ByteString)) -> IO ByteString
forall a b. IORef a -> (a -> (a, b)) -> IO b
IORef.atomicModifyIORef' IORef [ByteString]
chunkRef (([ByteString] -> ([ByteString], ByteString))
-> IO (IO ByteString))
-> ([ByteString] -> ([ByteString], ByteString))
-> IO (IO ByteString)
forall a b. (a -> b) -> a -> b
$
\case
[] -> ([ByteString], ByteString)
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 = ((Text, [Text]) -> Query) -> [(Text, [Text])] -> Query
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text, [Text]) -> Query
expandParamList ([(Text, [Text])] -> Query)
-> (HashMap Text [Text] -> [(Text, [Text])])
-> HashMap Text [Text]
-> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text [Text] -> [(Text, [Text])]
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 (QueryText -> Query) -> QueryText -> Query
forall a b. (a -> b) -> a -> b
$ case [Text]
values of
[] -> [(Text
param, Maybe Text
forall a. Maybe a
Nothing)]
[Text]
_ -> (Text
param,) (Maybe Text -> (Text, Maybe Text))
-> (Text -> Maybe Text) -> Text -> (Text, Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> (Text, Maybe Text)) -> [Text] -> QueryText
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
values
getHeader :: HeaderName -> HalRequest.ProxyRequest a -> Maybe ByteString
CI ByteString
h =
(Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
T.encodeUtf8 (Maybe Text -> Maybe ByteString)
-> (ProxyRequest a -> Maybe Text)
-> ProxyRequest a
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI Text -> HashMap (CI Text) Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup ((ByteString -> Text) -> CI ByteString -> CI Text
forall s2 s1. FoldCase s2 => (s1 -> s2) -> CI s1 -> CI s2
CI.map ByteString -> Text
T.decodeUtf8 CI ByteString
h) (HashMap (CI Text) Text -> Maybe Text)
-> (ProxyRequest a -> HashMap (CI Text) Text)
-> ProxyRequest a
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProxyRequest a -> HashMap (CI Text) Text
forall a. ProxyRequest a -> HashMap (CI Text) Text
HalRequest.headers
fromWaiResponse :: Wai.Response -> IO HalResponse.ProxyResponse
fromWaiResponse :: Response -> IO ProxyResponse
fromWaiResponse (Wai.ResponseFile Status
status RequestHeaders
headers String
path Maybe FilePart
mFilePart) = do
ByteString
fileData <- String -> Maybe FilePart -> IO ByteString
readFilePart String
path Maybe FilePart
mFilePart
ProxyResponse -> IO ProxyResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(ProxyResponse -> IO ProxyResponse)
-> (ByteString -> ProxyResponse) -> ByteString -> IO ProxyResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestHeaders -> ProxyResponse -> ProxyResponse
addHeaders RequestHeaders
headers
(ProxyResponse -> ProxyResponse)
-> (ByteString -> ProxyResponse) -> ByteString -> ProxyResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> ProxyBody -> ProxyResponse
HalResponse.response Status
status
(ProxyBody -> ProxyResponse)
-> (ByteString -> ProxyBody) -> ByteString -> ProxyResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString -> ProxyBody
createProxyBody (RequestHeaders -> Text
getContentType RequestHeaders
headers)
(ByteString -> IO ProxyResponse) -> ByteString -> IO ProxyResponse
forall a b. (a -> b) -> a -> b
$ ByteString
fileData
fromWaiResponse (Wai.ResponseBuilder Status
status RequestHeaders
headers Builder
builder) =
ProxyResponse -> IO ProxyResponse
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(ProxyResponse -> IO ProxyResponse)
-> (ByteString -> ProxyResponse) -> ByteString -> IO ProxyResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestHeaders -> ProxyResponse -> ProxyResponse
addHeaders RequestHeaders
headers
(ProxyResponse -> ProxyResponse)
-> (ByteString -> ProxyResponse) -> ByteString -> ProxyResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> ProxyBody -> ProxyResponse
HalResponse.response Status
status
(ProxyBody -> ProxyResponse)
-> (ByteString -> ProxyBody) -> ByteString -> ProxyResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString -> ProxyBody
createProxyBody (RequestHeaders -> Text
getContentType RequestHeaders
headers)
(ByteString -> ProxyBody)
-> (ByteString -> ByteString) -> ByteString -> ProxyBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict
(ByteString -> IO ProxyResponse) -> ByteString -> IO ProxyResponse
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
Builder.toLazyByteString Builder
builder
fromWaiResponse (Wai.ResponseStream Status
status RequestHeaders
headers StreamingBody
stream) = do
IORef Builder
builderRef <- Builder -> IO (IORef Builder)
forall a. a -> IO (IORef a)
IORef.newIORef Builder
forall a. Monoid a => a
mempty
let addChunk :: Builder -> IO ()
addChunk Builder
chunk = IORef Builder -> (Builder -> Builder) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
IORef.modifyIORef IORef Builder
builderRef (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
chunk)
flush :: IO ()
flush = IORef Builder -> (Builder -> Builder) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
IORef.modifyIORef IORef Builder
builderRef (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
Builder.flush)
StreamingBody
stream Builder -> IO ()
addChunk IO ()
flush
Builder
builder <- IORef Builder -> IO Builder
forall a. IORef a -> IO a
IORef.readIORef IORef Builder
builderRef
Response -> IO ProxyResponse
fromWaiResponse (Status -> RequestHeaders -> Builder -> Response
Wai.ResponseBuilder Status
status RequestHeaders
headers Builder
builder)
fromWaiResponse (Wai.ResponseRaw IO ByteString -> (ByteString -> IO ()) -> IO ()
_ Response
resp) = Response -> IO ProxyResponse
fromWaiResponse Response
resp
readFilePart :: FilePath -> Maybe Wai.FilePart -> IO ByteString
readFilePart :: String -> Maybe FilePart -> IO ByteString
readFilePart String
path Maybe FilePart
mPart = String -> IOMode -> (Handle -> IO ByteString) -> IO ByteString
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
path IOMode
ReadMode ((Handle -> IO ByteString) -> IO ByteString)
-> (Handle -> IO ByteString) -> IO ByteString
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 (Int -> IO ByteString) -> Int -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
count
createProxyBody :: Text -> ByteString -> HalResponse.ProxyBody
createProxyBody :: Text -> ByteString -> ProxyBody
createProxyBody Text
contentType ByteString
body
| (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`T.isPrefixOf` Text
contentType) [Text
"text/plain", Text
"application/json"] =
Text -> Text -> Bool -> ProxyBody
HalResponse.ProxyBody Text
contentType (ByteString -> Text
T.decodeUtf8 ByteString
body) Bool
False
| Bool
otherwise =
Text -> Text -> Bool -> ProxyBody
HalResponse.ProxyBody Text
contentType (ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B64.encode ByteString
body) Bool
True
addHeaders ::
ResponseHeaders -> HalResponse.ProxyResponse -> HalResponse.ProxyResponse
RequestHeaders
headers ProxyResponse
response = (ProxyResponse -> (CI ByteString, ByteString) -> ProxyResponse)
-> ProxyResponse -> RequestHeaders -> ProxyResponse
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ProxyResponse -> (CI ByteString, ByteString) -> ProxyResponse
addHeader ProxyResponse
response RequestHeaders
headers
where
addHeader :: ProxyResponse -> (CI ByteString, ByteString) -> ProxyResponse
addHeader ProxyResponse
r (CI ByteString
hName, ByteString
hValue) =
Text -> Text -> ProxyResponse -> ProxyResponse
HalResponse.addHeader
(ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
hName)
(ByteString -> Text
T.decodeUtf8 ByteString
hValue)
ProxyResponse
r
getContentType :: ResponseHeaders -> Text
getContentType :: RequestHeaders -> Text
getContentType =
Text -> (ByteString -> Text) -> Maybe ByteString -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"application/octet-stream" ByteString -> Text
T.decodeUtf8 (Maybe ByteString -> Text)
-> (RequestHeaders -> Maybe ByteString) -> RequestHeaders -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI ByteString -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
hContentType