{-# LANGUAGE TemplateHaskell, OverloadedStrings, RecordWildCards #-}
{-# LANGUAGE TypeApplications, NumDecimals #-}
module NgxExport.Tools.Subrequest (
makeSubrequest
,makeSubrequestWithRead
,makeSubrequestFull
,makeSubrequestFullWithRead
,extractRequestStatusFromFullResponse
,extractStatusFromFullResponse
,extractHeaderFromFullResponse
,extractBodyFromFullResponse
,notForwardableResponseHeaders
,contentFromFullResponse
) where
import NgxExport
import NgxExport.Tools
import Network.HTTP.Client hiding (ResponseTimeout)
import qualified Network.HTTP.Client (HttpExceptionContent (ResponseTimeout))
import Network.HTTP.Types
import qualified Network.Socket as S
import qualified Network.Socket.ByteString as SB
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C8
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as C8L
import Data.IORef
import qualified Data.Text.Encoding as T
import qualified Data.Binary as Binary
import Data.HashSet (HashSet)
import qualified Data.HashSet as HS
import Data.CaseInsensitive hiding (map)
import Data.Aeson
import Data.Maybe
import Data.Word
import Control.Arrow
import Control.Exception
import System.IO.Unsafe
data SubrequestParseError = SubrequestParseError deriving Int -> SubrequestParseError -> ShowS
[SubrequestParseError] -> ShowS
SubrequestParseError -> String
(Int -> SubrequestParseError -> ShowS)
-> (SubrequestParseError -> String)
-> ([SubrequestParseError] -> ShowS)
-> Show SubrequestParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubrequestParseError] -> ShowS
$cshowList :: [SubrequestParseError] -> ShowS
show :: SubrequestParseError -> String
$cshow :: SubrequestParseError -> String
showsPrec :: Int -> SubrequestParseError -> ShowS
$cshowsPrec :: Int -> SubrequestParseError -> ShowS
Show
instance Exception SubrequestParseError
data UDSNotConfiguredError = UDSNotConfiguredError deriving Int -> UDSNotConfiguredError -> ShowS
[UDSNotConfiguredError] -> ShowS
UDSNotConfiguredError -> String
(Int -> UDSNotConfiguredError -> ShowS)
-> (UDSNotConfiguredError -> String)
-> ([UDSNotConfiguredError] -> ShowS)
-> Show UDSNotConfiguredError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UDSNotConfiguredError] -> ShowS
$cshowList :: [UDSNotConfiguredError] -> ShowS
show :: UDSNotConfiguredError -> String
$cshow :: UDSNotConfiguredError -> String
showsPrec :: Int -> UDSNotConfiguredError -> ShowS
$cshowsPrec :: Int -> UDSNotConfiguredError -> ShowS
Show
instance Exception UDSNotConfiguredError
data ResponseTimeout = ResponseTimeoutDefault
| ResponseTimeout TimeInterval deriving (ResponseTimeout -> ResponseTimeout -> Bool
(ResponseTimeout -> ResponseTimeout -> Bool)
-> (ResponseTimeout -> ResponseTimeout -> Bool)
-> Eq ResponseTimeout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResponseTimeout -> ResponseTimeout -> Bool
$c/= :: ResponseTimeout -> ResponseTimeout -> Bool
== :: ResponseTimeout -> ResponseTimeout -> Bool
$c== :: ResponseTimeout -> ResponseTimeout -> Bool
Eq, ReadPrec [ResponseTimeout]
ReadPrec ResponseTimeout
Int -> ReadS ResponseTimeout
ReadS [ResponseTimeout]
(Int -> ReadS ResponseTimeout)
-> ReadS [ResponseTimeout]
-> ReadPrec ResponseTimeout
-> ReadPrec [ResponseTimeout]
-> Read ResponseTimeout
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResponseTimeout]
$creadListPrec :: ReadPrec [ResponseTimeout]
readPrec :: ReadPrec ResponseTimeout
$creadPrec :: ReadPrec ResponseTimeout
readList :: ReadS [ResponseTimeout]
$creadList :: ReadS [ResponseTimeout]
readsPrec :: Int -> ReadS ResponseTimeout
$creadsPrec :: Int -> ReadS ResponseTimeout
Read)
data SubrequestConf =
SubrequestConf { SubrequestConf -> ByteString
srMethod :: ByteString
, SubrequestConf -> String
srUri :: String
, SubrequestConf -> ByteString
srBody :: ByteString
, :: RequestHeaders
, SubrequestConf -> ResponseTimeout
srResponseTimeout :: ResponseTimeout
, SubrequestConf -> Bool
srUseUDS :: Bool
} deriving ReadPrec [SubrequestConf]
ReadPrec SubrequestConf
Int -> ReadS SubrequestConf
ReadS [SubrequestConf]
(Int -> ReadS SubrequestConf)
-> ReadS [SubrequestConf]
-> ReadPrec SubrequestConf
-> ReadPrec [SubrequestConf]
-> Read SubrequestConf
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SubrequestConf]
$creadListPrec :: ReadPrec [SubrequestConf]
readPrec :: ReadPrec SubrequestConf
$creadPrec :: ReadPrec SubrequestConf
readList :: ReadS [SubrequestConf]
$creadList :: ReadS [SubrequestConf]
readsPrec :: Int -> ReadS SubrequestConf
$creadsPrec :: Int -> ReadS SubrequestConf
Read
instance FromJSON SubrequestConf where
parseJSON :: Value -> Parser SubrequestConf
parseJSON = String
-> (Object -> Parser SubrequestConf)
-> Value
-> Parser SubrequestConf
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "SubrequestConf" ((Object -> Parser SubrequestConf)
-> Value -> Parser SubrequestConf)
-> (Object -> Parser SubrequestConf)
-> Value
-> Parser SubrequestConf
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
ByteString
srMethod <- Parser (Maybe Text) -> Parser ByteString
maybeEmpty (Parser (Maybe Text) -> Parser ByteString)
-> Parser (Maybe Text) -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "method"
String
srUri <- Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: "uri"
ByteString
srBody <- Parser (Maybe Text) -> Parser ByteString
maybeEmpty (Parser (Maybe Text) -> Parser ByteString)
-> Parser (Maybe Text) -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "body"
RequestHeaders
srHeaders <- ((Text, Text) -> Header) -> [(Text, Text)] -> RequestHeaders
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk (ByteString -> CI ByteString)
-> (Text -> ByteString) -> Text -> CI ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> CI ByteString)
-> (Text -> ByteString) -> (Text, Text) -> Header
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Text -> ByteString
T.encodeUtf8) ([(Text, Text)] -> RequestHeaders)
-> Parser [(Text, Text)] -> Parser RequestHeaders
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Object
o Object -> Text -> Parser (Maybe [(Text, Text)])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "headers" Parser (Maybe [(Text, Text)])
-> [(Text, Text)] -> Parser [(Text, Text)]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
ResponseTimeout
srResponseTimeout <- ResponseTimeout
-> (TimeInterval -> ResponseTimeout)
-> Maybe TimeInterval
-> ResponseTimeout
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ResponseTimeout
ResponseTimeoutDefault TimeInterval -> ResponseTimeout
ResponseTimeout (Maybe TimeInterval -> ResponseTimeout)
-> Parser (Maybe TimeInterval) -> Parser ResponseTimeout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Object
o Object -> Text -> Parser (Maybe TimeInterval)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "timeout"
Bool
srUseUDS <- Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Parser (Maybe Bool) -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "useUDS"
SubrequestConf -> Parser SubrequestConf
forall (m :: * -> *) a. Monad m => a -> m a
return SubrequestConf :: ByteString
-> String
-> ByteString
-> RequestHeaders
-> ResponseTimeout
-> Bool
-> SubrequestConf
SubrequestConf {..}
where maybeEmpty :: Parser (Maybe Text) -> Parser ByteString
maybeEmpty = (Maybe Text -> ByteString)
-> Parser (Maybe Text) -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe Text -> ByteString)
-> Parser (Maybe Text) -> Parser ByteString)
-> (Maybe Text -> ByteString)
-> Parser (Maybe Text)
-> Parser ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> (Text -> ByteString) -> Maybe Text -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" Text -> ByteString
T.encodeUtf8
subrequest :: (String -> IO Request) ->
(Response L.ByteString -> L.ByteString) -> SubrequestConf ->
IO L.ByteString
subrequest :: (String -> IO Request)
-> (Response ByteString -> ByteString)
-> SubrequestConf
-> IO ByteString
subrequest parseRequestF :: String -> IO Request
parseRequestF buildResponseF :: Response ByteString -> ByteString
buildResponseF SubrequestConf {..} = do
Manager
man <- if Bool
srUseUDS
then Manager -> Maybe Manager -> Manager
forall a. a -> Maybe a -> a
fromMaybe (UDSNotConfiguredError -> Manager
forall a e. Exception e => e -> a
throw UDSNotConfiguredError
UDSNotConfiguredError) (Maybe Manager -> Manager) -> IO (Maybe Manager) -> IO Manager
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
IORef (Maybe Manager) -> IO (Maybe Manager)
forall a. IORef a -> IO a
readIORef IORef (Maybe Manager)
httpUDSManager
else Manager -> IO Manager
forall (m :: * -> *) a. Monad m => a -> m a
return Manager
httpManager
Request
req <- String -> IO Request
parseRequestF String
srUri
let req' :: Request
req' = if ByteString -> Bool
B.null ByteString
srMethod
then Request
req
else Request
req { method :: ByteString
method = ByteString
srMethod }
req'' :: Request
req'' = if ByteString -> Bool
B.null ByteString
srBody
then Request
req'
else Request
req' { requestBody :: RequestBody
requestBody = ByteString -> RequestBody
RequestBodyBS ByteString
srBody }
req''' :: Request
req''' = if RequestHeaders -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null RequestHeaders
srHeaders
then Request
req''
else Request
req'' { requestHeaders :: RequestHeaders
requestHeaders = RequestHeaders
srHeaders }
req'''' :: Request
req'''' = if ResponseTimeout
srResponseTimeout ResponseTimeout -> ResponseTimeout -> Bool
forall a. Eq a => a -> a -> Bool
== ResponseTimeout
ResponseTimeoutDefault
then Request
req'''
else Request
req''' { responseTimeout :: ResponseTimeout
responseTimeout =
ResponseTimeout -> ResponseTimeout
setTimeout ResponseTimeout
srResponseTimeout }
Response ByteString -> ByteString
buildResponseF (Response ByteString -> ByteString)
-> IO (Response ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> Manager -> IO (Response ByteString)
httpLbs Request
req'''' Manager
man
where setTimeout :: ResponseTimeout -> ResponseTimeout
setTimeout (ResponseTimeout v :: TimeInterval
v)
| Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = ResponseTimeout
responseTimeoutNone
| Bool
otherwise = Int -> ResponseTimeout
responseTimeoutMicro (Int -> ResponseTimeout) -> Int -> ResponseTimeout
forall a b. (a -> b) -> a -> b
$ Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
* 1e6
where t :: Int
t = TimeInterval -> Int
toSec TimeInterval
v
setTimeout _ = ResponseTimeout
forall a. HasCallStack => a
undefined
subrequestBody :: SubrequestConf -> IO L.ByteString
subrequestBody :: SubrequestConf -> IO ByteString
subrequestBody = (String -> IO Request)
-> (Response ByteString -> ByteString)
-> SubrequestConf
-> IO ByteString
subrequest String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow Response ByteString -> ByteString
forall body. Response body -> body
responseBody
type FullResponse = (Word8, Int, [(ByteString, ByteString)], L.ByteString)
subrequestFull :: SubrequestConf -> IO L.ByteString
subrequestFull :: SubrequestConf -> IO ByteString
subrequestFull = IO ByteString -> IO ByteString
handleAll (IO ByteString -> IO ByteString)
-> (SubrequestConf -> IO ByteString)
-> SubrequestConf
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO Request)
-> (Response ByteString -> ByteString)
-> SubrequestConf
-> IO ByteString
subrequest String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest Response ByteString -> ByteString
buildResponse
where handleAll :: IO ByteString -> IO ByteString
handleAll = (SomeException -> IO ByteString) -> IO ByteString -> IO ByteString
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle ((SomeException -> IO ByteString)
-> IO ByteString -> IO ByteString)
-> (SomeException -> IO ByteString)
-> IO ByteString
-> IO ByteString
forall a b. (a -> b) -> a -> b
$ \e :: SomeException
e -> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Binary FullResponse => FullResponse -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode @FullResponse (FullResponse -> ByteString) -> FullResponse -> ByteString
forall a b. (a -> b) -> a -> b
$
case SomeException -> Maybe HttpException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just (HttpExceptionRequest _ c :: HttpExceptionContent
c) ->
case HttpExceptionContent
c of
Network.HTTP.Client.ResponseTimeout -> FullResponse
forall a. (Word8, Int, [a], ByteString)
response502
ConnectionTimeout -> FullResponse
forall a. (Word8, Int, [a], ByteString)
response502
ConnectionFailure _ -> FullResponse
forall a. (Word8, Int, [a], ByteString)
response502
_ -> FullResponse
forall a. (Word8, Int, [a], ByteString)
response500
_ -> FullResponse
forall a. (Word8, Int, [a], ByteString)
response500
response500 :: (Word8, Int, [a], ByteString)
response500 = (2, 500, [], "")
response502 :: (Word8, Int, [a], ByteString)
response502 = (1, 502, [], "")
buildResponse :: Response ByteString -> ByteString
buildResponse r :: Response ByteString
r =
let status :: Int
status = Status -> Int
statusCode (Status -> Int) -> Status -> Int
forall a b. (a -> b) -> a -> b
$ Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
r
headers :: [(ByteString, ByteString)]
headers = (Header -> (ByteString, ByteString))
-> RequestHeaders -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ((CI ByteString -> ByteString) -> Header -> (ByteString, ByteString)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first CI ByteString -> ByteString
forall s. CI s -> s
original) (RequestHeaders -> [(ByteString, ByteString)])
-> RequestHeaders -> [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ Response ByteString -> RequestHeaders
forall body. Response body -> RequestHeaders
responseHeaders Response ByteString
r
body :: ByteString
body = Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
r
in FullResponse -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode @FullResponse (0, Int
status, [(ByteString, ByteString)]
headers, ByteString
body)
httpManager :: Manager
httpManager :: Manager
httpManager = IO Manager -> Manager
forall a. IO a -> a
unsafePerformIO (IO Manager -> Manager) -> IO Manager -> Manager
forall a b. (a -> b) -> a -> b
$ ManagerSettings -> IO Manager
newManager ManagerSettings
defaultManagerSettings
{-# NOINLINE httpManager #-}
httpUDSManager :: IORef (Maybe Manager)
httpUDSManager :: IORef (Maybe Manager)
httpUDSManager = IO (IORef (Maybe Manager)) -> IORef (Maybe Manager)
forall a. IO a -> a
unsafePerformIO (IO (IORef (Maybe Manager)) -> IORef (Maybe Manager))
-> IO (IORef (Maybe Manager)) -> IORef (Maybe Manager)
forall a b. (a -> b) -> a -> b
$ Maybe Manager -> IO (IORef (Maybe Manager))
forall a. a -> IO (IORef a)
newIORef Maybe Manager
forall a. Maybe a
Nothing
{-# NOINLINE httpUDSManager #-}
makeSubrequest
:: ByteString
-> IO L.ByteString
makeSubrequest :: ByteString -> IO ByteString
makeSubrequest =
IO ByteString
-> (SubrequestConf -> IO ByteString)
-> Maybe SubrequestConf
-> IO ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (SubrequestParseError -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO SubrequestParseError
SubrequestParseError) SubrequestConf -> IO ByteString
subrequestBody (Maybe SubrequestConf -> IO ByteString)
-> (ByteString -> Maybe SubrequestConf)
-> ByteString
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
FromJSON SubrequestConf => ByteString -> Maybe SubrequestConf
forall a. FromJSON a => ByteString -> Maybe a
readFromByteStringAsJSON @SubrequestConf
ngxExportAsyncIOYY 'makeSubrequest
makeSubrequestWithRead
:: ByteString
-> IO L.ByteString
makeSubrequestWithRead :: ByteString -> IO ByteString
makeSubrequestWithRead =
IO ByteString
-> (SubrequestConf -> IO ByteString)
-> Maybe SubrequestConf
-> IO ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (SubrequestParseError -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO SubrequestParseError
SubrequestParseError) SubrequestConf -> IO ByteString
subrequestBody (Maybe SubrequestConf -> IO ByteString)
-> (ByteString -> Maybe SubrequestConf)
-> ByteString
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Read SubrequestConf => ByteString -> Maybe SubrequestConf
forall a. Read a => ByteString -> Maybe a
readFromByteString @SubrequestConf
ngxExportAsyncIOYY 'makeSubrequestWithRead
newtype UDSConf = UDSConf { UDSConf -> String
udsPath :: FilePath } deriving ReadPrec [UDSConf]
ReadPrec UDSConf
Int -> ReadS UDSConf
ReadS [UDSConf]
(Int -> ReadS UDSConf)
-> ReadS [UDSConf]
-> ReadPrec UDSConf
-> ReadPrec [UDSConf]
-> Read UDSConf
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UDSConf]
$creadListPrec :: ReadPrec [UDSConf]
readPrec :: ReadPrec UDSConf
$creadPrec :: ReadPrec UDSConf
readList :: ReadS [UDSConf]
$creadList :: ReadS [UDSConf]
readsPrec :: Int -> ReadS UDSConf
$creadsPrec :: Int -> ReadS UDSConf
Read
configureUDS :: UDSConf -> Bool -> IO L.ByteString
configureUDS :: UDSConf -> Bool -> IO ByteString
configureUDS = (UDSConf -> IO ByteString) -> UDSConf -> Bool -> IO ByteString
forall a. (a -> IO ByteString) -> a -> Bool -> IO ByteString
ignitionService ((UDSConf -> IO ByteString) -> UDSConf -> Bool -> IO ByteString)
-> (UDSConf -> IO ByteString) -> UDSConf -> Bool -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \UDSConf {..} -> do
Manager
man <- ManagerSettings -> IO Manager
newManager ManagerSettings
defaultManagerSettings
{ managerRawConnection :: IO (Maybe HostAddress -> String -> Int -> IO Connection)
managerRawConnection = (Maybe HostAddress -> String -> Int -> IO Connection)
-> IO (Maybe HostAddress -> String -> Int -> IO Connection)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe HostAddress -> String -> Int -> IO Connection)
-> IO (Maybe HostAddress -> String -> Int -> IO Connection))
-> (Maybe HostAddress -> String -> Int -> IO Connection)
-> IO (Maybe HostAddress -> String -> Int -> IO Connection)
forall a b. (a -> b) -> a -> b
$ String -> Maybe HostAddress -> String -> Int -> IO Connection
forall p p p. String -> p -> p -> p -> IO Connection
openUDS String
udsPath }
IORef (Maybe Manager) -> Maybe Manager -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Manager)
httpUDSManager (Maybe Manager -> IO ()) -> Maybe Manager -> IO ()
forall a b. (a -> b) -> a -> b
$ Manager -> Maybe Manager
forall a. a -> Maybe a
Just Manager
man
ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ""
where openUDS :: String -> p -> p -> p -> IO Connection
openUDS path :: String
path _ _ _ = do
Socket
s <- Family -> SocketType -> CInt -> IO Socket
S.socket Family
S.AF_UNIX SocketType
S.Stream CInt
S.defaultProtocol
Socket -> SockAddr -> IO ()
S.connect Socket
s (String -> SockAddr
S.SockAddrUnix String
path)
IO ByteString -> (ByteString -> IO ()) -> IO () -> IO Connection
makeConnection (Socket -> Int -> IO ByteString
SB.recv Socket
s 4096) (Socket -> ByteString -> IO ()
SB.sendAll Socket
s) (Socket -> IO ()
S.close Socket
s)
ngxExportSimpleServiceTyped 'configureUDS ''UDSConf SingleShotService
makeSubrequestFull
:: ByteString
-> IO L.ByteString
makeSubrequestFull :: ByteString -> IO ByteString
makeSubrequestFull =
IO ByteString
-> (SubrequestConf -> IO ByteString)
-> Maybe SubrequestConf
-> IO ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ FullResponse -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode @FullResponse (2, 400, [], ""))
SubrequestConf -> IO ByteString
subrequestFull (Maybe SubrequestConf -> IO ByteString)
-> (ByteString -> Maybe SubrequestConf)
-> ByteString
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
FromJSON SubrequestConf => ByteString -> Maybe SubrequestConf
forall a. FromJSON a => ByteString -> Maybe a
readFromByteStringAsJSON @SubrequestConf
ngxExportAsyncIOYY 'makeSubrequestFull
makeSubrequestFullWithRead
:: ByteString
-> IO L.ByteString
makeSubrequestFullWithRead :: ByteString -> IO ByteString
makeSubrequestFullWithRead =
IO ByteString
-> (SubrequestConf -> IO ByteString)
-> Maybe SubrequestConf
-> IO ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ FullResponse -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode @FullResponse (2, 400, [], ""))
SubrequestConf -> IO ByteString
subrequestFull (Maybe SubrequestConf -> IO ByteString)
-> (ByteString -> Maybe SubrequestConf)
-> ByteString
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Read SubrequestConf => ByteString -> Maybe SubrequestConf
forall a. Read a => ByteString -> Maybe a
readFromByteString @SubrequestConf
ngxExportAsyncIOYY 'makeSubrequestFullWithRead
extractRequestStatusFromFullResponse
:: ByteString
-> L.ByteString
= String -> ByteString
C8L.pack (String -> ByteString)
-> (ByteString -> String) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> String
forall a. Show a => a -> String
show (Word8 -> String) -> (ByteString -> Word8) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(\(a :: Word8
a, _, _, _) -> Word8
a) (FullResponse -> Word8)
-> (ByteString -> FullResponse) -> ByteString -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Binary FullResponse => ByteString -> FullResponse
forall a. Binary a => ByteString -> a
Binary.decode @FullResponse) (ByteString -> FullResponse)
-> (ByteString -> ByteString) -> ByteString -> FullResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.fromStrict
extractStatusFromFullResponse
:: ByteString
-> L.ByteString
= String -> ByteString
C8L.pack (String -> ByteString)
-> (ByteString -> String) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (ByteString -> Int) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(\(_, a :: Int
a, _, _) -> Int
a) (FullResponse -> Int)
-> (ByteString -> FullResponse) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Binary FullResponse => ByteString -> FullResponse
forall a. Binary a => ByteString -> a
Binary.decode @FullResponse) (ByteString -> FullResponse)
-> (ByteString -> ByteString) -> ByteString -> FullResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.fromStrict
extractHeaderFromFullResponse
:: ByteString
-> L.ByteString
v :: ByteString
v =
let (h :: CI ByteString
h, b :: ByteString
b) = ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk (ByteString -> CI ByteString)
-> (ByteString -> ByteString) -> (ByteString, ByteString) -> Header
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** ByteString -> ByteString
C8.tail ((ByteString, ByteString) -> Header)
-> (ByteString, ByteString) -> Header
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> (ByteString, ByteString)
C8.break ('|' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) ByteString
v
(_, _, hs :: [(ByteString, ByteString)]
hs, _) = Binary FullResponse => ByteString -> FullResponse
forall a. Binary a => ByteString -> a
Binary.decode @FullResponse (ByteString -> FullResponse) -> ByteString -> FullResponse
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
L.fromStrict ByteString
b
in ByteString
-> (ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" ByteString -> ByteString
L.fromStrict (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ CI ByteString -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
h (RequestHeaders -> Maybe ByteString)
-> RequestHeaders -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ((ByteString, ByteString) -> Header)
-> [(ByteString, ByteString)] -> RequestHeaders
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString -> CI ByteString) -> (ByteString, ByteString) -> Header
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk) [(ByteString, ByteString)]
hs
extractBodyFromFullResponse
:: ByteString
-> L.ByteString
extractBodyFromFullResponse :: ByteString -> ByteString
extractBodyFromFullResponse =
(\(_, _, _, a :: ByteString
a) -> ByteString
a) (FullResponse -> ByteString)
-> (ByteString -> FullResponse) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Binary FullResponse => ByteString -> FullResponse
forall a. Binary a => ByteString -> a
Binary.decode @FullResponse) (ByteString -> FullResponse)
-> (ByteString -> ByteString) -> ByteString -> FullResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.fromStrict
ngxExportYY 'extractBodyFromFullResponse
notForwardableResponseHeaders :: HashSet HeaderName
= [CI ByteString] -> HashSet (CI ByteString)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([CI ByteString] -> HashSet (CI ByteString))
-> [CI ByteString] -> HashSet (CI ByteString)
forall a b. (a -> b) -> a -> b
$
(ByteString -> CI ByteString) -> [ByteString] -> [CI ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk ["Connection"
,"Content-Length"
,"Content-Type"
,"Date"
,"Keep-Alive"
,"Last-Modified"
,"Server"
,"Transfer-Encoding"
,"X-Pad"
]
contentFromFullResponse
:: HashSet HeaderName
-> Bool
-> ByteString
-> ContentHandlerResult
contentFromFullResponse :: HashSet (CI ByteString)
-> Bool -> ByteString -> ContentHandlerResult
contentFromFullResponse headersToDelete :: HashSet (CI ByteString)
headersToDelete deleteXAccel :: Bool
deleteXAccel v :: ByteString
v =
let (_, st :: Int
st, hs :: [(ByteString, ByteString)]
hs, b :: ByteString
b) = Binary FullResponse => ByteString -> FullResponse
forall a. Binary a => ByteString -> a
Binary.decode @FullResponse (ByteString -> FullResponse) -> ByteString -> FullResponse
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
L.fromStrict ByteString
v
hs' :: RequestHeaders
hs' = ((ByteString, ByteString) -> Header)
-> [(ByteString, ByteString)] -> RequestHeaders
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString -> CI ByteString) -> (ByteString, ByteString) -> Header
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk) [(ByteString, ByteString)]
hs
ct :: ByteString
ct = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ CI ByteString -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk "Content-Type") RequestHeaders
hs'
hs'' :: RequestHeaders
hs'' = (Header -> Bool) -> RequestHeaders -> RequestHeaders
forall a. (a -> Bool) -> [a] -> [a]
filter
(\(n :: CI ByteString
n, _) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
CI ByteString
n CI ByteString -> HashSet (CI ByteString) -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HS.member` HashSet (CI ByteString)
headersToDelete Bool -> Bool -> Bool
||
Bool
deleteXAccel Bool -> Bool -> Bool
&&
ByteString -> ByteString
forall s. FoldCase s => s -> s
foldCase "X-Accel-" ByteString -> ByteString -> Bool
`B.isPrefixOf` CI ByteString -> ByteString
forall s. CI s -> s
foldedCase CI ByteString
n
) RequestHeaders
hs'
in (ByteString
b, ByteString
ct, Int
st, (Header -> (ByteString, ByteString))
-> RequestHeaders -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map ((CI ByteString -> ByteString) -> Header -> (ByteString, ByteString)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first CI ByteString -> ByteString
forall s. CI s -> s
original) RequestHeaders
hs'')
fromFullResponse :: ByteString -> ContentHandlerResult
fromFullResponse :: ByteString -> ContentHandlerResult
fromFullResponse = HashSet (CI ByteString)
-> Bool -> ByteString -> ContentHandlerResult
contentFromFullResponse HashSet (CI ByteString)
notForwardableResponseHeaders Bool
True
ngxExportHandler 'fromFullResponse