ngx-export-tools-0.1.0.0: Extra tools for Nginx haskell module

Copyright(c) Alexey Radkov 2018
LicenseBSD-style
Maintaineralexey.radkov@gmail.com
Stabilityexperimental
Portabilitynon-portable (requires Template Haskell)
Safe HaskellNone
LanguageHaskell98

NgxExport.Tools

Contents

Description

Extra tools for using in custom Haskell code with nginx-haskell-module.

Synopsis

Various useful functions and data

exitWorkerProcess :: IO () Source #

Terminates current Nginx worker process.

Nginx master process shall spawn a new worker process thereafter.

terminateWorkerProcess :: IO () Source #

Terminates current Nginx worker process.

Nginx master process shall not spawn a new worker process thereafter.

ngxNow :: IO CTime Source #

Returns current time as the number of seconds elapsed since UNIX epoch.

The value is taken from Nginx core, so no additional system calls get involved. On the other hand, it means that this is only safe to use from an Nginx worker's main thread, i.e. in synchronous Haskell handlers and service hooks. Be also aware that this is a small type casting hack: the value is interpreted as being of type time_t while having been actually wrapped in a bigger C struct as its first element.

threadDelaySec :: Int -> IO () Source #

Delays current thread for the specified number of seconds.

data TimeInterval Source #

Time intervals.

Constructors

Hr Int

Hours

Min Int

Minutes

Sec Int

Seconds

HrMin Int Int

Hours and minutes

MinSec Int Int

Minutes and seconds

Instances
Read TimeInterval Source # 
Instance details

Defined in NgxExport.Tools

Generic TimeInterval Source # 
Instance details

Defined in NgxExport.Tools

Associated Types

type Rep TimeInterval :: Type -> Type #

Lift TimeInterval Source # 
Instance details

Defined in NgxExport.Tools

Methods

lift :: TimeInterval -> Q Exp #

FromJSON TimeInterval Source # 
Instance details

Defined in NgxExport.Tools

type Rep TimeInterval Source # 
Instance details

Defined in NgxExport.Tools

toSec :: TimeInterval -> Int Source #

Converts a time interval into seconds.

Exporters of simple services

There are a number of exporters for simple services. Here simplicity means avoiding boilerplate code regarding to efficient reading of typed configurations and timed restarts of services. All simple services have type

ByteString -> Bool -> IO ByteString

which corresponds to the type of usual services from module NgxExport.

Below is a toy example.

File test_tools.hs.

{-# LANGUAGE TemplateHaskell, DeriveGeneric #-}

module TestTools where

import NgxExport
import NgxExport.Tools

import           Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as C8L
import           Data.Aeson
import           GHC.Generics

test :: ByteString -> Bool -> IO L.ByteString
test = const . return . L.fromStrict
ngxExportSimpleService 'test $
    PersistentService $ Just $ Sec 10

newtype ConfRead = ConfRead Int deriving (Read, Show)

testRead :: ConfRead -> Bool -> IO L.ByteString
testRead c = const $ return $ C8L.pack $ show c
ngxExportSimpleServiceTyped 'testRead ''ConfRead $
    PersistentService $ Just $ Sec 10

data ConfReadJSON = ConfReadJSONCon1 Int
                  | ConfReadJSONCon2 deriving (Generic, Show)
instance FromJSON ConfReadJSON

testReadJSON :: ConfReadJSON -> Bool -> IO L.ByteString
testReadJSON c = const $ return $ C8L.pack $ show c
ngxExportSimpleServiceTypedAsJSON 'testReadJSON ''ConfReadJSON
    SingleShotService

Here three simple services of various types are defined: test, testRead, and testReadJSON. As soon as they merely echo their arguments into their service variables, they must sleep for a while between iterations. Sleeps are managed by strategies defined in type ServiceMode. There are basically three sleeping strategies:

In this toy example the most efficient sleeping strategy is a single-shot service because data is not altered during runtime. Under the hood, the single-shot strategy is implemented as periodical sleeps (with period of Hr 1), except it runs the handler only on the first iteration, while afterwards it merely returns empty values: as such, this strategy should be accompanied by Nginx directive haskell_service_var_ignore_empty.

All three services ignore their second parameter (of type Bool) denoting the first run of the service.

File nginx.conf.

user                    nobody;
worker_processes        2;

events {
    worker_connections  1024;
}

http {
    default_type        application/octet-stream;
    sendfile            on;

    haskell load /var/lib/nginx/test_tools.so;

    haskell_run_service simpleService_test $hs_test
            test;

    haskell_run_service simpleService_testRead $hs_testRead
            'ConfRead 20';

    haskell_run_service simpleService_testReadJSON $hs_testReadJSON
            '{"tag":"ConfReadJSONCon1", "contents":56}';

    haskell_service_var_ignore_empty $hs_testReadJSON;

    server {
        listen       8010;
        server_name  main;
        error_log    /tmp/nginx-test-haskell-error.log;
        access_log   /tmp/nginx-test-haskell-access.log;

        location / {
            echo "Service variables:";
            echo "  hs_test: $hs_test";
            echo "  hs_testRead: $hs_testRead";
            echo "  hs_testReadJSON: $hs_testReadJSON";
        }
    }
}

Notice that Haskel handlers defined in test_tools.hs are referred from the Nginx configuration file with prefix simpleService_.

Let's run a simple test.

$ curl 'http://localhost:8010/'
Service variables:
  hs_test: test
  hs_testRead: ConfRead 20
  hs_testReadJSON: ConfReadJSONCon1 56

data ServiceMode Source #

Defines a sleeping strategy.

Single-shot services should be accompanied by Nginx directive haskell_service_var_ignore_empty.

Constructors

PersistentService (Maybe TimeInterval)

Persistent service (with or without periodical sleeps)

SingleShotService

Single-shot service

ngxExportSimpleService Source #

Arguments

:: Name

Name of the service

-> ServiceMode

Service mode

-> Q [Dec] 

Exports a simple service with specified name and service mode.

The service expects a plain ByteString as its first argument.

ngxExportSimpleServiceTyped Source #

Arguments

:: Name

Name of the service

-> Name

Name of the custom type

-> ServiceMode

Service mode

-> Q [Dec] 

Exports a simple service with specified name and service mode.

The service expects a custom type deriving Read as its first argument. For the sake of efficiency, the object of this custom type gets deserialized into a global IORef data storage on the first service run to be further accessed directly from the storage.

ngxExportSimpleServiceTypedAsJSON Source #

Arguments

:: Name

Name of the service

-> Name

Name of the custom type

-> ServiceMode

Service mode

-> Q [Dec] 

Exports a simple service with specified name and service mode.

The service expects a custom type deriving FromJSON as its first argument. For the sake of efficiency, the object of this custom type gets deserialized into a global IORef data storage on the first service run to be further accessed directly from the storage.

Re-exported functions needed for building simple services

unsafePerformIO :: IO a -> a #

This is the "back door" into the IO monad, allowing IO computation to be performed at any time. For this to be safe, the IO computation should be free of side effects and independent of its environment.

If the I/O computation wrapped in unsafePerformIO performs side effects, then the relative order in which those side effects take place (relative to the main I/O trunk, or other calls to unsafePerformIO) is indeterminate. Furthermore, when using unsafePerformIO to cause side-effects, you should take the following precautions to ensure the side effects are performed as many times as you expect them to be. Note that these precautions are necessary for GHC, but may not be sufficient, and other compilers may require different precautions:

  • Use {-# NOINLINE foo #-} as a pragma on any function foo that calls unsafePerformIO. If the call is inlined, the I/O may be performed more than once.
  • Use the compiler flag -fno-cse to prevent common sub-expression elimination being performed on the module, which might combine two side effects that were meant to be separate. A good example is using multiple global variables (like test in the example below).
  • Make sure that the either you switch off let-floating (-fno-full-laziness), or that the call to unsafePerformIO cannot float outside a lambda. For example, if you say: f x = unsafePerformIO (newIORef []) you may get only one reference cell shared between all calls to f. Better would be f x = unsafePerformIO (newIORef [x]) because now it can't float outside the lambda.

It is less well known that unsafePerformIO is not type safe. For example:

    test :: IORef [a]
    test = unsafePerformIO $ newIORef []

    main = do
            writeIORef test [42]
            bang <- readIORef test
            print (bang :: [Char])

This program will core dump. This problem with polymorphic references is well known in the ML community, and does not arise with normal monadic use of references. There is no easy way to make it impossible once you use unsafePerformIO. Indeed, it is possible to write coerce :: a -> b with the help of unsafePerformIO. So be careful!