{-# LANGUAGE TemplateHaskell, TypeFamilies, EmptyDataDecls #-} {-# LANGUAGE DeriveGeneric, DeriveLift, NumDecimals #-} ----------------------------------------------------------------------------- -- | -- Module : NgxExport.Tools -- Copyright : (c) Alexey Radkov 2018-2021 -- License : BSD-style -- -- Maintainer : alexey.radkov@gmail.com -- Stability : experimental -- Portability : non-portable (requires Template Haskell) -- -- Extra tools for using in custom Haskell code with -- . -- ----------------------------------------------------------------------------- module NgxExport.Tools ( -- * Various useful functions and data terminateWorkerProcess ,restartWorkerProcess ,finalizeHTTPRequest ,workerProcessIsExiting ,ngxRequestPtr ,ngxNow ,ngxPid -- *** Time intervals ,TimeInterval (..) ,toSec ,threadDelaySec -- *** Reading custom types from /ByteStrings/ -- $readingCustomTypes ,readFromByteString ,readFromByteStringAsJSON ,readFromByteStringWithRPtr ,readFromByteStringWithRPtrAsJSON ,skipRPtr -- * Exporters of simple services -- $simpleServices ,ServiceMode (..) ,ngxExportSimpleService ,ngxExportSimpleServiceTyped ,ngxExportSimpleServiceTypedAsJSON -- * Split services -- $splitServices ,splitService ,ignitionService ,deferredService -- * Re-exported data constructors from /Foreign.C/ -- | Re-exports are needed by exporters for marshalling in foreign calls. ,Foreign.C.Types.CInt (..) ,Foreign.C.Types.CUInt (..) ) where import NgxExport import Language.Haskell.TH import Language.Haskell.TH.Syntax import Foreign.Ptr import Foreign.Storable import Foreign.C.Types import qualified Data.ByteString as B import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as C8 import qualified Data.ByteString.Lazy as L import Data.Binary.Get import Data.IORef import Data.Maybe import Data.Aeson import Data.Function (on) import Data.Ord (comparing) import Data.Proxy import Control.Monad import Control.Arrow import Control.Exception import Control.Concurrent import GHC.Generics import System.IO.Unsafe (unsafePerformIO) import System.Posix.Types import Safe -- | Terminates the Nginx worker process from a Haskell service. -- -- Nginx master process shall /not/ spawn a new worker process thereafter. This -- function throws exception 'TerminateWorkerProcess', and therefore terminates -- the worker process effectively only from a Haskell service. terminateWorkerProcess :: String -> IO () terminateWorkerProcess = throwIO . TerminateWorkerProcess -- | Restarts the Nginx worker process from a Haskell service. -- -- Nginx master process shall spawn a new worker process after termination of -- the current one. This function throws exception 'RestartWorkerProcess', and -- therefore terminates the worker process effectively only from a Haskell -- service. restartWorkerProcess :: String -> IO () restartWorkerProcess = throwIO . RestartWorkerProcess -- | Finalizes the current HTTP request from a Haskell asynchronous variable -- handler. -- -- This function throws exception 'FinalizeHTTPRequest', and therefore -- terminates the HTTP request effectively only from a Haskell asynchronous -- variable handler. finalizeHTTPRequest :: Int -> Maybe String -> IO () finalizeHTTPRequest = (throwIO .) . FinalizeHTTPRequest -- | Checks that a generic exception is of type 'WorkerProcessIsExiting'. -- -- This can be useful to check quickly in an exception handler whether a -- Haskell service has been interrupted because the worker process is exiting. workerProcessIsExiting :: SomeException -> Bool workerProcessIsExiting e = isJust (fromException e :: Maybe WorkerProcessIsExiting) -- | Unmarshals the value of Nginx variable __/$_r_ptr/__ into a pointer to -- the Nginx request object. -- -- This is safe to use in request-based Haskell handlers such as synchronous -- and asynchronous tasks and content handlers, but not in services and their -- derivatives. In /asynchronous/ tasks and content handlers the value must be -- used as read-only. The value can be passed into a /C plugin/, however, as -- opposed to usual functions in Nginx C code, it must be tested against the -- /NULL/ value. ngxRequestPtr :: ByteString -> Ptr () ngxRequestPtr = wordPtrToPtr . fromIntegral . runGet getWordhost . L.fromStrict -- | Returns the current time as the number of seconds elapsed since the 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. ngxNow :: IO CTime ngxNow = ngxCachedTimePtr >>= peek >>= peek . castPtr -- | Returns the /PID/ of the current worker process cached in Nginx core. ngxPid :: IO CPid ngxPid = ngxCachedPid -- | Time intervals. data TimeInterval = Hr Int -- ^ Hours | Min Int -- ^ Minutes | Sec Int -- ^ Seconds | HrMin Int Int -- ^ Hours and minutes | MinSec Int Int -- ^ Minutes and seconds | Unset -- ^ Zero time interval, equal to @Sec 0@ deriving (Generic, Lift, Read, Show) instance FromJSON TimeInterval instance Eq TimeInterval where (==) = (==) `on` toSec instance Ord TimeInterval where compare = comparing toSec -- | Converts a time interval into seconds. toSec :: TimeInterval -> Int toSec (Hr h) = 3600 * h toSec (Min m) = 60 * m toSec (Sec s) = s toSec (HrMin h m) = 3600 * h + 60 * m toSec (MinSec m s) = 60 * m + s toSec Unset = 0 -- | Delays the current thread by the specified number of seconds. threadDelaySec :: Int -> IO () threadDelaySec = threadDelay . (* 1e6) data Readable a data ReadableAsJSON a class FromByteString a where type WrappedT a fromByteString :: Proxy a -> ByteString -> Maybe (WrappedT a) instance Read a => FromByteString (Readable a) where type WrappedT (Readable a) = a fromByteString = const $ readMay . C8.unpack instance FromJSON a => FromByteString (ReadableAsJSON a) where type WrappedT (ReadableAsJSON a) = a fromByteString = const decodeStrict instance FromByteString ByteString where type WrappedT ByteString = ByteString fromByteString = const Just -- $readingCustomTypes -- -- There are a number of functions to support /typed/ exchange between Nginx -- and Haskell handlers. Functions 'readFromByteString' and -- 'readFromByteStringAsJSON' expect serialized values of custom types deriving -- or implementing instances of 'Read' and 'FromJSON' respectively. Functions -- 'readFromByteStringWithRPtr' and 'readFromByteStringWithRPtrAsJSON' -- additionally expect a binary value of a C pointer size marshalled in front -- of the value of the custom type. This pointer should correspond to the value -- of Nginx variable __/$_r_ptr/__. -- -- Below is a toy example. -- -- ==== File /test_tools.hs/ -- @ -- {-\# LANGUAGE TemplateHaskell, DeriveGeneric, TypeApplications \#-} -- -- 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 -- -- showAsLazyByteString :: Show a => a -> L.ByteString -- showAsLazyByteString = C8L.pack . show -- -- newtype Conf = Conf Int deriving (Read, Show) -- -- data ConfJSON = ConfJSONCon1 Int -- | ConfJSONCon2 deriving (Generic, Show) -- instance FromJSON ConfJSON -- -- testReadIntHandler :: ByteString -> L.ByteString -- __/testReadIntHandler/__ = showAsLazyByteString . -- 'readFromByteString' \@Int -- 'ngxExportYY' \'testReadIntHandler -- -- testReadConfHandler :: ByteString -> L.ByteString -- __/testReadConfHandler/__ = showAsLazyByteString . -- 'readFromByteString' \@Conf -- 'ngxExportYY' \'testReadConfHandler -- -- testReadConfJSONHandler :: ByteString -> IO L.ByteString -- __/testReadConfJSONHandler/__ = return . showAsLazyByteString . -- 'readFromByteStringAsJSON' \@ConfJSON -- 'ngxExportAsyncIOYY' \'testReadConfJSONHandler -- -- testReadConfWithRPtrHandler :: ByteString -> L.ByteString -- __/testReadConfWithRPtrHandler/__ = showAsLazyByteString . -- 'readFromByteStringWithRPtr' \@Conf -- 'ngxExportYY' \'testReadConfWithRPtrHandler -- -- testReadConfWithRPtrJSONHandler :: ByteString -> L.ByteString -- __/testReadConfWithRPtrJSONHandler/__ = showAsLazyByteString . -- 'readFromByteStringWithRPtrAsJSON' \@ConfJSON -- 'ngxExportYY' \'testReadConfWithRPtrJSONHandler -- @ -- -- Here five Haskell handlers are defined: /testReadIntHandler/, -- /testReadConfHandler/, /testReadConfJSONHandler/, -- /testReadConfWithRPtrHandler/, and /testReadConfWithRPtrJSONHandler/. Four -- of them are /synchronous/ and one is /asynchronous/ for the sake of variety. -- -- ==== 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; -- -- server { -- listen 8010; -- server_name main; -- error_log \/tmp\/nginx-test-haskell-error.log; -- access_log \/tmp\/nginx-test-haskell-access.log; -- -- location \/ { -- haskell_run __/testReadIntHandler/__ -- $hs_testReadIntHandler -- -456; -- haskell_run __/testReadConfHandler/__ -- $hs_testReadConfHandler -- \'Conf 21\'; -- haskell_run_async __/testReadConfJSONHandler/__ -- $hs_testReadConfJSONHandler -- \'{\"tag\":\"ConfJSONCon2\"}\'; -- haskell_run_async __/testReadConfJSONHandler/__ -- $hs_testReadConfJSONHandlerBadInput -- \'{\"tag\":\"Unknown\"}\'; -- haskell_run __/testReadConfWithRPtrHandler/__ -- $hs_testReadConfWithRPtrHandler -- \'${_r_ptr}Conf 21\'; -- haskell_run __/testReadConfWithRPtrJSONHandler/__ -- $hs_testReadConfWithRPtrJSONHandler -- \'$_r_ptr -- {\"tag\":\"ConfJSONCon1\", \"contents\":4} -- \'; -- -- echo \"Handler variables:\"; -- echo \" hs_testReadIntHandler: $hs_testReadIntHandler\"; -- echo \" hs_testReadConfHandler: $hs_testReadConfHandler\"; -- echo \" hs_testReadConfJSONHandler: $hs_testReadConfJSONHandler\"; -- echo \" hs_testReadConfJSONHandlerBadInput: $hs_testReadConfJSONHandlerBadInput\"; -- echo \" hs_testReadConfWithRPtrHandler: $hs_testReadConfWithRPtrHandler\"; -- echo \" hs_testReadConfWithRPtrJSONHandler: $hs_testReadConfWithRPtrJSONHandler\"; -- } -- } -- } -- @ -- -- ==== A simple test -- > $ curl 'http://localhost:8010/' -- > Handler variables: -- > hs_testReadIntHandler: Just (-456) -- > hs_testReadConfHandler: Just (Conf 21) -- > hs_testReadConfJSONHandler: Just ConfJSONCon2 -- > hs_testReadConfJSONHandlerBadInput: Nothing -- > hs_testReadConfWithRPtrHandler: (0x00000000016fc790,Just (Conf 21)) -- > hs_testReadConfWithRPtrJSONHandler: (0x00000000016fc790,Just (ConfJSONCon1 4)) -- | Reads an object of a custom type implementing an instance of 'Read' -- from a 'ByteString'. -- -- Returns 'Nothing' if reading fails. readFromByteString :: Read a => ByteString -> Maybe a readFromByteString = fromByteString (Proxy :: Proxy (Readable a)) -- | Reads an object of a custom type implementing an instance of 'FromJSON' -- from a 'ByteString'. -- -- Returns 'Nothing' if reading fails. readFromByteStringAsJSON :: FromJSON a => ByteString -> Maybe a readFromByteStringAsJSON = fromByteString (Proxy :: Proxy (ReadableAsJSON a)) -- | Reads a pointer to the Nginx request object followed by an object of -- a custom type implementing an instance of 'Read' from a 'ByteString'. -- -- Throws an exception if unmarshalling of the request pointer fails. In the -- second element of the tuple returns 'Nothing' if reading of the custom -- object fails. Notice that the value of the returned request pointer is not -- checked against /NULL/. readFromByteStringWithRPtr :: Read a => ByteString -> (Ptr (), Maybe a) readFromByteStringWithRPtr = ngxRequestPtr &&& readFromByteString . skipRPtr -- | Reads a pointer to the Nginx request object followed by an object of -- a custom type implementing an instance of 'FromJSON' from a 'ByteString'. -- -- Throws an exception if unmarshalling of the request pointer fails. In the -- second element of the tuple returns 'Nothing' if decoding of the custom -- object fails. Notice that the value of the returned request pointer is not -- checked against /NULL/. readFromByteStringWithRPtrAsJSON :: FromJSON a => ByteString -> (Ptr (), Maybe a) readFromByteStringWithRPtrAsJSON = ngxRequestPtr &&& readFromByteStringAsJSON . skipRPtr -- | Skips the number of bytes equal to the size of a pointer from the beginning -- of a 'ByteString'. -- -- This can be useful to drop a pointer to the Nginx request object passed at -- the beginning of a handler's argument. skipRPtr :: ByteString -> ByteString skipRPtr = B.drop $ sizeOf (undefined :: Word) -- $simpleServices -- -- 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' -> 'Prelude.Bool' -> 'IO' 'L.ByteString' -- @ -- -- which corresponds to the type of usual services from module "NgxExport". -- -- Below is a toy example. -- -- ==== File /test_tools.hs/ -- @ -- {-\# LANGUAGE TemplateHaskell, DeriveGeneric, RecordWildCards \#-} -- -- 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 Data.IORef -- import Control.Monad -- import GHC.Generics -- -- test :: ByteString -> Bool -> IO L.ByteString -- __/test/__ = const . return . L.fromStrict -- 'ngxExportSimpleService' \'test $ -- 'PersistentService' $ Just $ 'Sec' 10 -- -- showAsLazyByteString :: Show a => a -> L.ByteString -- showAsLazyByteString = C8L.pack . show -- -- testRead :: Show a => a -> IO L.ByteString -- testRead = return . showAsLazyByteString -- -- testReadInt :: Int -> Bool -> IO L.ByteString -- __/testReadInt/__ = const . testRead -- 'ngxExportSimpleServiceTyped' \'testReadInt \'\'Int $ -- 'PersistentService' $ Just $ 'Sec' 10 -- -- newtype Conf = Conf Int deriving (Read, Show) -- -- testReadConf :: Conf -> Bool -> IO L.ByteString -- __/testReadConf/__ = const . testRead -- 'ngxExportSimpleServiceTyped' \'testReadConf \'\'Conf $ -- 'PersistentService' $ Just $ 'Sec' 10 -- -- testConfStorage :: ByteString -> IO L.ByteString -- __/testConfStorage/__ = const $ -- showAsLazyByteString \<$\> readIORef __/storage_Conf_/__testReadConf -- 'ngxExportIOYY' \'testConfStorage -- -- data ConfWithDelay = ConfWithDelay { delay :: 'TimeInterval' -- , value :: Int -- } deriving (Read, Show) -- -- testReadConfWithDelay :: ConfWithDelay -> Bool -> IO L.ByteString -- __/testReadConfWithDelay/__ c\@ConfWithDelay {..} fstRun = do -- unless fstRun $ 'threadDelaySec' $ 'toSec' delay -- testRead c -- 'ngxExportSimpleServiceTyped' \'testReadConfWithDelay \'\'ConfWithDelay $ -- 'PersistentService' Nothing -- -- data ConfJSON = ConfJSONCon1 Int -- | ConfJSONCon2 deriving (Generic, Show) -- instance FromJSON ConfJSON -- -- testReadConfJSON :: ConfJSON -> Bool -> IO L.ByteString -- __/testReadConfJSON/__ = 'ignitionService' testRead -- 'ngxExportSimpleServiceTypedAsJSON' \'testReadConfJSON \'\'ConfJSON -- 'SingleShotService' -- @ -- -- Here five simple services of various types are defined: /test/, -- /testReadInt/, /testReadConf/, /testReadConfWithDelay/, and -- /testReadConfJSON/. /Typed/ services hold 'IORef' /storages/ to save their -- configurations for faster access in future iterations. The name of a storage -- consists of the name of its type and the name of the service connected by an -- underscore and prefixed as a whole word with __/storage_/__. -- -- As soon as all the services in the example merely echo their configurations -- 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: -- -- * Periodical sleeps (for example, @'PersistentService' $ Just $ 'Sec' 10@) -- * No sleeps between iterations (@'PersistentService' Nothing@) -- * /Single-shot/ services (@'SingleShotService'@) -- -- In this toy example the most efficient sleeping strategy is a single-shot -- service because data is not altered during runtime. A single-shot service -- runs exactly two times during the lifetime of a worker process: the first -- run (when the second argument of the service, i.e. the /first-run/ flag, is -- /True/) is immediately followed by the second run (when the /first-run/ flag -- is /False/). On the second run the service handler is used as an exception -- handler when the service is shutting down after the 'WorkerProcessIsExiting' -- exception has been thrown. Accordingly, a single-shot handler can be used -- for allocation of some global resources (when the first-run flag is /True/), -- and cleaning them up (when the first-run flag is /False/). -- -- Notice that service /testReadConfWithDelay/ manages time delays on its own, -- therefore it uses /no-sleeps/ strategy @'PersistentService' Nothing@. -- -- ==== 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_testReadInt/__ -- $hs_testReadInt -- 5000000; -- -- haskell_run_service __/simpleService_testReadConf/__ -- $hs_testReadConf -- \'Conf 20\'; -- -- haskell_run_service __/simpleService_testReadConfWithDelay/__ -- $hs_testReadConfWithDelay -- \'ConfWithDelay { delay = Sec 10, value = 12 }\'; -- -- haskell_run_service __/simpleService_testReadConfJSON/__ -- $hs_testReadConfJSON -- \'{\"tag\":\"ConfJSONCon1\", \"contents\":56}\'; -- -- server { -- listen 8010; -- server_name main; -- error_log \/tmp\/nginx-test-haskell-error.log; -- access_log \/tmp\/nginx-test-haskell-access.log; -- -- location \/ { -- haskell_run __/testConfStorage/__ $hs_testConfStorage \'\'; -- -- echo \"Service variables:\"; -- echo \" hs_test: $hs_test\"; -- echo \" hs_testReadInt: $hs_testReadInt\"; -- echo \" hs_testReadConf: $hs_testReadConf\"; -- echo \" hs_testReadConfWithDelay: $hs_testReadConfWithDelay\"; -- echo \" hs_testReadConfJSON: $hs_testReadConfJSON\"; -- echo \"Storages of service variables:\"; -- echo \" hs_testConfStorage: $hs_testConfStorage\"; -- } -- } -- } -- @ -- -- Notice that Haskel handlers defined in /test_tools.hs/ are referred from -- the Nginx configuration file with prefix __/simpleService_/__. -- -- ==== A simple test -- > $ curl 'http://localhost:8010/' -- > Service variables: -- > hs_test: test -- > hs_testReadInt: 5000000 -- > hs_testReadConf: Conf 20 -- > hs_testReadConfWithDelay: ConfWithDelay {delay = Sec 10, value = 12} -- > hs_testReadConfJSON: ConfJSONCon1 56 -- > Storages of service variables: -- > hs_testConfStorage: Just (Conf 20) -- | Defines a sleeping strategy. data ServiceMode -- | Persistent service (with or without periodical sleeps) = PersistentService (Maybe TimeInterval) -- | Single-shot service | SingleShotService ngxExportSimpleService' :: Name -> Maybe (Name, Bool) -> ServiceMode -> Q [Dec] ngxExportSimpleService' f c m = do confBs <- newName "confBs_" fstRun <- newName "fstRun_" let nameF = nameBase f nameSsf = mkName $ "simpleService_" ++ nameF hasConf = isJust c (sNameC, typeC, readConf, unreadableConfMsg) = if hasConf then let (tName, isJSON) = first nameBase $ fromJust c in (mkName $ "storage_" ++ tName ++ '_' : nameF -- FIXME: using base name of the type means that it is -- not possible to pass here qualified types from -- external modules. Using showName instead of nameBase -- won't help, as it adds static qualified names like -- GHC.Types.Int that can be unexpected in the context -- of the user's module scope, instead of adding the -- dynamic namespace (possibly not qualified) specified -- in the import clause of the user's module. ,conT $ mkName tName ,if isJSON then [|readFromByteStringAsJSON|] else [|readFromByteString|] ,"Configuration " ++ tName ++ " is not readable" ) else undefined initConf = let eConfBs = varE confBs in if hasConf then let storage = varE sNameC in [|readIORef $(storage) >>= maybe (do let conf_data__ = $(readConf) $(eConfBs) when (isNothing conf_data__) $ terminateWorkerProcess unreadableConfMsg writeIORef $(storage) conf_data__ return conf_data__ ) (return . Just) |] else [|return $ fromByteString (Proxy :: Proxy ByteString) $(eConfBs) |] (waitTime, runService) = let eF = varE f eFstRun = varE fstRun runPersistentService = [|flip $(eF) $(eFstRun)|] in case m of PersistentService (Just t) -> ([|const $ unless $(eFstRun) $ threadDelaySec $ toSec t|] ,runPersistentService ) PersistentService Nothing -> ([|const $ return ()|] ,runPersistentService ) SingleShotService -> ([|\conf_data__ -> unless $(eFstRun) $ handle (const $ void $ $(eF) conf_data__ False :: WorkerProcessIsExiting -> IO () ) $ forever $ threadDelaySec $ toSec $ Hr 24 |] ,[|\conf_data__ -> if $(eFstRun) then $(eF) conf_data__ True else return L.empty |] ) concat <$> sequence [sequence $ (if hasConf then [sigD sNameC [t|IORef (Maybe $(typeC))|] ,funD sNameC [clause [] (normalB [|unsafePerformIO $ newIORef Nothing|]) [] ] ,pragInlD sNameC NoInline FunLike AllPhases ] else [] ) ++ [sigD nameSsf [t|ByteString -> Bool -> IO L.ByteString|] ,funD nameSsf [clause [varP confBs, varP fstRun] (normalB [|do conf_data_ <- fromJust <$> $(initConf) $(waitTime) conf_data_ $(runService) conf_data_ |] ) [] ] ] ,ngxExportServiceIOYY nameSsf ] -- | Exports a simple service of type -- -- @ -- 'ByteString' -> 'Prelude.Bool' -> 'IO' 'L.ByteString' -- @ -- -- with specified name and service mode. ngxExportSimpleService :: Name -- ^ Name of the service -> ServiceMode -- ^ Service mode -> Q [Dec] ngxExportSimpleService f = ngxExportSimpleService' f Nothing -- | Exports a simple service of type -- -- @ -- 'Read' a => a -> 'Prelude.Bool' -> 'IO' 'L.ByteString' -- @ -- -- with specified name and service mode. -- -- The service expects an object of a custom type implementing an instance of -- 'Read' at its first argument. For the sake of efficiency, this object gets -- deserialized into a global 'IORef' data storage on the first service run to -- be further accessed directly from this storage. The storage can be accessed -- from elsewhere by a name comprised of the name of the custom type and the -- name of the service connected by an underscore and prefixed as a whole word -- with __/storage_/__. The stored data is wrapped in 'Maybe' container. -- -- When reading of the custom object fails on the first service run, the -- service terminates the worker process by calling 'terminateWorkerProcess' -- with a corresponding message. ngxExportSimpleServiceTyped :: Name -- ^ Name of the service -> Name -- ^ Name of the custom type -> ServiceMode -- ^ Service mode -> Q [Dec] ngxExportSimpleServiceTyped f c = ngxExportSimpleService' f $ Just (c, False) -- | Exports a simple service of type -- -- @ -- 'FromJSON' a => a -> 'Prelude.Bool' -> 'IO' 'L.ByteString' -- @ -- -- with specified name and service mode. -- -- The service expects an object of a custom type implementing an instance of -- 'FromJSON' at its first argument. For the sake of efficiency, this object -- gets deserialized into a global 'IORef' data storage on the first service -- run to be further accessed directly from this storage. The storage can be -- accessed from elsewhere by a name comprised of the name of the custom type -- and the name of the service connected by an underscore and prefixed as a -- whole word with __/storage_/__. The stored data is wrapped in 'Maybe' -- container. -- -- When reading of the custom object fails on the first service run, the -- service terminates the worker process by calling 'terminateWorkerProcess' -- with a corresponding message. ngxExportSimpleServiceTypedAsJSON :: Name -- ^ Name of the service -> Name -- ^ Name of the custom type -> ServiceMode -- ^ Service mode -> Q [Dec] ngxExportSimpleServiceTypedAsJSON f c = ngxExportSimpleService' f $ Just (c, True) -- $splitServices -- -- Here are a number of combinators to facilitate creation of specialized -- services. They allow distinguishing between /ignition/ and /deferred/ -- services: the former run when the /first-run/ flag is /True/ whereas the -- latter run when the flag is /False/. The most promising use case for these -- helper functions is tuning of /single-shot/ services: in this case the -- ignition service corresponds to a normal single-shot action on startup of a -- worker process, while the deferred service corresponds to a cleanup handler -- and runs when a worker process exits. -- -- In all helpers, configuration and the first-run flag parameters belong to -- the common service signature, and therefore should not be bound by any -- arguments. -- | Sets two different actions as ignition and deferred services. -- -- When used as a single-shot service, the second action only runs on exit of a -- worker process, and therefore can be used as a cleanup handler. splitService :: (a -> IO L.ByteString) -- ^ Ignition service -> (a -> IO L.ByteString) -- ^ Deferred service -> a -- ^ Configuration -> Bool -- ^ First-run flag -> IO L.ByteString splitService is ds c fstRun | fstRun = is c | otherwise = ds c -- | Sets an action as an ignition service. ignitionService :: (a -> IO L.ByteString) -- ^ Ignition service -> a -- ^ Configuration -> Bool -- ^ First-run flag -> IO L.ByteString ignitionService is = splitService is $ const $ return L.empty -- | Sets an action as a deferred service. -- -- When used as a single-shot service, the action only runs on exit of a worker -- process, and therefore can be used as a cleanup handler. deferredService :: (a -> IO L.ByteString) -- ^ Deferred service -> a -- ^ Configuration -> Bool -- ^ First-run flag -> IO L.ByteString deferredService = splitService $ const $ return L.empty