ngx-export-1.7.10: Helper module for Nginx Haskell module
Copyright(c) Alexey Radkov 2016-2024
LicenseBSD-style
Maintaineralexey.radkov@gmail.com
Stabilitystable
Portabilitynon-portable (requires POSIX and Template Haskell)
Safe HaskellSafe-Inferred
LanguageHaskell2010

NgxExport

Description

Nginx / Haskell interoperability layer and exporters of regular Haskell functions at Nginx level for using in configuration directives of nginx-haskell-module.

Synopsis

Type declarations

type ContentHandlerResult = (ByteString, ByteString, Int, HTTPHeaders) Source #

The 4-tuple contains (content, content-type, HTTP-status, response-headers).

type UnsafeContentHandlerResult = (ByteString, ByteString, Int) Source #

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 HTTPHeaders = [(ByteString, ByteString)] Source #

A list of HTTP headers comprised of name-value pairs.

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.

Synchronous handlers

ngxExportSS :: Name -> Q [Dec] Source #

Exports a function of type

String -> String

for using in directive haskell_run.

ngxExportSSS :: Name -> Q [Dec] Source #

Exports a function of type

String -> String -> String

for using in directive haskell_run.

ngxExportSLS :: Name -> Q [Dec] Source #

Exports a function of type

[String] -> String

for using in directive haskell_run.

ngxExportBS :: Name -> Q [Dec] Source #

Exports a function of type

String -> Bool

for using in directive haskell_run.

ngxExportBSS :: Name -> Q [Dec] Source #

Exports a function of type

String -> String -> Bool

for using in directive haskell_run.

ngxExportBLS :: Name -> Q [Dec] Source #

Exports a function of type

[String] -> Bool

for using in directive haskell_run.

ngxExportYY :: Name -> Q [Dec] Source #

Exports a function of type

ByteString -> ByteString

for using in directive haskell_run.

ngxExportBY :: Name -> Q [Dec] Source #

Exports a function of type

ByteString -> Bool

for using in directive haskell_run.

ngxExportIOYY :: Name -> Q [Dec] Source #

Exports a function of type

ByteString -> IO ByteString

for using in directive haskell_run.

Asynchronous handlers and services

ngxExportAsyncIOYY :: Name -> Q [Dec] Source #

Exports a function of type

ByteString -> IO ByteString

for using in directive haskell_run_async.

ngxExportAsyncOnReqBody :: Name -> Q [Dec] Source #

Exports a function of type

ByteString -> ByteString -> IO 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.

ngxExportServiceIOYY :: Name -> Q [Dec] Source #

Exports a function of type

ByteString -> Bool -> IO 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.

Content handlers

ngxExportHandler :: Name -> Q [Dec] Source #

Exports a function of type

ByteString -> ContentHandlerResult

for using in directives haskell_content and haskell_static_content.

ngxExportDefHandler :: Name -> Q [Dec] Source #

Exports a function of type

ByteString -> ByteString

for using in directives haskell_content and haskell_static_content.

ngxExportUnsafeHandler :: Name -> Q [Dec] Source #

Exports a function of type

ByteString -> UnsafeContentHandlerResult

for using in directive haskell_unsafe_content.

ngxExportAsyncHandler :: Name -> Q [Dec] Source #

Exports a function of type

ByteString -> IO ContentHandlerResult

for using in directive haskell_async_content.

ngxExportAsyncHandlerOnReqBody :: Name -> Q [Dec] Source #

Exports a function of type

ByteString -> 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.

Service hooks

ngxExportServiceHook :: Name -> Q [Dec] Source #

Exports a function of type

ByteString -> IO ByteString

for using in directives haskell_service_hook and haskell_service_update_hook.

Initialization hook

ngxExportInitHook :: Name -> Q [Dec] Source #

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 getArgs inside it.

Since: 1.7.10

Accessing Nginx global objects

Opaque pointers

ngxCyclePtr :: IO (Ptr ()) Source #

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).

ngxUpstreamMainConfPtr :: IO (Ptr ()) Source #

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).

ngxCachedTimePtr :: IO (Ptr (Ptr ())) Source #

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.

Primitive objects

ngxCachedPid :: IO CPid Source #

Returns the PID of the current worker process cached in Nginx.

Since: 1.7.1

Accessing Nginx core functionality from Haskell handlers

newtype TerminateWorkerProcess Source #

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

Constructors

TerminateWorkerProcess String

Contains the message to log

newtype RestartWorkerProcess Source #

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

Constructors

RestartWorkerProcess String

Contains the message to log

data WorkerProcessIsExiting Source #

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 FinalizeHTTPRequest Source #

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

Constructors

FinalizeHTTPRequest Int (Maybe String)

Contains HTTP status and body

Re-exported data constructors from Foreign.C

Re-exports are needed by exporters for marshalling in foreign calls.

newtype CInt #

Haskell type representing the C int type. (The concrete types of Foreign.C.Types are platform-specific.)

Constructors

CInt Int32 

Instances

Instances details
Storable CInt 
Instance details

Defined in Foreign.C.Types

Methods

sizeOf :: CInt -> Int #

alignment :: CInt -> Int #

peekElemOff :: Ptr CInt -> Int -> IO CInt #

pokeElemOff :: Ptr CInt -> Int -> CInt -> IO () #

peekByteOff :: Ptr b -> Int -> IO CInt #

pokeByteOff :: Ptr b -> Int -> CInt -> IO () #

peek :: Ptr CInt -> IO CInt #

poke :: Ptr CInt -> CInt -> IO () #

Bits CInt 
Instance details

Defined in Foreign.C.Types

FiniteBits CInt 
Instance details

Defined in Foreign.C.Types

Bounded CInt 
Instance details

Defined in Foreign.C.Types

Enum CInt 
Instance details

Defined in Foreign.C.Types

Methods

succ :: CInt -> CInt #

pred :: CInt -> CInt #

toEnum :: Int -> CInt #

fromEnum :: CInt -> Int #

enumFrom :: CInt -> [CInt] #

enumFromThen :: CInt -> CInt -> [CInt] #

enumFromTo :: CInt -> CInt -> [CInt] #

enumFromThenTo :: CInt -> CInt -> CInt -> [CInt] #

Ix CInt 
Instance details

Defined in Foreign.C.Types

Methods

range :: (CInt, CInt) -> [CInt] #

index :: (CInt, CInt) -> CInt -> Int #

unsafeIndex :: (CInt, CInt) -> CInt -> Int #

inRange :: (CInt, CInt) -> CInt -> Bool #

rangeSize :: (CInt, CInt) -> Int #

unsafeRangeSize :: (CInt, CInt) -> Int #

Num CInt 
Instance details

Defined in Foreign.C.Types

Methods

(+) :: CInt -> CInt -> CInt #

(-) :: CInt -> CInt -> CInt #

(*) :: CInt -> CInt -> CInt #

negate :: CInt -> CInt #

abs :: CInt -> CInt #

signum :: CInt -> CInt #

fromInteger :: Integer -> CInt #

Read CInt 
Instance details

Defined in Foreign.C.Types

Integral CInt 
Instance details

Defined in Foreign.C.Types

Methods

quot :: CInt -> CInt -> CInt #

rem :: CInt -> CInt -> CInt #

div :: CInt -> CInt -> CInt #

mod :: CInt -> CInt -> CInt #

quotRem :: CInt -> CInt -> (CInt, CInt) #

divMod :: CInt -> CInt -> (CInt, CInt) #

toInteger :: CInt -> Integer #

Real CInt 
Instance details

Defined in Foreign.C.Types

Methods

toRational :: CInt -> Rational #

Show CInt 
Instance details

Defined in Foreign.C.Types

Methods

showsPrec :: Int -> CInt -> ShowS #

show :: CInt -> String #

showList :: [CInt] -> ShowS #

NFData CInt

Since: deepseq-1.4.0.0

Instance details

Defined in Control.DeepSeq

Methods

rnf :: CInt -> () #

Eq CInt 
Instance details

Defined in Foreign.C.Types

Methods

(==) :: CInt -> CInt -> Bool #

(/=) :: CInt -> CInt -> Bool #

Ord CInt 
Instance details

Defined in Foreign.C.Types

Methods

compare :: CInt -> CInt -> Ordering #

(<) :: CInt -> CInt -> Bool #

(<=) :: CInt -> CInt -> Bool #

(>) :: CInt -> CInt -> Bool #

(>=) :: CInt -> CInt -> Bool #

max :: CInt -> CInt -> CInt #

min :: CInt -> CInt -> CInt #

newtype CUInt #

Haskell type representing the C unsigned int type. (The concrete types of Foreign.C.Types are platform-specific.)

Constructors

CUInt Word32 

Instances

Instances details
Storable CUInt 
Instance details

Defined in Foreign.C.Types

Methods

sizeOf :: CUInt -> Int #

alignment :: CUInt -> Int #

peekElemOff :: Ptr CUInt -> Int -> IO CUInt #

pokeElemOff :: Ptr CUInt -> Int -> CUInt -> IO () #

peekByteOff :: Ptr b -> Int -> IO CUInt #

pokeByteOff :: Ptr b -> Int -> CUInt -> IO () #

peek :: Ptr CUInt -> IO CUInt #

poke :: Ptr CUInt -> CUInt -> IO () #

Bits CUInt 
Instance details

Defined in Foreign.C.Types

FiniteBits CUInt 
Instance details

Defined in Foreign.C.Types

Bounded CUInt 
Instance details

Defined in Foreign.C.Types

Enum CUInt 
Instance details

Defined in Foreign.C.Types

Ix CUInt 
Instance details

Defined in Foreign.C.Types

Num CUInt 
Instance details

Defined in Foreign.C.Types

Read CUInt 
Instance details

Defined in Foreign.C.Types

Integral CUInt 
Instance details

Defined in Foreign.C.Types

Real CUInt 
Instance details

Defined in Foreign.C.Types

Methods

toRational :: CUInt -> Rational #

Show CUInt 
Instance details

Defined in Foreign.C.Types

Methods

showsPrec :: Int -> CUInt -> ShowS #

show :: CUInt -> String #

showList :: [CUInt] -> ShowS #

NFData CUInt

Since: deepseq-1.4.0.0

Instance details

Defined in Control.DeepSeq

Methods

rnf :: CUInt -> () #

Eq CUInt 
Instance details

Defined in Foreign.C.Types

Methods

(==) :: CUInt -> CUInt -> Bool #

(/=) :: CUInt -> CUInt -> Bool #

Ord CUInt 
Instance details

Defined in Foreign.C.Types

Methods

compare :: CUInt -> CUInt -> Ordering #

(<) :: CUInt -> CUInt -> Bool #

(<=) :: CUInt -> CUInt -> Bool #

(>) :: CUInt -> CUInt -> Bool #

(>=) :: CUInt -> CUInt -> Bool #

max :: CUInt -> CUInt -> CUInt #

min :: CUInt -> CUInt -> CUInt #