{-# LANGUAGE CPP, TemplateHaskell, ForeignFunctionInterface #-}
{-# LANGUAGE ViewPatterns, PatternSynonyms, TupleSections, LambdaCase #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  NgxExport
-- Copyright   :  (c) Alexey Radkov 2016-2024
-- License     :  BSD-style
--
-- Maintainer  :  alexey.radkov@gmail.com
-- Stability   :  stable
-- Portability :  non-portable (requires POSIX and Template Haskell)
--
-- Nginx / Haskell interoperability layer and exporters of regular Haskell
-- functions at Nginx level for using in configuration directives of
-- <https://github.com/lyokha/nginx-haskell-module nginx-haskell-module>.
--
-----------------------------------------------------------------------------

module NgxExport (
    -- * Type declarations
                  ContentHandlerResult
                 ,UnsafeContentHandlerResult
                 ,HTTPHeaders
    -- * Exporters
    -- $exporters

    -- *** Synchronous handlers
                 ,ngxExportSS
                 ,ngxExportSSS
                 ,ngxExportSLS
                 ,ngxExportBS
                 ,ngxExportBSS
                 ,ngxExportBLS
                 ,ngxExportYY
                 ,ngxExportBY
                 ,ngxExportIOYY
    -- *** Asynchronous handlers and services
                 ,ngxExportAsyncIOYY
                 ,ngxExportAsyncOnReqBody
                 ,ngxExportServiceIOYY
    -- *** Content handlers
                 ,ngxExportHandler
                 ,ngxExportDefHandler
                 ,ngxExportUnsafeHandler
                 ,ngxExportAsyncHandler
                 ,ngxExportAsyncHandlerOnReqBody
    -- *** Service hooks
                 ,ngxExportServiceHook
    -- *** Initialization hook
                 ,ngxExportInitHook
    -- * Accessing Nginx global objects
    -- *** Opaque pointers
                 ,ngxCyclePtr
                 ,ngxUpstreamMainConfPtr
                 ,ngxCachedTimePtr
    -- *** Primitive objects
                 ,ngxCachedPid
    -- * Accessing Nginx core functionality from Haskell handlers
                 ,TerminateWorkerProcess (..)
                 ,RestartWorkerProcess (..)
                 ,WorkerProcessIsExiting
                 ,FinalizeHTTPRequest (..)
    -- * Re-exported data constructors from /Foreign.C/
    -- | Re-exports are needed by exporters for marshalling in foreign calls.
                 ,Foreign.C.CInt (..)
                 ,Foreign.C.CUInt (..)
                 ) where

import           NgxExport.Internal.SafeFileLock

import           Language.Haskell.TH
import           Foreign.C
import           Foreign.Ptr
import           Foreign.StablePtr
import           Foreign.Storable
import           Foreign.Marshal.Alloc
import           Foreign.Marshal.Utils
import           System.IO.Unsafe
import           System.IO.Error
import           System.Posix.IO
import           System.Posix.Types
import           System.Posix.Signals hiding (Handler)
import           Control.Monad
import           Control.Monad.Loops
import           Control.DeepSeq
import qualified Control.Exception as E
import           Control.Exception hiding (Handler)
import           Control.Concurrent
import           Control.Concurrent.Async
import           GHC.IO.Exception (ioe_errno)
import           Data.IORef
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Internal as L
import qualified Data.ByteString.Lazy.Char8 as C8L
import           Data.Binary.Put
import           Data.Bits
import           Data.Version
import           Paths_ngx_export (version)

pattern I :: (Num i, Integral j) => i -> j
pattern $mI :: forall {r} {i} {j}.
(Num i, Integral j) =>
j -> (i -> r) -> ((# #) -> r) -> r
I i <- (fromIntegral -> i)
{-# COMPLETE I :: Int #-}
{-# COMPLETE I :: CInt #-}
{-# COMPLETE I :: CSize #-}

pattern PtrLen :: Num l => Ptr s -> l -> (Ptr s, Int)
pattern $mPtrLen :: forall {r} {l} {s}.
Num l =>
(Ptr s, Int) -> (Ptr s -> l -> r) -> ((# #) -> r) -> r
PtrLen s l <- (s, I l)

pattern ToBool :: (Num i, Eq i) => Bool -> i
pattern $mToBool :: forall {r} {i}.
(Num i, Eq i) =>
i -> (Bool -> r) -> ((# #) -> r) -> r
ToBool b <- (toBool -> b)
{-# COMPLETE ToBool :: CUInt #-}

-- | The /4-tuple/ contains
--   /(content, content-type, HTTP-status, response-headers)/.
type ContentHandlerResult = (L.ByteString, B.ByteString, Int, HTTPHeaders)

-- | The /3-tuple/ contains /(content, content-type, HTTP-status)/.
--
-- Both the /content/ and the /content-type/ are supposed to be referring to
-- low-level string literals that do not need to be freed upon an HTTP request
-- termination and must not be garbage-collected in the Haskell RTS.
type UnsafeContentHandlerResult = (B.ByteString, B.ByteString, Int)

-- | A list of HTTP headers comprised of /name-value/ pairs.
type HTTPHeaders = [(B.ByteString, B.ByteString)]

data NgxExport = SS              (String -> String)
               | SSS             (String -> String -> String)
               | SLS             ([String] -> String)
               | BS              (String -> Bool)
               | BSS             (String -> String -> Bool)
               | BLS             ([String] -> Bool)
               | YY              (B.ByteString -> L.ByteString)
               | BY              (B.ByteString -> Bool)
               | IOYY            (B.ByteString -> Bool -> IO L.ByteString)
               | IOYYY           (L.ByteString -> B.ByteString ->
                                     IO L.ByteString)
               | Handler         (B.ByteString -> ContentHandlerResult)
               | UnsafeHandler   (B.ByteString -> UnsafeContentHandlerResult)
               | AsyncHandler    (B.ByteString -> IO ContentHandlerResult)
               | AsyncHandlerRB  (L.ByteString -> B.ByteString ->
                                     IO ContentHandlerResult)

data NgxExportTypeAmbiguityTag = Unambiguous
                               | YYSync
                               | YYDefHandler
                               | IOYYSync
                               | IOYYAsync

data NgxStrType = NgxStrType CSize CString

instance Storable NgxStrType where
    alignment :: NgxStrType -> Int
alignment = Int -> NgxStrType -> Int
forall a b. a -> b -> a
const (Int -> NgxStrType -> Int) -> Int -> NgxStrType -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (CSize -> Int
forall a. Storable a => a -> Int
alignment (CSize
forall a. HasCallStack => a
undefined :: CSize))
                            (CString -> Int
forall a. Storable a => a -> Int
alignment (CString
forall a. HasCallStack => a
undefined :: CString))
    sizeOf :: NgxStrType -> Int
sizeOf = (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
*) (Int -> Int) -> (NgxStrType -> Int) -> NgxStrType -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NgxStrType -> Int
forall a. Storable a => a -> Int
alignment  -- must always be correct for
                                -- aligned struct ngx_str_t
    peek :: Ptr NgxStrType -> IO NgxStrType
peek Ptr NgxStrType
p = do
        CSize
n <- Ptr NgxStrType -> Int -> IO CSize
forall b. Ptr b -> Int -> IO CSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr NgxStrType
p Int
0
        CString
s <- Ptr NgxStrType -> Int -> IO CString
forall b. Ptr b -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr NgxStrType
p (Int -> IO CString) -> Int -> IO CString
forall a b. (a -> b) -> a -> b
$ NgxStrType -> Int
forall a. Storable a => a -> Int
alignment (NgxStrType
forall a. HasCallStack => a
undefined :: NgxStrType)
        NgxStrType -> IO NgxStrType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (NgxStrType -> IO NgxStrType) -> NgxStrType -> IO NgxStrType
forall a b. (a -> b) -> a -> b
$ CSize -> CString -> NgxStrType
NgxStrType CSize
n CString
s
    poke :: Ptr NgxStrType -> NgxStrType -> IO ()
poke Ptr NgxStrType
p x :: NgxStrType
x@(NgxStrType CSize
n CString
s) = do
        Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr NgxStrType -> Ptr CSize
forall a b. Ptr a -> Ptr b
castPtr Ptr NgxStrType
p) CSize
n
        Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr NgxStrType -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr NgxStrType
p (Int -> Ptr CString) -> Int -> Ptr CString
forall a b. (a -> b) -> a -> b
$ NgxStrType -> Int
forall a. Storable a => a -> Int
alignment NgxStrType
x) CString
s

type SSImpl =
    CString -> CInt -> Ptr CString -> Ptr CInt -> IO CUInt

type SSSImpl =
    CString -> CInt -> SSImpl

type SLSImpl =
    Ptr NgxStrType -> CInt -> Ptr CString -> Ptr CInt -> IO CUInt

type BSImpl =
    CString -> CInt -> Ptr CString -> Ptr CInt -> IO CUInt

type BSSImpl =
    CString -> CInt -> BSImpl

type BLSImpl =
    Ptr NgxStrType -> CInt -> Ptr CString -> Ptr CInt -> IO CUInt

type YYImpl =
    CString -> CInt -> Ptr (Ptr NgxStrType) -> Ptr CInt ->
    Ptr (StablePtr L.ByteString) -> IO CUInt

type BYImpl =
    CString -> CInt -> Ptr CString -> Ptr CInt -> IO CUInt

type AsyncIOCommonImpl =
    Ptr (Ptr NgxStrType) -> Ptr CInt ->
    Ptr CUInt -> Ptr (StablePtr L.ByteString) -> IO (StablePtr (Async ()))

type AsyncIOYYImpl =
    CString -> CInt -> CInt -> CInt ->
    Ptr CUInt -> CUInt -> CUInt -> AsyncIOCommonImpl

type AsyncIOYYYImpl =
    Ptr NgxStrType -> Ptr NgxStrType -> CInt ->
    CString -> CInt -> CInt -> CUInt -> AsyncIOCommonImpl

type HandlerImpl =
    CString -> CInt -> Ptr (Ptr NgxStrType) -> Ptr CInt ->
    Ptr CString -> Ptr CSize -> Ptr (StablePtr B.ByteString) -> Ptr CInt ->
    Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr (StablePtr L.ByteString) ->
    Ptr (StablePtr L.ByteString) -> IO CUInt

type DefHandlerImpl =
    CString -> CInt -> Ptr (Ptr NgxStrType) -> Ptr CInt ->
    Ptr CString -> Ptr (StablePtr L.ByteString) -> IO CUInt

type UnsafeHandlerImpl =
    CString -> CInt -> Ptr CString -> Ptr CSize ->
    Ptr CString -> Ptr CSize -> Ptr CInt -> IO CUInt

type AsyncHandlerImpl =
    CString -> CInt -> CInt -> CUInt ->
    Ptr CString -> Ptr CSize -> Ptr (StablePtr B.ByteString) -> Ptr CInt ->
    Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr (StablePtr L.ByteString) ->
    AsyncIOCommonImpl

type AsyncHandlerRBImpl =
    Ptr NgxStrType -> Ptr NgxStrType -> CInt -> AsyncHandlerImpl

type InitHookImpl =
    Ptr CString -> Ptr CInt -> IO CUInt

do
    TyConI (DataD _ _ _ _ tCs _) <- reify ''NgxExport
    TyConI (DataD _ _ _ _ aCs _) <- reify ''NgxExportTypeAmbiguityTag
    let tName = mkName "exportType"
        aName = mkName "exportTypeAmbiguity"
        tCons = map (\case
                         NormalC con [(_, typ)] -> (con, typ)
                         _ -> undefined
                    ) tCs
        aCons = map (\case
                         NormalC con [] -> con
                         _ -> undefined
                    ) aCs
    sequence $
        [sigD tName [t|NgxExport -> IO CInt|]
        ,funD tName $
             map (\(fst -> c, i) ->
                    clause [conP c [wildP]] (normalB [|return i|]) []
                 ) (zip tCons [1 ..] :: [((Name, Type), Int)])
        ,sigD aName [t|NgxExportTypeAmbiguityTag -> IO CInt|]
        ,funD aName $
             map (\(c, i) ->
                    clause [conP c []] (normalB [|return i|]) []
                 ) (zip aCons [0 ..] :: [(Name, Int)])
        ]
        ++
        map (\(c, t) -> tySynD (mkName $ nameBase c) [] $ return t) tCons

fExport :: String -> Name -> Type -> Dec
fExport :: String -> Name -> Type -> Dec
fExport = ((Foreign -> Dec
ForeignD (Foreign -> Dec) -> (Type -> Foreign) -> Type -> Dec
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Type -> Foreign) -> Type -> Dec)
-> (Name -> Type -> Foreign) -> Name -> Type -> Dec
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Name -> Type -> Foreign) -> Name -> Type -> Dec)
-> (String -> Name -> Type -> Foreign)
-> String
-> Name
-> Type
-> Dec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Callconv -> String -> Name -> Type -> Foreign
ExportF Callconv
CCall

fBody :: Q Exp -> [Q Clause]
fBody :: Q Exp -> [Q Clause]
fBody Q Exp
b = [[Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [] (Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB Q Exp
b) []]

-- Exporter -> Ambiguity -> Handler impl -> Handler name (Function) -> Decls
type NgxExportDec = Name -> Name -> Name -> Name -> Q [Dec]

ngxExport' :: (Name -> Q Exp) -> NgxExportDec
ngxExport' :: (Name -> Q Exp) -> NgxExportDec
ngxExport' Name -> Q Exp
mode Name
e Name
a Name
h Name
f = do
#if MIN_VERSION_template_haskell(2,16,0)
    AppT (AppT Type
ArrowT Type
_) typeF :: Type
typeF@(ConT Name
_) <- Name -> Q Type
reifyType Name
h
#else
    VarI _ (AppT (AppT ArrowT _) typeF@(ConT _)) _ <- reify h
#endif
    [Q Dec] -> Q [Dec]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
        [Name -> Q Type -> Q Dec
forall (m :: * -> *). Quote m => Name -> m Type -> m Dec
sigD Name
nameFt Q Type
typeFt
        ,Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD Name
nameFt ([Q Clause] -> Q Dec) -> [Q Clause] -> Q Dec
forall a b. (a -> b) -> a -> b
$ Q Exp -> [Q Clause]
fBody [|exportType $(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE Name
e Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
`appE` Q Exp
modeF)|]
        ,String -> Name -> Type -> Dec
fExport String
ftName Name
nameFt (Type -> Dec) -> Q Type -> Q Dec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Type
typeFt
        ,Name -> Q Type -> Q Dec
forall (m :: * -> *). Quote m => Name -> m Type -> m Dec
sigD Name
nameFta Q Type
typeFta
        ,Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD Name
nameFta ([Q Clause] -> Q Dec) -> [Q Clause] -> Q Dec
forall a b. (a -> b) -> a -> b
$ Q Exp -> [Q Clause]
fBody [|exportTypeAmbiguity $(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE Name
a)|]
        ,String -> Name -> Type -> Dec
fExport String
ftaName Name
nameFta (Type -> Dec) -> Q Type -> Q Dec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Type
typeFta
        ,Name -> Q Type -> Q Dec
forall (m :: * -> *). Quote m => Name -> m Type -> m Dec
sigD Name
nameF (Q Type -> Q Dec) -> Q Type -> Q Dec
forall a b. (a -> b) -> a -> b
$ Type -> Q Type
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return Type
typeF
        ,Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD Name
nameF ([Q Clause] -> Q Dec) -> [Q Clause] -> Q Dec
forall a b. (a -> b) -> a -> b
$ Q Exp -> [Q Clause]
fBody [|$(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
h) $Q Exp
modeF|]
        ,Dec -> Q Dec
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Dec -> Q Dec) -> Dec -> Q Dec
forall a b. (a -> b) -> a -> b
$ String -> Name -> Type -> Dec
fExport String
fName Name
nameF Type
typeF
        ]
    where modeF :: Q Exp
modeF   = Name -> Q Exp
mode Name
f
          fName :: String
fName   = String
"ngx_hs_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
nameBase Name
f
          nameF :: Name
nameF   = String -> Name
mkName String
fName
          ftName :: String
ftName  = String
"type_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fName
          nameFt :: Name
nameFt  = String -> Name
mkName String
ftName
          typeFt :: Q Type
typeFt  = [t|IO CInt|]
          ftaName :: String
ftaName = String
"ambiguity_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fName
          nameFta :: Name
nameFta = String -> Name
mkName String
ftaName
          typeFta :: Q Type
typeFta = [t|IO CInt|]

ngxExport :: NgxExportDec
ngxExport :: NgxExportDec
ngxExport = (Name -> Q Exp) -> NgxExportDec
ngxExport' Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE

ngxExportC :: NgxExportDec
ngxExportC :: NgxExportDec
ngxExportC = (Name -> Q Exp) -> NgxExportDec
ngxExport' ((Name -> Q Exp) -> NgxExportDec)
-> (Name -> Q Exp) -> NgxExportDec
forall a b. (a -> b) -> a -> b
$ Maybe (Q Exp) -> Q Exp -> Maybe (Q Exp) -> Q Exp
forall (m :: * -> *).
Quote m =>
Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp
infixE (Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp)) -> Q Exp -> Maybe (Q Exp)
forall a b. (a -> b) -> a -> b
$ Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE 'const) (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE '(.)) (Maybe (Q Exp) -> Q Exp)
-> (Name -> Maybe (Q Exp)) -> Name -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Q Exp -> Maybe (Q Exp))
-> (Name -> Q Exp) -> Name -> Maybe (Q Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE

-- $exporters
--
-- Nginx Haskell module aims at bringing regular Haskell code into Nginx
-- configuration. A special sort of functions to accomplish this is called
-- /exporters/. An exporter accepts a 'Name' of an /exported/ Haskell function
-- (also called /handler/) and generates appropriate FFI code.
--
-- Exporters export Haskell handlers of a few types:
--
-- * synchronous handlers,
-- * asynchronous handlers,
-- * services (which are asynchronous handlers that run in background),
-- * synchronous content handlers,
-- * asynchronous content handlers,
-- * synchronous service hooks.
--
-- Exporters accept handlers only of certain types. For example, exporter
-- 'ngxExportSS' accepts only functions of type /String -> String/.
--
-- Below is a simple example featuring synchronous handlers.
--
-- ==== File /test.hs/
--
-- @
-- {-\# LANGUAGE TemplateHaskell \#-}
--
-- module Test where
--
-- import           NgxExport
-- import qualified Data.Char as C
--
-- toUpper :: /String -> String/
-- toUpper = map C.toUpper
-- 'ngxExportSS' \'__/toUpper/__
--
-- 'ngxExportSS' \'__/reverse/__
--
-- isInList :: /[String] -> Bool/
-- isInList [] = False
-- isInList (x : xs) = x \`elem\` xs
-- 'ngxExportBLS' \'__/isInList/__
-- @
--
-- In this module, we declared three synchronous handlers: /toUpper/, /reverse/,
-- and /isInList/. Handler /reverse/ exports function /reverse/ from /Prelude/
-- which reverses lists.
--
-- ==== File /nginx.conf/
--
-- @
-- user                    nginx;
-- worker_processes        4;
--
-- events {
--     worker_connections  1024;
-- }
--
-- http {
--     default_type        application\/octet-stream;
--     sendfile            on;
--
--     haskell load \/var\/lib\/nginx\/test.so;
--
--     server {
--         listen          8010;
--         server_name     main;
--
--         location \/ {
--             __/haskell_run/__ __/toUpper/__ $hs_upper $arg_u;
--             __/haskell_run/__ __/reverse/__ $hs_reverse $arg_r;
--             __/haskell_run/__ __/isInList/__ $hs_isInList $arg_a $arg_b $arg_c $arg_d;
--             echo "toUpper $arg_u = $hs_upper";
--             echo "reverse $arg_r = $hs_reverse";
--             echo "$arg_a \`isInList\` [$arg_b, $arg_c, $arg_d] = $hs_isInList";
--         }
--     }
-- }
-- @
--
-- ==== A simple test
--
-- > $ curl 'http://127.0.0.1:8010/?u=hello&r=world&a=1&b=10&c=1'
-- > toUpper hello = HELLO
-- > reverse world = dlrow
-- > 1 `isInList` [10, 1, ] = 1
--
-- See documentation with more examples at
-- <https://nginx-haskell-module.readthedocs.io>.

-- | Exports a function of type
--
-- @
-- 'String' -> 'String'
-- @
--
-- for using in directive __/haskell_run/__.
ngxExportSS :: Name -> Q [Dec]
ngxExportSS :: Name -> Q [Dec]
ngxExportSS =
    NgxExportDec
ngxExport 'SS 'Unambiguous 'sS

-- | Exports a function of type
--
-- @
-- 'String' -> 'String' -> 'String'
-- @
--
-- for using in directive __/haskell_run/__.
ngxExportSSS :: Name -> Q [Dec]
ngxExportSSS :: Name -> Q [Dec]
ngxExportSSS =
    NgxExportDec
ngxExport 'SSS 'Unambiguous 'sSS

-- | Exports a function of type
--
-- @
-- ['String'] -> 'String'
-- @
--
-- for using in directive __/haskell_run/__.
ngxExportSLS :: Name -> Q [Dec]
ngxExportSLS :: Name -> Q [Dec]
ngxExportSLS =
    NgxExportDec
ngxExport 'SLS 'Unambiguous 'sLS

-- | Exports a function of type
--
-- @
-- 'String' -> 'Bool'
-- @
--
-- for using in directive __/haskell_run/__.
ngxExportBS :: Name -> Q [Dec]
ngxExportBS :: Name -> Q [Dec]
ngxExportBS =
    NgxExportDec
ngxExport 'BS 'Unambiguous 'bS

-- | Exports a function of type
--
-- @
-- 'String' -> 'String' -> 'Bool'
-- @
--
-- for using in directive __/haskell_run/__.
ngxExportBSS :: Name -> Q [Dec]
ngxExportBSS :: Name -> Q [Dec]
ngxExportBSS =
    NgxExportDec
ngxExport 'BSS 'Unambiguous 'bSS

-- | Exports a function of type
--
-- @
-- ['String'] -> 'Bool'
-- @
--
-- for using in directive __/haskell_run/__.
ngxExportBLS :: Name -> Q [Dec]
ngxExportBLS :: Name -> Q [Dec]
ngxExportBLS =
    NgxExportDec
ngxExport 'BLS 'Unambiguous 'bLS

-- | Exports a function of type
--
-- @
-- 'B.ByteString' -> 'L.ByteString'
-- @
--
-- for using in directive __/haskell_run/__.
ngxExportYY :: Name -> Q [Dec]
ngxExportYY :: Name -> Q [Dec]
ngxExportYY =
    NgxExportDec
ngxExport 'YY 'YYSync 'yY

-- | Exports a function of type
--
-- @
-- 'B.ByteString' -> 'Bool'
-- @
--
-- for using in directive __/haskell_run/__.
ngxExportBY :: Name -> Q [Dec]
ngxExportBY :: Name -> Q [Dec]
ngxExportBY =
    NgxExportDec
ngxExport 'BY 'Unambiguous 'bY

-- | Exports a function of type
--
-- @
-- 'B.ByteString' -> 'IO' 'L.ByteString'
-- @
--
-- for using in directive __/haskell_run/__.
ngxExportIOYY :: Name -> Q [Dec]
ngxExportIOYY :: Name -> Q [Dec]
ngxExportIOYY =
    NgxExportDec
ngxExportC 'IOYY 'IOYYSync 'ioyY

-- | Exports a function of type
--
-- @
-- 'B.ByteString' -> 'IO' 'L.ByteString'
-- @
--
-- for using in directive __/haskell_run_async/__.
ngxExportAsyncIOYY :: Name -> Q [Dec]
ngxExportAsyncIOYY :: Name -> Q [Dec]
ngxExportAsyncIOYY =
    NgxExportDec
ngxExportC 'IOYY 'IOYYAsync 'asyncIOYY

-- | Exports a function of type
--
-- @
-- 'L.ByteString' -> 'B.ByteString' -> 'IO' 'L.ByteString'
-- @
--
-- for using in directive __/haskell_run_async_on_request_body/__.
--
-- The first argument of the exported function contains buffers of the client
-- request body.
ngxExportAsyncOnReqBody :: Name -> Q [Dec]
ngxExportAsyncOnReqBody :: Name -> Q [Dec]
ngxExportAsyncOnReqBody =
    NgxExportDec
ngxExport 'IOYYY 'Unambiguous 'asyncIOYYY

-- | Exports a function of type
--
-- @
-- 'B.ByteString' -> 'Bool' -> 'IO' 'L.ByteString'
-- @
--
-- for using in directives __/haskell_run_service/__ and
-- __/haskell_service_var_update_callback/__.
--
-- The boolean argument of the exported function marks that the service is
-- being run for the first time.
ngxExportServiceIOYY :: Name -> Q [Dec]
ngxExportServiceIOYY :: Name -> Q [Dec]
ngxExportServiceIOYY =
    NgxExportDec
ngxExport 'IOYY 'IOYYAsync 'asyncIOYY

-- | Exports a function of type
--
-- @
-- 'B.ByteString' -> 'ContentHandlerResult'
-- @
--
-- for using in directives __/haskell_content/__ and
-- __/haskell_static_content/__.
ngxExportHandler :: Name -> Q [Dec]
ngxExportHandler :: Name -> Q [Dec]
ngxExportHandler =
    NgxExportDec
ngxExport 'Handler 'Unambiguous 'handler

-- | Exports a function of type
--
-- @
-- 'B.ByteString' -> 'L.ByteString'
-- @
--
-- for using in directives __/haskell_content/__ and
-- __/haskell_static_content/__.
ngxExportDefHandler :: Name -> Q [Dec]
ngxExportDefHandler :: Name -> Q [Dec]
ngxExportDefHandler =
    NgxExportDec
ngxExport 'YY 'YYDefHandler 'defHandler

-- | Exports a function of type
--
-- @
-- 'B.ByteString' -> 'UnsafeContentHandlerResult'
-- @
--
-- for using in directive __/haskell_unsafe_content/__.
ngxExportUnsafeHandler :: Name -> Q [Dec]
ngxExportUnsafeHandler :: Name -> Q [Dec]
ngxExportUnsafeHandler =
    NgxExportDec
ngxExport 'UnsafeHandler 'Unambiguous 'unsafeHandler

-- | Exports a function of type
--
-- @
-- 'B.ByteString' -> 'IO' 'ContentHandlerResult'
-- @
--
-- for using in directive __/haskell_async_content/__.
ngxExportAsyncHandler :: Name -> Q [Dec]
ngxExportAsyncHandler :: Name -> Q [Dec]
ngxExportAsyncHandler =
    NgxExportDec
ngxExport 'AsyncHandler 'Unambiguous 'asyncHandler

-- | Exports a function of type
--
-- @
-- 'L.ByteString' -> 'B.ByteString' -> 'IO' 'ContentHandlerResult'
-- @
--
-- for using in directive __/haskell_async_content_on_request_body/__.
--
-- The first argument of the exported function contains buffers of the client
-- request body.
ngxExportAsyncHandlerOnReqBody :: Name -> Q [Dec]
ngxExportAsyncHandlerOnReqBody :: Name -> Q [Dec]
ngxExportAsyncHandlerOnReqBody =
    NgxExportDec
ngxExport 'AsyncHandlerRB 'Unambiguous 'asyncHandlerRB

-- | Exports a function of type
--
-- @
-- 'B.ByteString' -> 'IO' 'L.ByteString'
-- @
--
-- for using in directives __/haskell_service_hook/__ and
-- __/haskell_service_update_hook/__.
ngxExportServiceHook :: Name -> Q [Dec]
ngxExportServiceHook :: Name -> Q [Dec]
ngxExportServiceHook =
    NgxExportDec
ngxExportC 'IOYY 'IOYYSync 'ioyYWithFree

-- | Exports an action of type
--
-- @
-- 'IO' ()
-- @
--
-- as a synchronous initialization hook.
--
-- This can be used to initialize global data /synchronously/ before starting
-- services and handling client requests. Note that asynchronous services that
-- write global data on the first run cannot guarantee the data has been
-- written before the start of processing client requests.
--
-- It is not possible to load more than one initialization hook. The hook is
-- only loaded if it has been directly declared in the target library,
-- initialization hooks found in dependent libraries are ignored.
--
-- The hook is not controlled by Nginx directives. If required, data for the
-- initialization hook can be passed in directive /haskell program_options/ and
-- handled with 'System.Environment.getArgs' inside it.
--
-- @since 1.7.10
ngxExportInitHook :: Name -> Q [Dec]
ngxExportInitHook :: Name -> Q [Dec]
ngxExportInitHook Name
f =
    [Q Dec] -> Q [Dec]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
        [Name -> Q Type -> Q Dec
forall (m :: * -> *). Quote m => Name -> m Type -> m Dec
sigD Name
nameF Q Type
typeF
        ,Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD Name
nameF ([Q Clause] -> Q Dec) -> [Q Clause] -> Q Dec
forall a b. (a -> b) -> a -> b
$ Q Exp -> [Q Clause]
fBody [|initHook $(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
f)|]
        ,String -> Name -> Type -> Dec
fExport String
fName Name
nameF (Type -> Dec) -> Q Type -> Q Dec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Type
typeF
        ]
    where fName :: String
fName = String
"ngx_hsinit_"
          nameF :: Name
nameF = String -> Name
mkName String
fName
          typeF :: Q Type
typeF = [t|InitHookImpl|]

data ServiceHookInterrupt = ServiceHookInterrupt

instance Exception ServiceHookInterrupt
instance Show ServiceHookInterrupt where
    show :: ServiceHookInterrupt -> String
show = String -> ServiceHookInterrupt -> String
forall a b. a -> b -> a
const String
"Service was interrupted by a service hook"

newtype ServiceSomeInterrupt = ServiceSomeInterrupt String

instance Exception ServiceSomeInterrupt
instance Show ServiceSomeInterrupt where
    show :: ServiceSomeInterrupt -> String
show (ServiceSomeInterrupt String
s) = String
s

-- | Terminates the worker process.
--
-- Being thrown from a service, this exception makes Nginx log the supplied
-- message and terminate the worker process without respawning. This can be
-- useful when the service is unable to read its configuration from the Nginx
-- configuration script or to perform an important initialization action.
--
-- @since 1.6.2
newtype TerminateWorkerProcess =
    TerminateWorkerProcess String  -- ^ Contains the message to log
    deriving TerminateWorkerProcess -> TerminateWorkerProcess -> Bool
(TerminateWorkerProcess -> TerminateWorkerProcess -> Bool)
-> (TerminateWorkerProcess -> TerminateWorkerProcess -> Bool)
-> Eq TerminateWorkerProcess
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TerminateWorkerProcess -> TerminateWorkerProcess -> Bool
== :: TerminateWorkerProcess -> TerminateWorkerProcess -> Bool
$c/= :: TerminateWorkerProcess -> TerminateWorkerProcess -> Bool
/= :: TerminateWorkerProcess -> TerminateWorkerProcess -> Bool
Eq

instance Exception TerminateWorkerProcess
instance Show TerminateWorkerProcess where
    show :: TerminateWorkerProcess -> String
show (TerminateWorkerProcess String
s) = String
s

-- | Restarts the worker process.
--
-- The same as 'TerminateWorkerProcess', except that a new worker process shall
-- be spawned by the Nginx master process in place of the current one.
--
-- @since 1.6.3
newtype RestartWorkerProcess =
    RestartWorkerProcess String  -- ^ Contains the message to log
    deriving RestartWorkerProcess -> RestartWorkerProcess -> Bool
(RestartWorkerProcess -> RestartWorkerProcess -> Bool)
-> (RestartWorkerProcess -> RestartWorkerProcess -> Bool)
-> Eq RestartWorkerProcess
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RestartWorkerProcess -> RestartWorkerProcess -> Bool
== :: RestartWorkerProcess -> RestartWorkerProcess -> Bool
$c/= :: RestartWorkerProcess -> RestartWorkerProcess -> Bool
/= :: RestartWorkerProcess -> RestartWorkerProcess -> Bool
Eq

instance Exception RestartWorkerProcess
instance Show RestartWorkerProcess where
    show :: RestartWorkerProcess -> String
show (RestartWorkerProcess String
s) = String
s

-- | Signals that the worker process is exiting.
--
-- This asynchronous exception is thrown from the Nginx core to all services
-- with 'cancelWith' when the working process is exiting. An exception handler
-- that catches this exception is expected to perform the service's specific
-- cleanup and finalization actions.
--
-- @since 1.6.4
data WorkerProcessIsExiting = WorkerProcessIsExiting deriving (Int -> WorkerProcessIsExiting -> String -> String
[WorkerProcessIsExiting] -> String -> String
WorkerProcessIsExiting -> String
(Int -> WorkerProcessIsExiting -> String -> String)
-> (WorkerProcessIsExiting -> String)
-> ([WorkerProcessIsExiting] -> String -> String)
-> Show WorkerProcessIsExiting
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> WorkerProcessIsExiting -> String -> String
showsPrec :: Int -> WorkerProcessIsExiting -> String -> String
$cshow :: WorkerProcessIsExiting -> String
show :: WorkerProcessIsExiting -> String
$cshowList :: [WorkerProcessIsExiting] -> String -> String
showList :: [WorkerProcessIsExiting] -> String -> String
Show, WorkerProcessIsExiting -> WorkerProcessIsExiting -> Bool
(WorkerProcessIsExiting -> WorkerProcessIsExiting -> Bool)
-> (WorkerProcessIsExiting -> WorkerProcessIsExiting -> Bool)
-> Eq WorkerProcessIsExiting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WorkerProcessIsExiting -> WorkerProcessIsExiting -> Bool
== :: WorkerProcessIsExiting -> WorkerProcessIsExiting -> Bool
$c/= :: WorkerProcessIsExiting -> WorkerProcessIsExiting -> Bool
/= :: WorkerProcessIsExiting -> WorkerProcessIsExiting -> Bool
Eq)

instance Exception WorkerProcessIsExiting where
    fromException :: SomeException -> Maybe WorkerProcessIsExiting
fromException = SomeException -> Maybe WorkerProcessIsExiting
forall e. Exception e => SomeException -> Maybe e
asyncExceptionFromException
    toException :: WorkerProcessIsExiting -> SomeException
toException = WorkerProcessIsExiting -> SomeException
forall e. Exception e => e -> SomeException
asyncExceptionToException

-- | Finalizes the HTTP request.
--
-- Being thrown from an asynchronous variable handler, this exception makes
-- Nginx finalize the current HTTP request with the supplied HTTP status and
-- an optional body. If the body is /Nothing/ then the response will be styled
-- by the Nginx core.
--
-- @since 1.6.3
data FinalizeHTTPRequest =
    FinalizeHTTPRequest Int (Maybe String)  -- ^ Contains HTTP status and body
    deriving FinalizeHTTPRequest -> FinalizeHTTPRequest -> Bool
(FinalizeHTTPRequest -> FinalizeHTTPRequest -> Bool)
-> (FinalizeHTTPRequest -> FinalizeHTTPRequest -> Bool)
-> Eq FinalizeHTTPRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FinalizeHTTPRequest -> FinalizeHTTPRequest -> Bool
== :: FinalizeHTTPRequest -> FinalizeHTTPRequest -> Bool
$c/= :: FinalizeHTTPRequest -> FinalizeHTTPRequest -> Bool
/= :: FinalizeHTTPRequest -> FinalizeHTTPRequest -> Bool
Eq

instance Exception FinalizeHTTPRequest
instance Show FinalizeHTTPRequest where
    show :: FinalizeHTTPRequest -> String
show (FinalizeHTTPRequest Int
_ (Just String
s)) = String
s
    show (FinalizeHTTPRequest Int
_ Maybe String
Nothing) = String
""

safeMallocBytes :: Int -> IO (Ptr a)
safeMallocBytes :: forall a. Int -> IO (Ptr a)
safeMallocBytes =
    (IO (Ptr a) -> (IOError -> IO (Ptr a)) -> IO (Ptr a))
-> (IOError -> IO (Ptr a)) -> IO (Ptr a) -> IO (Ptr a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO (Ptr a) -> (IOError -> IO (Ptr a)) -> IO (Ptr a)
forall a. IO a -> (IOError -> IO a) -> IO a
catchIOError (IO (Ptr a) -> IOError -> IO (Ptr a)
forall a b. a -> b -> a
const (IO (Ptr a) -> IOError -> IO (Ptr a))
-> IO (Ptr a) -> IOError -> IO (Ptr a)
forall a b. (a -> b) -> a -> b
$ Ptr a -> IO (Ptr a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
forall a. Ptr a
nullPtr) (IO (Ptr a) -> IO (Ptr a))
-> (Int -> IO (Ptr a)) -> Int -> IO (Ptr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IO (Ptr a)
forall a. Int -> IO (Ptr a)
mallocBytes
{-# INLINE safeMallocBytes #-}

safeNewCStringLen :: String -> IO CStringLen
safeNewCStringLen :: String -> IO CStringLen
safeNewCStringLen =
    (IO CStringLen -> (IOError -> IO CStringLen) -> IO CStringLen)
-> (IOError -> IO CStringLen) -> IO CStringLen -> IO CStringLen
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO CStringLen -> (IOError -> IO CStringLen) -> IO CStringLen
forall a. IO a -> (IOError -> IO a) -> IO a
catchIOError (IO CStringLen -> IOError -> IO CStringLen
forall a b. a -> b -> a
const (IO CStringLen -> IOError -> IO CStringLen)
-> IO CStringLen -> IOError -> IO CStringLen
forall a b. (a -> b) -> a -> b
$ CStringLen -> IO CStringLen
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CString
forall a. Ptr a
nullPtr, -Int
1)) (IO CStringLen -> IO CStringLen)
-> (String -> IO CStringLen) -> String -> IO CStringLen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO CStringLen
newCStringLen
{-# INLINE safeNewCStringLen #-}

peekNgxStringArrayLen :: (CStringLen -> IO a) -> Ptr NgxStrType -> Int -> IO [a]
peekNgxStringArrayLen :: forall a. (CStringLen -> IO a) -> Ptr NgxStrType -> Int -> IO [a]
peekNgxStringArrayLen CStringLen -> IO a
f Ptr NgxStrType
x = [IO a] -> IO [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([IO a] -> IO [a]) -> (Int -> [IO a]) -> Int -> IO [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (Int -> [IO a] -> [IO a]) -> [IO a] -> [Int] -> [IO a]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
k ->
            ((Ptr NgxStrType -> Int -> IO NgxStrType
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr NgxStrType
x Int
k IO NgxStrType -> (NgxStrType -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\(NgxStrType (I Int
m) CString
y) -> CStringLen -> IO a
f (CString
y, Int
m))) IO a -> [IO a] -> [IO a]
forall a. a -> [a] -> [a]
:)
          ) [] ([Int] -> [IO a]) -> (Int -> [Int]) -> Int -> [IO a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [Int] -> [Int]) -> [Int] -> Int -> [Int]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take [Int
0 ..]
{-# SPECIALIZE INLINE peekNgxStringArrayLen ::
    (CStringLen -> IO String) -> Ptr NgxStrType -> Int ->
        IO [String] #-}
{-# SPECIALIZE INLINE peekNgxStringArrayLen ::
    (CStringLen -> IO B.ByteString) -> Ptr NgxStrType -> Int ->
        IO [B.ByteString] #-}

peekNgxStringArrayLenLS :: Ptr NgxStrType -> Int -> IO [String]
peekNgxStringArrayLenLS :: Ptr NgxStrType -> Int -> IO [String]
peekNgxStringArrayLenLS =
    (CStringLen -> IO String) -> Ptr NgxStrType -> Int -> IO [String]
forall a. (CStringLen -> IO a) -> Ptr NgxStrType -> Int -> IO [a]
peekNgxStringArrayLen CStringLen -> IO String
peekCStringLen

peekNgxStringArrayLenY :: Ptr NgxStrType -> Int -> IO L.ByteString
peekNgxStringArrayLenY :: Ptr NgxStrType -> Int -> IO ByteString
peekNgxStringArrayLenY =
    (([ByteString] -> ByteString) -> IO [ByteString] -> IO ByteString
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ByteString] -> ByteString
L.fromChunks (IO [ByteString] -> IO ByteString)
-> (Int -> IO [ByteString]) -> Int -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Int -> IO [ByteString]) -> Int -> IO ByteString)
-> (Ptr NgxStrType -> Int -> IO [ByteString])
-> Ptr NgxStrType
-> Int
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CStringLen -> IO ByteString)
-> Ptr NgxStrType -> Int -> IO [ByteString]
forall a. (CStringLen -> IO a) -> Ptr NgxStrType -> Int -> IO [a]
peekNgxStringArrayLen CStringLen -> IO ByteString
B.unsafePackCStringLen

pokeCStringLen :: Storable a => CString -> a -> Ptr CString -> Ptr a -> IO ()
pokeCStringLen :: forall a.
Storable a =>
CString -> a -> Ptr CString -> Ptr a -> IO ()
pokeCStringLen CString
x a
n Ptr CString
p Ptr a
s = Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CString
p CString
x IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
s a
n
{-# SPECIALIZE INLINE pokeCStringLen ::
    CString -> CInt -> Ptr CString -> Ptr CInt -> IO () #-}
{-# SPECIALIZE INLINE pokeCStringLen ::
    CString -> CSize -> Ptr CString -> Ptr CSize -> IO () #-}

toBuffers :: L.ByteString -> Ptr NgxStrType -> IO (Ptr NgxStrType, Int)
toBuffers :: ByteString -> Ptr NgxStrType -> IO (Ptr NgxStrType, Int)
toBuffers ByteString
L.Empty Ptr NgxStrType
_ =
    (Ptr NgxStrType, Int) -> IO (Ptr NgxStrType, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr NgxStrType
forall a. Ptr a
nullPtr, Int
0)
toBuffers (L.Chunk ByteString
s ByteString
L.Empty) Ptr NgxStrType
p | Ptr NgxStrType
p Ptr NgxStrType -> Ptr NgxStrType -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr NgxStrType
forall a. Ptr a
nullPtr = do
    ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
s ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
x, I CSize
l) -> Ptr NgxStrType -> NgxStrType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr NgxStrType
p (NgxStrType -> IO ()) -> NgxStrType -> IO ()
forall a b. (a -> b) -> a -> b
$ CSize -> CString -> NgxStrType
NgxStrType CSize
l CString
x
    (Ptr NgxStrType, Int) -> IO (Ptr NgxStrType, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr NgxStrType
p, Int
1)
toBuffers ByteString
s Ptr NgxStrType
_ = do
    let n :: Int
n = (Int -> ByteString -> Int) -> Int -> ByteString -> Int
forall a. (a -> ByteString -> a) -> a -> ByteString -> a
L.foldlChunks (Int -> ByteString -> Int
forall a b. a -> b -> a
const (Int -> ByteString -> Int)
-> (Int -> Int) -> Int -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
succ) Int
0 ByteString
s
    Ptr NgxStrType
t <- Int -> IO (Ptr NgxStrType)
forall a. Int -> IO (Ptr a)
safeMallocBytes (Int -> IO (Ptr NgxStrType)) -> Int -> IO (Ptr NgxStrType)
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* NgxStrType -> Int
forall a. Storable a => a -> Int
sizeOf (NgxStrType
forall a. HasCallStack => a
undefined :: NgxStrType)
    if Ptr NgxStrType
t Ptr NgxStrType -> Ptr NgxStrType -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr NgxStrType
forall a. Ptr a
nullPtr
        then (Ptr NgxStrType, Int) -> IO (Ptr NgxStrType, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr NgxStrType
forall a. Ptr a
nullPtr, -Int
1)
        else (Ptr NgxStrType
t, ) (Int -> (Ptr NgxStrType, Int))
-> IO Int -> IO (Ptr NgxStrType, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                (IO Int -> ByteString -> IO Int) -> IO Int -> ByteString -> IO Int
forall a. (a -> ByteString -> a) -> a -> ByteString -> a
L.foldlChunks
                    (\IO Int
a ByteString
c -> do
                        Int
off <- IO Int
a
                        ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
c ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(CString
x, I CSize
l) ->
                            Ptr NgxStrType -> Int -> NgxStrType -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr NgxStrType
t Int
off (NgxStrType -> IO ()) -> NgxStrType -> IO ()
forall a b. (a -> b) -> a -> b
$ CSize -> CString -> NgxStrType
NgxStrType CSize
l CString
x
                        Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                    ) (Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0) ByteString
s

pokeLazyByteString :: L.ByteString ->
    Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr (StablePtr L.ByteString) -> IO ()
pokeLazyByteString :: ByteString
-> Ptr (Ptr NgxStrType)
-> Ptr CInt
-> Ptr (StablePtr ByteString)
-> IO ()
pokeLazyByteString ByteString
s Ptr (Ptr NgxStrType)
p Ptr CInt
pl Ptr (StablePtr ByteString)
spd = do
    Ptr NgxStrType
pv <- Ptr (Ptr NgxStrType) -> IO (Ptr NgxStrType)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr NgxStrType)
p
    PtrLen Ptr NgxStrType
t CInt
l <- ByteString -> Ptr NgxStrType -> IO (Ptr NgxStrType, Int)
toBuffers ByteString
s Ptr NgxStrType
pv
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
l CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
1 Bool -> Bool -> Bool
|| Ptr NgxStrType
pv Ptr NgxStrType -> Ptr NgxStrType -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr NgxStrType
forall a. Ptr a
nullPtr) (Ptr (Ptr NgxStrType) -> Ptr NgxStrType -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr NgxStrType)
p Ptr NgxStrType
t) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
pl CInt
l
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr NgxStrType
t Ptr NgxStrType -> Ptr NgxStrType -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr NgxStrType
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO (StablePtr ByteString)
forall a. a -> IO (StablePtr a)
newStablePtr ByteString
s IO (StablePtr ByteString)
-> (StablePtr ByteString -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr (StablePtr ByteString) -> StablePtr ByteString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (StablePtr ByteString)
spd

pokeContentTypeAndStatus :: B.ByteString ->
    Ptr CString -> Ptr CSize -> Ptr CInt -> CInt -> IO CSize
pokeContentTypeAndStatus :: ByteString
-> Ptr CString -> Ptr CSize -> Ptr CInt -> CInt -> IO CSize
pokeContentTypeAndStatus ByteString
ct Ptr CString
pct Ptr CSize
plct Ptr CInt
pst CInt
st = do
    PtrLen CString
sct CSize
lct <- ByteString -> (CStringLen -> IO CStringLen) -> IO CStringLen
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
ct CStringLen -> IO CStringLen
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    CString -> CSize -> Ptr CString -> Ptr CSize -> IO ()
forall a.
Storable a =>
CString -> a -> Ptr CString -> Ptr a -> IO ()
pokeCStringLen CString
sct CSize
lct Ptr CString
pct Ptr CSize
plct IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
pst CInt
st
    CSize -> IO CSize
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CSize
lct

peekRequestBodyChunks :: Ptr NgxStrType -> Ptr NgxStrType -> Int ->
    IO L.ByteString
peekRequestBodyChunks :: Ptr NgxStrType -> Ptr NgxStrType -> Int -> IO ByteString
peekRequestBodyChunks Ptr NgxStrType
tmpf Ptr NgxStrType
b Int
m =
    if Ptr NgxStrType
tmpf Ptr NgxStrType -> Ptr NgxStrType -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr NgxStrType
forall a. Ptr a
nullPtr
        then do
            ByteString
c <- Ptr NgxStrType -> IO NgxStrType
forall a. Storable a => Ptr a -> IO a
peek Ptr NgxStrType
tmpf IO NgxStrType -> (NgxStrType -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                (\(NgxStrType (I Int
l) CString
s) -> CStringLen -> IO String
peekCStringLen (CString
s, Int
l)) IO String -> (String -> IO ByteString) -> IO ByteString
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                    String -> IO ByteString
L.readFile
            ByteString -> Int64
L.length ByteString
c Int64 -> IO ByteString -> IO ByteString
forall a b. a -> b -> b
`seq` ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
c
        else Ptr NgxStrType -> Int -> IO ByteString
peekNgxStringArrayLenY Ptr NgxStrType
b Int
m

pokeAsyncHandlerData :: B.ByteString -> Ptr CString -> Ptr CSize ->
    Ptr (StablePtr B.ByteString) -> Ptr CInt -> CInt -> HTTPHeaders ->
    Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr (StablePtr L.ByteString) -> IO ()
pokeAsyncHandlerData :: ByteString
-> Ptr CString
-> Ptr CSize
-> Ptr (StablePtr ByteString)
-> Ptr CInt
-> CInt
-> [(ByteString, ByteString)]
-> Ptr (Ptr NgxStrType)
-> Ptr CInt
-> Ptr (StablePtr ByteString)
-> IO ()
pokeAsyncHandlerData ByteString
ct Ptr CString
pct Ptr CSize
plct Ptr (StablePtr ByteString)
spct Ptr CInt
pst CInt
st [(ByteString, ByteString)]
rhs Ptr (Ptr NgxStrType)
prhs Ptr CInt
plrhs Ptr (StablePtr ByteString)
sprhs = do
    CSize
lct <- ByteString
-> Ptr CString -> Ptr CSize -> Ptr CInt -> CInt -> IO CSize
pokeContentTypeAndStatus ByteString
ct Ptr CString
pct Ptr CSize
plct Ptr CInt
pst CInt
st
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CSize
lct CSize -> CSize -> Bool
forall a. Ord a => a -> a -> Bool
> CSize
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO (StablePtr ByteString)
forall a. a -> IO (StablePtr a)
newStablePtr ByteString
ct IO (StablePtr ByteString)
-> (StablePtr ByteString -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr (StablePtr ByteString) -> StablePtr ByteString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (StablePtr ByteString)
spct
    ByteString
-> Ptr (Ptr NgxStrType)
-> Ptr CInt
-> Ptr (StablePtr ByteString)
-> IO ()
pokeLazyByteString ([(ByteString, ByteString)] -> ByteString
fromHTTPHeaders [(ByteString, ByteString)]
rhs) Ptr (Ptr NgxStrType)
prhs Ptr CInt
plrhs Ptr (StablePtr ByteString)
sprhs

safeHandler :: Ptr CString -> Ptr CInt -> IO CUInt -> IO CUInt
safeHandler :: Ptr CString -> Ptr CInt -> IO CUInt -> IO CUInt
safeHandler Ptr CString
p Ptr CInt
pl = (SomeException -> IO CUInt) -> IO CUInt -> IO CUInt
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle ((SomeException -> IO CUInt) -> IO CUInt -> IO CUInt)
-> (SomeException -> IO CUInt) -> IO CUInt -> IO CUInt
forall a b. (a -> b) -> a -> b
$ \SomeException
e -> do
    PtrLen CString
x CInt
l <- String -> IO CStringLen
safeNewCStringLen (String -> IO CStringLen) -> String -> IO CStringLen
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show (SomeException
e :: SomeException)
    CString -> CInt -> Ptr CString -> Ptr CInt -> IO ()
forall a.
Storable a =>
CString -> a -> Ptr CString -> Ptr a -> IO ()
pokeCStringLen CString
x CInt
l Ptr CString
p Ptr CInt
pl
    CUInt -> IO CUInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CUInt
1

safeYYHandler :: IO (L.ByteString, CUInt) -> IO (L.ByteString, CUInt)
safeYYHandler :: IO (ByteString, CUInt) -> IO (ByteString, CUInt)
safeYYHandler = (SomeException -> IO (ByteString, CUInt))
-> IO (ByteString, CUInt) -> IO (ByteString, CUInt)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle ((SomeException -> IO (ByteString, CUInt))
 -> IO (ByteString, CUInt) -> IO (ByteString, CUInt))
-> (SomeException -> IO (ByteString, CUInt))
-> IO (ByteString, CUInt)
-> IO (ByteString, CUInt)
forall a b. (a -> b) -> a -> b
$ \SomeException
e ->
    (ByteString, CUInt) -> IO (ByteString, CUInt)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ByteString
C8L.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show (SomeException
e :: SomeException), CUInt
1)
{-# INLINE safeYYHandler #-}

safeAsyncYYHandler :: IO (L.ByteString, (CUInt, Bool)) ->
    IO (L.ByteString, (CUInt, Bool))
safeAsyncYYHandler :: IO (ByteString, (CUInt, Bool)) -> IO (ByteString, (CUInt, Bool))
safeAsyncYYHandler = (SomeException -> IO (ByteString, (CUInt, Bool)))
-> IO (ByteString, (CUInt, Bool)) -> IO (ByteString, (CUInt, Bool))
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle ((SomeException -> IO (ByteString, (CUInt, Bool)))
 -> IO (ByteString, (CUInt, Bool))
 -> IO (ByteString, (CUInt, Bool)))
-> (SomeException -> IO (ByteString, (CUInt, Bool)))
-> IO (ByteString, (CUInt, Bool))
-> IO (ByteString, (CUInt, Bool))
forall a b. (a -> b) -> a -> b
$ \SomeException
e ->
    (ByteString, (CUInt, Bool)) -> IO (ByteString, (CUInt, Bool))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ByteString
C8L.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
e,
            (case SomeException -> Maybe ServiceHookInterrupt
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
                Just ServiceHookInterrupt
ServiceHookInterrupt -> CUInt
2
                Maybe ServiceHookInterrupt
_ -> case SomeException -> Maybe TerminateWorkerProcess
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
                    Just (TerminateWorkerProcess String
_) -> CUInt
3
                    Maybe TerminateWorkerProcess
_ -> case SomeException -> Maybe RestartWorkerProcess
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
                        Just (RestartWorkerProcess String
_) -> CUInt
4
                        Maybe RestartWorkerProcess
_ -> case SomeException -> Maybe FinalizeHTTPRequest
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
                            Just (FinalizeHTTPRequest Int
st (Just String
_)) ->
                                CUInt
0x80000000 CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.|. Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
st
                            Just (FinalizeHTTPRequest Int
st Maybe String
Nothing) ->
                                CUInt
0xC0000000 CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.|. Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
st
                            Maybe FinalizeHTTPRequest
_ -> case SomeException -> Maybe ServiceSomeInterrupt
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
                                Just (ServiceSomeInterrupt String
_) -> CUInt
5
                                Maybe ServiceSomeInterrupt
_ -> CUInt
1
            ,case SomeException -> Maybe WorkerProcessIsExiting
forall e. Exception e => SomeException -> Maybe e
asyncExceptionFromException SomeException
e of
                Just WorkerProcessIsExiting
WorkerProcessIsExiting -> Bool
True
                Maybe WorkerProcessIsExiting
_ -> Bool
False
            )
           )
{-# INLINE safeAsyncYYHandler #-}

fromHTTPHeaders :: HTTPHeaders -> L.ByteString
fromHTTPHeaders :: [(ByteString, ByteString)] -> ByteString
fromHTTPHeaders = [ByteString] -> ByteString
L.fromChunks ([ByteString] -> ByteString)
-> ([(ByteString, ByteString)] -> [ByteString])
-> [(ByteString, ByteString)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, ByteString) -> [ByteString] -> [ByteString])
-> [ByteString] -> [(ByteString, ByteString)] -> [ByteString]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(ByteString
a, ByteString
b) -> (ByteString -> ByteString
z ByteString
a ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:) ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString
z ByteString
b ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:)) []
    where z :: ByteString -> ByteString
z ByteString
s | ByteString -> Bool
B.null ByteString
s = Word8 -> ByteString
B.singleton Word8
0
              | Bool
otherwise = ByteString
s

isIOError :: Errno -> IOError -> Bool
isIOError :: Errno -> IOError -> Bool
isIOError (Errno CInt
e) = (CInt -> Maybe CInt
forall a. a -> Maybe a
Just CInt
e Maybe CInt -> Maybe CInt -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe CInt -> Bool) -> (IOError -> Maybe CInt) -> IOError -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Maybe CInt
ioe_errno
{-# INLINE isIOError #-}

isEINTR :: IOError -> Bool
isEINTR :: IOError -> Bool
isEINTR = Errno -> IOError -> Bool
isIOError Errno
eINTR
{-# INLINE isEINTR #-}

isEDEADLK :: IOError -> Bool
isEDEADLK :: IOError -> Bool
isEDEADLK = Errno -> IOError -> Bool
isIOError Errno
eDEADLK
{-# INLINE isEDEADLK #-}

sS :: SS -> SSImpl
sS :: (String -> String) -> SSImpl
sS String -> String
f CString
x (I Int
n) Ptr CString
p Ptr CInt
pl =
    Ptr CString -> Ptr CInt -> IO CUInt -> IO CUInt
safeHandler Ptr CString
p Ptr CInt
pl (IO CUInt -> IO CUInt) -> IO CUInt -> IO CUInt
forall a b. (a -> b) -> a -> b
$ do
        PtrLen CString
s CInt
l <- CStringLen -> IO String
peekCStringLen (CString
x, Int
n) IO String -> (String -> IO CStringLen) -> IO CStringLen
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO CStringLen
newCStringLen (String -> IO CStringLen)
-> (String -> String) -> String -> IO CStringLen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f
        CString -> CInt -> Ptr CString -> Ptr CInt -> IO ()
forall a.
Storable a =>
CString -> a -> Ptr CString -> Ptr a -> IO ()
pokeCStringLen CString
s CInt
l Ptr CString
p Ptr CInt
pl
        CUInt -> IO CUInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CUInt
0

sSS :: SSS -> SSSImpl
sSS :: (String -> String -> String) -> SSSImpl
sSS String -> String -> String
f CString
x (I Int
n) CString
y (I Int
m) Ptr CString
p Ptr CInt
pl =
    Ptr CString -> Ptr CInt -> IO CUInt -> IO CUInt
safeHandler Ptr CString
p Ptr CInt
pl (IO CUInt -> IO CUInt) -> IO CUInt -> IO CUInt
forall a b. (a -> b) -> a -> b
$ do
        PtrLen CString
s CInt
l <- String -> String -> String
f (String -> String -> String) -> IO String -> IO (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO String
peekCStringLen (CString
x, Int
n)
                        IO (String -> String) -> IO String -> IO String
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CStringLen -> IO String
peekCStringLen (CString
y, Int
m)
                        IO String -> (String -> IO CStringLen) -> IO CStringLen
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO CStringLen
newCStringLen
        CString -> CInt -> Ptr CString -> Ptr CInt -> IO ()
forall a.
Storable a =>
CString -> a -> Ptr CString -> Ptr a -> IO ()
pokeCStringLen CString
s CInt
l Ptr CString
p Ptr CInt
pl
        CUInt -> IO CUInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CUInt
0

sLS :: SLS -> SLSImpl
sLS :: ([String] -> String) -> SLSImpl
sLS [String] -> String
f Ptr NgxStrType
x (I Int
n) Ptr CString
p Ptr CInt
pl =
    Ptr CString -> Ptr CInt -> IO CUInt -> IO CUInt
safeHandler Ptr CString
p Ptr CInt
pl (IO CUInt -> IO CUInt) -> IO CUInt -> IO CUInt
forall a b. (a -> b) -> a -> b
$ do
        PtrLen CString
s CInt
l <- Ptr NgxStrType -> Int -> IO [String]
peekNgxStringArrayLenLS Ptr NgxStrType
x Int
n IO [String] -> ([String] -> IO CStringLen) -> IO CStringLen
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO CStringLen
newCStringLen (String -> IO CStringLen)
-> ([String] -> String) -> [String] -> IO CStringLen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
f
        CString -> CInt -> Ptr CString -> Ptr CInt -> IO ()
forall a.
Storable a =>
CString -> a -> Ptr CString -> Ptr a -> IO ()
pokeCStringLen CString
s CInt
l Ptr CString
p Ptr CInt
pl
        CUInt -> IO CUInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CUInt
0

yY :: YY -> YYImpl
yY :: (ByteString -> ByteString) -> YYImpl
yY ByteString -> ByteString
f CString
x (I Int
n) Ptr (Ptr NgxStrType)
p Ptr CInt
pl Ptr (StablePtr ByteString)
spd = do
    (ByteString
s, CUInt
r) <- IO (ByteString, CUInt) -> IO (ByteString, CUInt)
safeYYHandler (IO (ByteString, CUInt) -> IO (ByteString, CUInt))
-> IO (ByteString, CUInt) -> IO (ByteString, CUInt)
forall a b. (a -> b) -> a -> b
$ do
        ByteString
s <- ByteString -> ByteString
f (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO ByteString
B.unsafePackCStringLen (CString
x, Int
n)
        (ByteString -> (ByteString, CUInt))
-> IO ByteString -> IO (ByteString, CUInt)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, CUInt
0) (IO ByteString -> IO (ByteString, CUInt))
-> IO ByteString -> IO (ByteString, CUInt)
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. NFData a => (a -> b) -> a -> b
$!! ByteString
s
    ByteString
-> Ptr (Ptr NgxStrType)
-> Ptr CInt
-> Ptr (StablePtr ByteString)
-> IO ()
pokeLazyByteString ByteString
s Ptr (Ptr NgxStrType)
p Ptr CInt
pl Ptr (StablePtr ByteString)
spd
    CUInt -> IO CUInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CUInt
r

ioyYCommon :: (CStringLen -> IO B.ByteString) -> IOYY -> YYImpl
ioyYCommon :: (CStringLen -> IO ByteString)
-> (ByteString -> Bool -> IO ByteString) -> YYImpl
ioyYCommon CStringLen -> IO ByteString
pack ByteString -> Bool -> IO ByteString
f CString
x (I Int
n) Ptr (Ptr NgxStrType)
p Ptr CInt
pl Ptr (StablePtr ByteString)
spd = do
    (ByteString
s, CUInt
r) <- IO (ByteString, CUInt) -> IO (ByteString, CUInt)
safeYYHandler (IO (ByteString, CUInt) -> IO (ByteString, CUInt))
-> IO (ByteString, CUInt) -> IO (ByteString, CUInt)
forall a b. (a -> b) -> a -> b
$ do
        ByteString
s <- CStringLen -> IO ByteString
pack (CString
x, Int
n) IO ByteString -> (ByteString -> IO ByteString) -> IO ByteString
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ByteString -> Bool -> IO ByteString)
-> Bool -> ByteString -> IO ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> Bool -> IO ByteString
f Bool
False
        (ByteString -> (ByteString, CUInt))
-> IO ByteString -> IO (ByteString, CUInt)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, CUInt
0) (IO ByteString -> IO (ByteString, CUInt))
-> IO ByteString -> IO (ByteString, CUInt)
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. NFData a => (a -> b) -> a -> b
$!! ByteString
s
    ByteString
-> Ptr (Ptr NgxStrType)
-> Ptr CInt
-> Ptr (StablePtr ByteString)
-> IO ()
pokeLazyByteString ByteString
s Ptr (Ptr NgxStrType)
p Ptr CInt
pl Ptr (StablePtr ByteString)
spd
    CUInt -> IO CUInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CUInt
r

ioyY :: IOYY -> YYImpl
ioyY :: (ByteString -> Bool -> IO ByteString) -> YYImpl
ioyY = (CStringLen -> IO ByteString)
-> (ByteString -> Bool -> IO ByteString) -> YYImpl
ioyYCommon CStringLen -> IO ByteString
B.unsafePackCStringLen

ioyYWithFree :: IOYY -> YYImpl
ioyYWithFree :: (ByteString -> Bool -> IO ByteString) -> YYImpl
ioyYWithFree = (CStringLen -> IO ByteString)
-> (ByteString -> Bool -> IO ByteString) -> YYImpl
ioyYCommon CStringLen -> IO ByteString
B.unsafePackMallocCStringLen

asyncIOFlag1b :: B.ByteString
asyncIOFlag1b :: ByteString
asyncIOFlag1b = ByteString -> ByteString
L.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Word8 -> Put
putWord8 Word8
1

asyncIOFlag8b :: B.ByteString
asyncIOFlag8b :: ByteString
asyncIOFlag8b = ByteString -> ByteString
L.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Word64 -> Put
putWord64host Word64
1

asyncIOCommon :: IO (L.ByteString, Bool) -> CInt -> Bool -> AsyncIOCommonImpl
asyncIOCommon :: IO (ByteString, Bool) -> CInt -> Bool -> AsyncIOCommonImpl
asyncIOCommon IO (ByteString, Bool)
a (I Fd
fd) Bool
efd Ptr (Ptr NgxStrType)
p Ptr CInt
pl Ptr CUInt
pr Ptr (StablePtr ByteString)
spd = IO (StablePtr (Async ())) -> IO (StablePtr (Async ()))
forall a. IO a -> IO a
mask_ (IO (StablePtr (Async ())) -> IO (StablePtr (Async ())))
-> IO (StablePtr (Async ())) -> IO (StablePtr (Async ()))
forall a b. (a -> b) -> a -> b
$
    IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async
    (do
        (ByteString
s, (CUInt
r, Bool
exiting)) <- IO (ByteString, (CUInt, Bool)) -> IO (ByteString, (CUInt, Bool))
safeAsyncYYHandler (IO (ByteString, (CUInt, Bool)) -> IO (ByteString, (CUInt, Bool)))
-> IO (ByteString, (CUInt, Bool)) -> IO (ByteString, (CUInt, Bool))
forall a b. (a -> b) -> a -> b
$ do
            (ByteString
s, Bool
exiting) <- IO (ByteString, Bool)
a
            IO (ByteString, (CUInt, Bool)) -> IO (ByteString, (CUInt, Bool))
forall a. IO a -> IO a
E.interruptible (IO (ByteString, (CUInt, Bool)) -> IO (ByteString, (CUInt, Bool)))
-> IO (ByteString, (CUInt, Bool)) -> IO (ByteString, (CUInt, Bool))
forall a b. (a -> b) -> a -> b
$ (ByteString -> (ByteString, (CUInt, Bool)))
-> IO ByteString -> IO (ByteString, (CUInt, Bool))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, (CUInt
0, Bool
exiting)) (IO ByteString -> IO (ByteString, (CUInt, Bool)))
-> IO ByteString -> IO (ByteString, (CUInt, Bool))
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. NFData a => (a -> b) -> a -> b
$!! ByteString
s
        ByteString
-> Ptr (Ptr NgxStrType)
-> Ptr CInt
-> Ptr (StablePtr ByteString)
-> IO ()
pokeLazyByteString ByteString
s Ptr (Ptr NgxStrType)
p Ptr CInt
pl Ptr (StablePtr ByteString)
spd
        Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CUInt
pr CUInt
r
        if Bool
exiting
            then Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
efd IO ()
closeChannel
            else IO () -> IO ()
forall a. IO a -> IO a
uninterruptibleMask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                    if Bool
efd
                        then IO ()
writeFlag8b
                        else IO ()
writeFlag1b IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
closeChannel
    ) IO (Async ())
-> (Async () -> IO (StablePtr (Async ())))
-> IO (StablePtr (Async ()))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Async () -> IO (StablePtr (Async ()))
forall a. a -> IO (StablePtr a)
newStablePtr
    where writeBufN :: CSize -> Ptr a -> IO ()
writeBufN CSize
n Ptr a
s =
              (CSize -> Bool) -> (CSize -> IO CSize) -> CSize -> IO CSize
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> (a -> m a) -> a -> m a
iterateUntilM (CSize -> CSize -> Bool
forall a. Ord a => a -> a -> Bool
>= CSize
n)
              (\CSize
w -> (CSize
w CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
+) (CSize -> CSize) -> IO CSize -> IO CSize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                  Fd -> Ptr Word8 -> CSize -> IO CSize
fdWriteBuf Fd
fd (Ptr a -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr a
s (Int -> Ptr Word8) -> Int -> Ptr Word8
forall a b. (a -> b) -> a -> b
$ CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
w) (CSize
n CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
- CSize
w)
                  IO CSize -> (IOError -> IO CSize) -> IO CSize
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError`
                  (\IOError
e -> CSize -> IO CSize
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> IO CSize) -> CSize -> IO CSize
forall a b. (a -> b) -> a -> b
$ if IOError -> Bool
isEINTR IOError
e
                                      then CSize
0
                                      else CSize
n CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
+ CSize
1
                  )
              ) CSize
0 IO CSize -> (CSize -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CSize
w -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CSize
w CSize -> CSize -> Bool
forall a. Ord a => a -> a -> Bool
> CSize
n) IO ()
cleanupOnWriteError
          writeFlag1b :: IO ()
writeFlag1b = ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
asyncIOFlag1b ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ CSize -> CString -> IO ()
forall {a}. CSize -> Ptr a -> IO ()
writeBufN CSize
1
          writeFlag8b :: IO ()
writeFlag8b = ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
asyncIOFlag8b ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ CSize -> CString -> IO ()
forall {a}. CSize -> Ptr a -> IO ()
writeBufN CSize
8
          closeChannel :: IO ()
closeChannel = Fd -> IO ()
closeFd Fd
fd IO () -> (IOError -> IO ()) -> IO ()
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` IO () -> IOError -> IO ()
forall a b. a -> b -> a
const (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
          -- FIXME: cleanupOnWriteError should free all previously allocated
          -- data and stable pointers. However, leaving this not implemented
          -- seems to be safe because Nginx won't close the event channel or
          -- delete the request object (for request-driven handlers)
          -- regardless of the Haskell handler's duration.
          cleanupOnWriteError :: IO ()
cleanupOnWriteError = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

asyncIOYY :: IOYY -> AsyncIOYYImpl
asyncIOYY :: (ByteString -> Bool -> IO ByteString) -> AsyncIOYYImpl
asyncIOYY ByteString -> Bool -> IO ByteString
f CString
x (I Int
n) CInt
fd (I Fd
fdlk) Ptr CUInt
active (ToBool Bool
efd) (ToBool Bool
fstRun) =
    IO (ByteString, Bool) -> CInt -> Bool -> AsyncIOCommonImpl
asyncIOCommon
    (do
        Bool
exiting <- if Bool
fstRun Bool -> Bool -> Bool
&& Fd
fdlk Fd -> Fd -> Bool
forall a. Eq a => a -> a -> Bool
/= -Fd
1
                       then Fd -> IO CInt
getBestLockImpl Fd
fdlk IO CInt -> (CInt -> IO Bool) -> IO Bool
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Fd -> CInt -> IO Bool
acquireLock Fd
fdlk
                       else Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        if Bool
exiting
            then (ByteString, Bool) -> IO (ByteString, Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
L.empty, Bool
True)
            else do
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
fstRun (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CUInt
active CUInt
1
                ByteString
x' <- CStringLen -> IO ByteString
B.unsafePackCStringLen (CString
x, Int
n)
                IO (ByteString, Bool) -> IO (ByteString, Bool)
forall a. IO a -> IO a
E.interruptible (IO (ByteString, Bool) -> IO (ByteString, Bool))
-> IO (ByteString, Bool) -> IO (ByteString, Bool)
forall a b. (a -> b) -> a -> b
$ (, Bool
False) (ByteString -> (ByteString, Bool))
-> IO ByteString -> IO (ByteString, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Bool -> IO ByteString
f ByteString
x' Bool
fstRun
    ) CInt
fd Bool
efd
    where acquireLock :: Fd -> CInt -> IO Bool
acquireLock Fd
lk CInt
cmd = (Bool, Bool) -> Bool
forall a b. (a, b) -> b
snd ((Bool, Bool) -> Bool) -> IO (Bool, Bool) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
              ((Bool, Bool) -> Bool) -> IO (Bool, Bool) -> IO (Bool, Bool)
forall (m :: * -> *) a. Monad m => (a -> Bool) -> m a -> m a
iterateUntil (Bool, Bool) -> Bool
forall a b. (a, b) -> a
fst
              (IO (Bool, Bool) -> IO (Bool, Bool)
forall a. IO a -> IO a
E.interruptible
                   (Fd -> CInt -> IO ()
safeWaitToSetLock Fd
lk CInt
cmd IO () -> IO (Bool, Bool) -> IO (Bool, Bool)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Bool, Bool) -> IO (Bool, Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Bool
False))
               IO (Bool, Bool) -> [Handler (Bool, Bool)] -> IO (Bool, Bool)
forall a. IO a -> [Handler a] -> IO a
`catches`
               [(IOError -> IO (Bool, Bool)) -> Handler (Bool, Bool)
forall a e. Exception e => (e -> IO a) -> Handler a
E.Handler ((IOError -> IO (Bool, Bool)) -> Handler (Bool, Bool))
-> (IOError -> IO (Bool, Bool)) -> Handler (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ \IOError
e ->
                   if IOError -> Bool
isEINTR IOError
e
                       then (Bool, Bool) -> IO (Bool, Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Bool
False)
                       else do
                           -- wait some time to avoid fastly repeated calls;
                           -- threadDelay is interruptible even in exception
                           -- handlers
                           Bool
exiting <- (Int -> IO ()
threadDelay Int
500000 IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
                               IO Bool -> [Handler Bool] -> IO Bool
forall a. IO a -> [Handler a] -> IO a
`catches`
                               [(WorkerProcessIsExiting -> IO Bool) -> Handler Bool
forall a e. Exception e => (e -> IO a) -> Handler a
E.Handler ((WorkerProcessIsExiting -> IO Bool) -> Handler Bool)
-> (WorkerProcessIsExiting -> IO Bool) -> Handler Bool
forall a b. (a -> b) -> a -> b
$ Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool)
-> (WorkerProcessIsExiting -> Bool)
-> WorkerProcessIsExiting
-> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkerProcessIsExiting -> WorkerProcessIsExiting -> Bool
forall a. Eq a => a -> a -> Bool
== WorkerProcessIsExiting
WorkerProcessIsExiting)
                               ,(SomeException -> IO Bool) -> Handler Bool
forall a e. Exception e => (e -> IO a) -> Handler a
E.Handler (IO Bool -> SomeException -> IO Bool
forall a b. a -> b -> a
const (IO Bool -> SomeException -> IO Bool)
-> IO Bool -> SomeException -> IO Bool
forall a b. (a -> b) -> a -> b
$ Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False ::
                                              SomeException -> IO Bool
                                          )
                               ]
                           if Bool
exiting
                               then (Bool, Bool) -> IO (Bool, Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Bool
True)
                               else if IOError -> Bool
isEDEADLK IOError
e
                                        then (Bool, Bool) -> IO (Bool, Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Bool
False)
                                        else ServiceSomeInterrupt -> IO (Bool, Bool)
forall e a. Exception e => e -> IO a
throwIO (ServiceSomeInterrupt -> IO (Bool, Bool))
-> ServiceSomeInterrupt -> IO (Bool, Bool)
forall a b. (a -> b) -> a -> b
$
                                            String -> ServiceSomeInterrupt
ServiceSomeInterrupt (String -> ServiceSomeInterrupt) -> String -> ServiceSomeInterrupt
forall a b. (a -> b) -> a -> b
$ IOError -> String
forall a. Show a => a -> String
show IOError
e
               ,(WorkerProcessIsExiting -> IO (Bool, Bool)) -> Handler (Bool, Bool)
forall a e. Exception e => (e -> IO a) -> Handler a
E.Handler ((WorkerProcessIsExiting -> IO (Bool, Bool))
 -> Handler (Bool, Bool))
-> (WorkerProcessIsExiting -> IO (Bool, Bool))
-> Handler (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ (Bool, Bool) -> IO (Bool, Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool, Bool) -> IO (Bool, Bool))
-> (WorkerProcessIsExiting -> (Bool, Bool))
-> WorkerProcessIsExiting
-> IO (Bool, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool
True, ) (Bool -> (Bool, Bool))
-> (WorkerProcessIsExiting -> Bool)
-> WorkerProcessIsExiting
-> (Bool, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkerProcessIsExiting -> WorkerProcessIsExiting -> Bool
forall a. Eq a => a -> a -> Bool
== WorkerProcessIsExiting
WorkerProcessIsExiting)
               ,(SomeException -> IO (Bool, Bool)) -> Handler (Bool, Bool)
forall a e. Exception e => (e -> IO a) -> Handler a
E.Handler (ServiceSomeInterrupt -> IO (Bool, Bool)
forall e a. Exception e => e -> IO a
throwIO (ServiceSomeInterrupt -> IO (Bool, Bool))
-> (SomeException -> ServiceSomeInterrupt)
-> SomeException
-> IO (Bool, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ServiceSomeInterrupt
ServiceSomeInterrupt (String -> ServiceSomeInterrupt)
-> (SomeException -> String)
-> SomeException
-> ServiceSomeInterrupt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall a. Show a => a -> String
show ::
                              SomeException -> IO (Bool, Bool)
                          )
               ]
              )

asyncIOYYY :: IOYYY -> AsyncIOYYYImpl
asyncIOYYY :: (ByteString -> ByteString -> IO ByteString) -> AsyncIOYYYImpl
asyncIOYYY ByteString -> ByteString -> IO ByteString
f Ptr NgxStrType
tmpf Ptr NgxStrType
b (I Int
m) CString
x (I Int
n) CInt
fd (ToBool Bool
efd) =
    IO (ByteString, Bool) -> CInt -> Bool -> AsyncIOCommonImpl
asyncIOCommon
    (do
        ByteString
b' <- Ptr NgxStrType -> Ptr NgxStrType -> Int -> IO ByteString
peekRequestBodyChunks Ptr NgxStrType
tmpf Ptr NgxStrType
b Int
m
        ByteString
x' <- CStringLen -> IO ByteString
B.unsafePackCStringLen (CString
x, Int
n)
        IO (ByteString, Bool) -> IO (ByteString, Bool)
forall a. IO a -> IO a
E.interruptible (IO (ByteString, Bool) -> IO (ByteString, Bool))
-> IO (ByteString, Bool) -> IO (ByteString, Bool)
forall a b. (a -> b) -> a -> b
$ (, Bool
False) (ByteString -> (ByteString, Bool))
-> IO ByteString -> IO (ByteString, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> ByteString -> IO ByteString
f ByteString
b' ByteString
x'
    ) CInt
fd Bool
efd

asyncHandler :: AsyncHandler -> AsyncHandlerImpl
asyncHandler :: (ByteString -> IO ContentHandlerResult) -> AsyncHandlerImpl
asyncHandler ByteString -> IO ContentHandlerResult
f CString
x (I Int
n) CInt
fd (ToBool Bool
efd) Ptr CString
pct Ptr CSize
plct Ptr (StablePtr ByteString)
spct Ptr CInt
pst
        Ptr (Ptr NgxStrType)
prhs Ptr CInt
plrhs Ptr (StablePtr ByteString)
sprhs =
    IO (ByteString, Bool) -> CInt -> Bool -> AsyncIOCommonImpl
asyncIOCommon
    (do
        ByteString
x' <- CStringLen -> IO ByteString
B.unsafePackCStringLen (CString
x, Int
n)
        (ByteString
s, ByteString
ct, I CInt
st, [(ByteString, ByteString)]
rhs) <- IO ContentHandlerResult -> IO ContentHandlerResult
forall a. IO a -> IO a
E.interruptible (IO ContentHandlerResult -> IO ContentHandlerResult)
-> IO ContentHandlerResult -> IO ContentHandlerResult
forall a b. (a -> b) -> a -> b
$ do
            ContentHandlerResult
v <- ByteString -> IO ContentHandlerResult
f ByteString
x'
            ContentHandlerResult -> IO ContentHandlerResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ContentHandlerResult -> IO ContentHandlerResult)
-> ContentHandlerResult -> IO ContentHandlerResult
forall a b. NFData a => (a -> b) -> a -> b
$!! ContentHandlerResult
v
        ByteString
-> Ptr CString
-> Ptr CSize
-> Ptr (StablePtr ByteString)
-> Ptr CInt
-> CInt
-> [(ByteString, ByteString)]
-> Ptr (Ptr NgxStrType)
-> Ptr CInt
-> Ptr (StablePtr ByteString)
-> IO ()
pokeAsyncHandlerData ByteString
ct Ptr CString
pct Ptr CSize
plct Ptr (StablePtr ByteString)
spct Ptr CInt
pst CInt
st [(ByteString, ByteString)]
rhs Ptr (Ptr NgxStrType)
prhs Ptr CInt
plrhs Ptr (StablePtr ByteString)
sprhs
        (ByteString, Bool) -> IO (ByteString, Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
s, Bool
False)
    ) CInt
fd Bool
efd

asyncHandlerRB :: AsyncHandlerRB -> AsyncHandlerRBImpl
asyncHandlerRB :: (ByteString -> ByteString -> IO ContentHandlerResult)
-> AsyncHandlerRBImpl
asyncHandlerRB ByteString -> ByteString -> IO ContentHandlerResult
f Ptr NgxStrType
tmpf Ptr NgxStrType
b (I Int
m) CString
x (I Int
n) CInt
fd (ToBool Bool
efd) Ptr CString
pct Ptr CSize
plct Ptr (StablePtr ByteString)
spct Ptr CInt
pst
        Ptr (Ptr NgxStrType)
prhs Ptr CInt
plrhs Ptr (StablePtr ByteString)
sprhs =
    IO (ByteString, Bool) -> CInt -> Bool -> AsyncIOCommonImpl
asyncIOCommon
    (do
        ByteString
b' <- Ptr NgxStrType -> Ptr NgxStrType -> Int -> IO ByteString
peekRequestBodyChunks Ptr NgxStrType
tmpf Ptr NgxStrType
b Int
m
        ByteString
x' <- CStringLen -> IO ByteString
B.unsafePackCStringLen (CString
x, Int
n)
        (ByteString
s, ByteString
ct, I CInt
st, [(ByteString, ByteString)]
rhs) <- IO ContentHandlerResult -> IO ContentHandlerResult
forall a. IO a -> IO a
E.interruptible (IO ContentHandlerResult -> IO ContentHandlerResult)
-> IO ContentHandlerResult -> IO ContentHandlerResult
forall a b. (a -> b) -> a -> b
$ do
            ContentHandlerResult
v <- ByteString -> ByteString -> IO ContentHandlerResult
f ByteString
b' ByteString
x'
            ContentHandlerResult -> IO ContentHandlerResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ContentHandlerResult -> IO ContentHandlerResult)
-> ContentHandlerResult -> IO ContentHandlerResult
forall a b. NFData a => (a -> b) -> a -> b
$!! ContentHandlerResult
v
        ByteString
-> Ptr CString
-> Ptr CSize
-> Ptr (StablePtr ByteString)
-> Ptr CInt
-> CInt
-> [(ByteString, ByteString)]
-> Ptr (Ptr NgxStrType)
-> Ptr CInt
-> Ptr (StablePtr ByteString)
-> IO ()
pokeAsyncHandlerData ByteString
ct Ptr CString
pct Ptr CSize
plct Ptr (StablePtr ByteString)
spct Ptr CInt
pst CInt
st [(ByteString, ByteString)]
rhs Ptr (Ptr NgxStrType)
prhs Ptr CInt
plrhs Ptr (StablePtr ByteString)
sprhs
        (ByteString, Bool) -> IO (ByteString, Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
s, Bool
False)
    ) CInt
fd Bool
efd

bS :: BS -> BSImpl
bS :: (String -> Bool) -> SSImpl
bS String -> Bool
f CString
x (I Int
n) Ptr CString
p Ptr CInt
pl =
    Ptr CString -> Ptr CInt -> IO CUInt -> IO CUInt
safeHandler Ptr CString
p Ptr CInt
pl (IO CUInt -> IO CUInt) -> IO CUInt -> IO CUInt
forall a b. (a -> b) -> a -> b
$ do
        CUInt
r <- Bool -> CUInt
forall a. Num a => Bool -> a
fromBool (Bool -> CUInt) -> (String -> Bool) -> String -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
f (String -> CUInt) -> IO String -> IO CUInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO String
peekCStringLen (CString
x, Int
n)
        CString -> CInt -> Ptr CString -> Ptr CInt -> IO ()
forall a.
Storable a =>
CString -> a -> Ptr CString -> Ptr a -> IO ()
pokeCStringLen CString
forall a. Ptr a
nullPtr CInt
0 Ptr CString
p Ptr CInt
pl
        CUInt -> IO CUInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CUInt
r

bSS :: BSS -> BSSImpl
bSS :: (String -> String -> Bool) -> SSSImpl
bSS String -> String -> Bool
f CString
x (I Int
n) CString
y (I Int
m) Ptr CString
p Ptr CInt
pl =
    Ptr CString -> Ptr CInt -> IO CUInt -> IO CUInt
safeHandler Ptr CString
p Ptr CInt
pl (IO CUInt -> IO CUInt) -> IO CUInt -> IO CUInt
forall a b. (a -> b) -> a -> b
$ do
        CUInt
r <- (Bool -> CUInt
forall a. Num a => Bool -> a
fromBool (Bool -> CUInt) -> (String -> Bool) -> String -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((String -> Bool) -> String -> CUInt)
-> (String -> String -> Bool) -> String -> String -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Bool
f (String -> String -> CUInt) -> IO String -> IO (String -> CUInt)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO String
peekCStringLen (CString
x, Int
n)
                              IO (String -> CUInt) -> IO String -> IO CUInt
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CStringLen -> IO String
peekCStringLen (CString
y, Int
m)
        CString -> CInt -> Ptr CString -> Ptr CInt -> IO ()
forall a.
Storable a =>
CString -> a -> Ptr CString -> Ptr a -> IO ()
pokeCStringLen CString
forall a. Ptr a
nullPtr CInt
0 Ptr CString
p Ptr CInt
pl
        CUInt -> IO CUInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CUInt
r

bLS :: BLS -> BLSImpl
bLS :: ([String] -> Bool) -> SLSImpl
bLS [String] -> Bool
f Ptr NgxStrType
x (I Int
n) Ptr CString
p Ptr CInt
pl =
    Ptr CString -> Ptr CInt -> IO CUInt -> IO CUInt
safeHandler Ptr CString
p Ptr CInt
pl (IO CUInt -> IO CUInt) -> IO CUInt -> IO CUInt
forall a b. (a -> b) -> a -> b
$ do
        CUInt
r <- Bool -> CUInt
forall a. Num a => Bool -> a
fromBool (Bool -> CUInt) -> ([String] -> Bool) -> [String] -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
f ([String] -> CUInt) -> IO [String] -> IO CUInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr NgxStrType -> Int -> IO [String]
peekNgxStringArrayLenLS Ptr NgxStrType
x Int
n
        CString -> CInt -> Ptr CString -> Ptr CInt -> IO ()
forall a.
Storable a =>
CString -> a -> Ptr CString -> Ptr a -> IO ()
pokeCStringLen CString
forall a. Ptr a
nullPtr CInt
0 Ptr CString
p Ptr CInt
pl
        CUInt -> IO CUInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CUInt
r

bY :: BY -> BYImpl
bY :: (ByteString -> Bool) -> SSImpl
bY ByteString -> Bool
f CString
x (I Int
n) Ptr CString
p Ptr CInt
pl =
    Ptr CString -> Ptr CInt -> IO CUInt -> IO CUInt
safeHandler Ptr CString
p Ptr CInt
pl (IO CUInt -> IO CUInt) -> IO CUInt -> IO CUInt
forall a b. (a -> b) -> a -> b
$ do
        CUInt
r <- Bool -> CUInt
forall a. Num a => Bool -> a
fromBool (Bool -> CUInt) -> (ByteString -> Bool) -> ByteString -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
f (ByteString -> CUInt) -> IO ByteString -> IO CUInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO ByteString
B.unsafePackCStringLen (CString
x, Int
n)
        CString -> CInt -> Ptr CString -> Ptr CInt -> IO ()
forall a.
Storable a =>
CString -> a -> Ptr CString -> Ptr a -> IO ()
pokeCStringLen CString
forall a. Ptr a
nullPtr CInt
0 Ptr CString
p Ptr CInt
pl
        CUInt -> IO CUInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CUInt
r

handler :: Handler -> HandlerImpl
handler :: (ByteString -> ContentHandlerResult) -> HandlerImpl
handler ByteString -> ContentHandlerResult
f CString
x (I Int
n) Ptr (Ptr NgxStrType)
p Ptr CInt
pl Ptr CString
pct Ptr CSize
plct Ptr (StablePtr ByteString)
spct Ptr CInt
pst Ptr (Ptr NgxStrType)
prhs Ptr CInt
plrhs Ptr (StablePtr ByteString)
sprhs Ptr (StablePtr ByteString)
spd =
    Ptr CString -> Ptr CInt -> IO CUInt -> IO CUInt
safeHandler Ptr CString
pct Ptr CInt
pst (IO CUInt -> IO CUInt) -> IO CUInt -> IO CUInt
forall a b. (a -> b) -> a -> b
$ do
        v :: ContentHandlerResult
v@(ByteString
s, ByteString
ct, I CInt
st, [(ByteString, ByteString)]
rhs) <- ByteString -> ContentHandlerResult
f (ByteString -> ContentHandlerResult)
-> IO ByteString -> IO ContentHandlerResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO ByteString
B.unsafePackCStringLen (CString
x, Int
n)
        CSize
lct <- (ContentHandlerResult -> IO ContentHandlerResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ContentHandlerResult -> IO ContentHandlerResult)
-> ContentHandlerResult -> IO ContentHandlerResult
forall a b. NFData a => (a -> b) -> a -> b
$!! ContentHandlerResult
v) IO ContentHandlerResult -> IO CSize -> IO CSize
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString
-> Ptr CString -> Ptr CSize -> Ptr CInt -> CInt -> IO CSize
pokeContentTypeAndStatus ByteString
ct Ptr CString
pct Ptr CSize
plct Ptr CInt
pst CInt
st
        (CSize -> IO CSize
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CSize -> IO CSize) -> CSize -> IO CSize
forall a b. NFData a => (a -> b) -> a -> b
$!! CSize
lct) IO CSize -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
            ByteString
-> Ptr (Ptr NgxStrType)
-> Ptr CInt
-> Ptr (StablePtr ByteString)
-> IO ()
pokeLazyByteString ([(ByteString, ByteString)] -> ByteString
fromHTTPHeaders [(ByteString, ByteString)]
rhs) Ptr (Ptr NgxStrType)
prhs Ptr CInt
plrhs Ptr (StablePtr ByteString)
sprhs
        ByteString
-> Ptr (Ptr NgxStrType)
-> Ptr CInt
-> Ptr (StablePtr ByteString)
-> IO ()
pokeLazyByteString ByteString
s Ptr (Ptr NgxStrType)
p Ptr CInt
pl Ptr (StablePtr ByteString)
spd
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CSize
lct CSize -> CSize -> Bool
forall a. Ord a => a -> a -> Bool
> CSize
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO (StablePtr ByteString)
forall a. a -> IO (StablePtr a)
newStablePtr ByteString
ct IO (StablePtr ByteString)
-> (StablePtr ByteString -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr (StablePtr ByteString) -> StablePtr ByteString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (StablePtr ByteString)
spct
        CUInt -> IO CUInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CUInt
0

defHandler :: YY -> DefHandlerImpl
defHandler :: (ByteString -> ByteString) -> DefHandlerImpl
defHandler ByteString -> ByteString
f CString
x (I Int
n) Ptr (Ptr NgxStrType)
p Ptr CInt
pl Ptr CString
pe Ptr (StablePtr ByteString)
spd =
    Ptr CString -> Ptr CInt -> IO CUInt -> IO CUInt
safeHandler Ptr CString
pe Ptr CInt
pl (IO CUInt -> IO CUInt) -> IO CUInt -> IO CUInt
forall a b. (a -> b) -> a -> b
$ do
        ByteString
s <- ByteString -> ByteString
f (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO ByteString
B.unsafePackCStringLen (CString
x, Int
n)
        ByteString
-> Ptr (Ptr NgxStrType)
-> Ptr CInt
-> Ptr (StablePtr ByteString)
-> IO ()
pokeLazyByteString ByteString
s Ptr (Ptr NgxStrType)
p Ptr CInt
pl Ptr (StablePtr ByteString)
spd
        CUInt -> IO CUInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CUInt
0

unsafeHandler :: UnsafeHandler -> UnsafeHandlerImpl
unsafeHandler :: (ByteString -> UnsafeContentHandlerResult) -> UnsafeHandlerImpl
unsafeHandler ByteString -> UnsafeContentHandlerResult
f CString
x (I Int
n) Ptr CString
p Ptr CSize
pl Ptr CString
pct Ptr CSize
plct Ptr CInt
pst =
    Ptr CString -> Ptr CInt -> IO CUInt -> IO CUInt
safeHandler Ptr CString
pct Ptr CInt
pst (IO CUInt -> IO CUInt) -> IO CUInt -> IO CUInt
forall a b. (a -> b) -> a -> b
$ do
        v :: UnsafeContentHandlerResult
v@(ByteString
s, ByteString
ct, I CInt
st) <- ByteString -> UnsafeContentHandlerResult
f (ByteString -> UnsafeContentHandlerResult)
-> IO ByteString -> IO UnsafeContentHandlerResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO ByteString
B.unsafePackCStringLen (CString
x, Int
n)
        (UnsafeContentHandlerResult -> IO UnsafeContentHandlerResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UnsafeContentHandlerResult -> IO UnsafeContentHandlerResult)
-> UnsafeContentHandlerResult -> IO UnsafeContentHandlerResult
forall a b. NFData a => (a -> b) -> a -> b
$!! UnsafeContentHandlerResult
v) IO UnsafeContentHandlerResult -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO CSize -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ByteString
-> Ptr CString -> Ptr CSize -> Ptr CInt -> CInt -> IO CSize
pokeContentTypeAndStatus ByteString
ct Ptr CString
pct Ptr CSize
plct Ptr CInt
pst CInt
st)
        PtrLen CString
t CSize
l <- ByteString -> (CStringLen -> IO CStringLen) -> IO CStringLen
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
s CStringLen -> IO CStringLen
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
        CString -> CSize -> Ptr CString -> Ptr CSize -> IO ()
forall a.
Storable a =>
CString -> a -> Ptr CString -> Ptr a -> IO ()
pokeCStringLen CString
t CSize
l Ptr CString
p Ptr CSize
pl
        CUInt -> IO CUInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CUInt
0

initHook :: IO () -> InitHookImpl
initHook :: IO () -> InitHookImpl
initHook IO ()
f Ptr CString
p Ptr CInt
pl =
    Ptr CString -> Ptr CInt -> IO CUInt -> IO CUInt
safeHandler Ptr CString
p Ptr CInt
pl (IO CUInt -> IO CUInt) -> IO CUInt -> IO CUInt
forall a b. (a -> b) -> a -> b
$ IO ()
f IO () -> IO CUInt -> IO CUInt
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CUInt -> IO CUInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CUInt
0

foreign export ccall ngxExportInstallSignalHandler :: IO ()
ngxExportInstallSignalHandler :: IO ()
ngxExportInstallSignalHandler :: IO ()
ngxExportInstallSignalHandler = IO Handler -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Handler -> IO ()) -> IO Handler -> IO ()
forall a b. (a -> b) -> a -> b
$
    CInt -> Handler -> Maybe SignalSet -> IO Handler
installHandler CInt
keyboardSignal Handler
Ignore Maybe SignalSet
forall a. Maybe a
Nothing

foreign export ccall ngxExportTerminateTask ::
    StablePtr (Async ()) -> IO ()
ngxExportTerminateTask ::
    StablePtr (Async ()) -> IO ()
ngxExportTerminateTask :: StablePtr (Async ()) -> IO ()
ngxExportTerminateTask = StablePtr (Async ()) -> IO (Async ())
forall a. StablePtr a -> IO a
deRefStablePtr (StablePtr (Async ()) -> IO (Async ()))
-> (Async () -> IO ()) -> StablePtr (Async ()) -> IO ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
    (Async () -> WorkerProcessIsExiting -> IO ())
-> WorkerProcessIsExiting -> Async () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Async () -> WorkerProcessIsExiting -> IO ()
forall e a. Exception e => Async a -> e -> IO ()
cancelWith WorkerProcessIsExiting
WorkerProcessIsExiting

foreign export ccall ngxExportServiceHookInterrupt ::
    StablePtr (Async ()) -> IO ()
ngxExportServiceHookInterrupt ::
    StablePtr (Async ()) -> IO ()
ngxExportServiceHookInterrupt :: StablePtr (Async ()) -> IO ()
ngxExportServiceHookInterrupt = StablePtr (Async ()) -> IO (Async ())
forall a. StablePtr a -> IO a
deRefStablePtr (StablePtr (Async ()) -> IO (Async ()))
-> (Async () -> IO ()) -> StablePtr (Async ()) -> IO ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
    (ThreadId -> ServiceHookInterrupt -> IO ())
-> ServiceHookInterrupt -> ThreadId -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ThreadId -> ServiceHookInterrupt -> IO ()
forall e. Exception e => ThreadId -> e -> IO ()
throwTo ServiceHookInterrupt
ServiceHookInterrupt (ThreadId -> IO ()) -> (Async () -> ThreadId) -> Async () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async () -> ThreadId
forall a. Async a -> ThreadId
asyncThreadId

foreign export ccall ngxExportVersion ::
    Ptr CInt -> CInt -> IO CInt
ngxExportVersion ::
    Ptr CInt -> CInt -> IO CInt
ngxExportVersion :: Ptr CInt -> CInt -> IO CInt
ngxExportVersion Ptr CInt
x (I Int
n) = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> IO Int -> IO CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (Int -> Int -> IO Int) -> Int -> [Int] -> IO Int
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Int
k (I CInt
v) -> Ptr CInt -> Int -> CInt -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr CInt
x Int
k CInt
v IO () -> IO Int -> IO Int
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Int
0
        (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
n ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Version -> [Int]
versionBranch Version
version)

-- | Returns an opaque pointer to the Nginx /cycle object/
--   for using it in C plugins.
--
-- The actual type of the returned pointer is
--
-- > ngx_cycle_t *
--
-- (the value of argument __/cycle/__ in the worker's initialization function).
ngxCyclePtr :: IO (Ptr ())
ngxCyclePtr :: IO (Ptr ())
ngxCyclePtr = IORef (Ptr ()) -> IO (Ptr ())
forall a. IORef a -> IO a
readIORef IORef (Ptr ())
ngxCyclePtrStore

-- | Returns an opaque pointer to the Nginx /upstream main configuration/
--   for using it in C plugins.
--
-- The actual type of the returned pointer is
--
-- > ngx_http_upstream_main_conf_t *
--
-- (the value of expression
-- @ngx_http_cycle_get_module_main_conf(cycle, ngx_http_upstream_module)@ in
-- the worker's initialization function).
ngxUpstreamMainConfPtr :: IO (Ptr ())
ngxUpstreamMainConfPtr :: IO (Ptr ())
ngxUpstreamMainConfPtr = IORef (Ptr ()) -> IO (Ptr ())
forall a. IORef a -> IO a
readIORef IORef (Ptr ())
ngxUpstreamMainConfPtrStore

-- | Returns an opaque pointer to the Nginx /cached time object/
--   for using it in C plugins.
--
-- The actual type of the returned pointer is
--
-- > volatile ngx_time_t **
--
-- (the /address/ of the Nginx global variable __/ngx_cached_time/__).
--
-- Be aware that time gotten from this pointer is not reliable in asynchronous
-- tasks and services as soon as it gets updated only when some event happens
-- inside the Nginx worker to which the task is bound and thus can be heavily
-- outdated.
ngxCachedTimePtr :: IO (Ptr (Ptr ()))
ngxCachedTimePtr :: IO (Ptr (Ptr ()))
ngxCachedTimePtr = IORef (Ptr (Ptr ())) -> IO (Ptr (Ptr ()))
forall a. IORef a -> IO a
readIORef IORef (Ptr (Ptr ()))
ngxCachedTimePtrStore

-- | Returns the /PID/ of the current worker process cached in Nginx.
--
-- @since 1.7.1
ngxCachedPid :: IO CPid
ngxCachedPid :: IO CPid
ngxCachedPid = IORef CPid -> IO CPid
forall a. IORef a -> IO a
readIORef IORef CPid
ngxCachedPidStore

foreign export ccall ngxExportSetCyclePtr :: Ptr () -> IO ()
ngxExportSetCyclePtr :: Ptr () -> IO ()
ngxExportSetCyclePtr :: Ptr () -> IO ()
ngxExportSetCyclePtr = IORef (Ptr ()) -> Ptr () -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr ())
ngxCyclePtrStore

foreign export ccall ngxExportSetUpstreamMainConfPtr :: Ptr () -> IO ()
ngxExportSetUpstreamMainConfPtr :: Ptr () -> IO ()
ngxExportSetUpstreamMainConfPtr :: Ptr () -> IO ()
ngxExportSetUpstreamMainConfPtr = IORef (Ptr ()) -> Ptr () -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr ())
ngxUpstreamMainConfPtrStore

foreign export ccall ngxExportSetCachedTimePtr :: Ptr (Ptr ()) -> IO ()
ngxExportSetCachedTimePtr :: Ptr (Ptr ()) -> IO ()
ngxExportSetCachedTimePtr :: Ptr (Ptr ()) -> IO ()
ngxExportSetCachedTimePtr = IORef (Ptr (Ptr ())) -> Ptr (Ptr ()) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Ptr (Ptr ()))
ngxCachedTimePtrStore

foreign export ccall ngxExportSetCachedPid :: CPid -> IO ()
ngxExportSetCachedPid :: CPid -> IO ()
ngxExportSetCachedPid :: CPid -> IO ()
ngxExportSetCachedPid = IORef CPid -> CPid -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef CPid
ngxCachedPidStore

ngxCyclePtrStore :: IORef (Ptr ())
ngxCyclePtrStore :: IORef (Ptr ())
ngxCyclePtrStore = IO (IORef (Ptr ())) -> IORef (Ptr ())
forall a. IO a -> a
unsafePerformIO (IO (IORef (Ptr ())) -> IORef (Ptr ()))
-> IO (IORef (Ptr ())) -> IORef (Ptr ())
forall a b. (a -> b) -> a -> b
$ Ptr () -> IO (IORef (Ptr ()))
forall a. a -> IO (IORef a)
newIORef Ptr ()
forall a. Ptr a
nullPtr
{-# NOINLINE ngxCyclePtrStore #-}

ngxUpstreamMainConfPtrStore :: IORef (Ptr ())
ngxUpstreamMainConfPtrStore :: IORef (Ptr ())
ngxUpstreamMainConfPtrStore = IO (IORef (Ptr ())) -> IORef (Ptr ())
forall a. IO a -> a
unsafePerformIO (IO (IORef (Ptr ())) -> IORef (Ptr ()))
-> IO (IORef (Ptr ())) -> IORef (Ptr ())
forall a b. (a -> b) -> a -> b
$ Ptr () -> IO (IORef (Ptr ()))
forall a. a -> IO (IORef a)
newIORef Ptr ()
forall a. Ptr a
nullPtr
{-# NOINLINE ngxUpstreamMainConfPtrStore #-}

ngxCachedTimePtrStore :: IORef (Ptr (Ptr ()))
ngxCachedTimePtrStore :: IORef (Ptr (Ptr ()))
ngxCachedTimePtrStore = IO (IORef (Ptr (Ptr ()))) -> IORef (Ptr (Ptr ()))
forall a. IO a -> a
unsafePerformIO (IO (IORef (Ptr (Ptr ()))) -> IORef (Ptr (Ptr ())))
-> IO (IORef (Ptr (Ptr ()))) -> IORef (Ptr (Ptr ()))
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr ()) -> IO (IORef (Ptr (Ptr ())))
forall a. a -> IO (IORef a)
newIORef Ptr (Ptr ())
forall a. Ptr a
nullPtr
{-# NOINLINE ngxCachedTimePtrStore #-}

ngxCachedPidStore :: IORef CPid
ngxCachedPidStore :: IORef CPid
ngxCachedPidStore = IO (IORef CPid) -> IORef CPid
forall a. IO a -> a
unsafePerformIO (IO (IORef CPid) -> IORef CPid) -> IO (IORef CPid) -> IORef CPid
forall a b. (a -> b) -> a -> b
$ CPid -> IO (IORef CPid)
forall a. a -> IO (IORef a)
newIORef (-CPid
1)
{-# NOINLINE ngxCachedPidStore #-}