ngx-export-tools 0.4.9.2 → 1.0

raw patch · 9 files changed

+900/−761 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Changelog.md +5/−0
• LICENSE +1/−1
• NgxExport/Tools.hs +19/−755
• NgxExport/Tools/Read.hs +231/−0
• NgxExport/Tools/SimpleService.hs +399/−0
• NgxExport/Tools/SplitService.hs +62/−0
• NgxExport/Tools/System.hs +106/−0
• NgxExport/Tools/TimeInterval.hs +67/−0
• ngx-export-tools.cabal +10/−5

@@ -1,3 +1,8 @@+### 1.0++- The whole package was split into five separate sub-modules.+- Package stability tag was promoted to stable.+ ### 0.4.9.0  - Exposed function *skipRPtr* which can be useful in many contexts.

@@ -1,7 +1,7 @@ The following license covers this documentation, and the source code, except where otherwise indicated. -Copyright 2018-2021, Alexey Radkov. All rights reserved.+Copyright 2018-2022, Alexey Radkov. All rights reserved.  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

@@ -1,771 +1,35 @@-{-# LANGUAGE TemplateHaskell, TypeFamilies, EmptyDataDecls #-}-{-# LANGUAGE DeriveGeneric, DeriveLift, NumDecimals #-}- ----------------------------------------------------------------------------- -- | -- Module      :  NgxExport.Tools--- Copyright   :  (c) Alexey Radkov 2018-2021+-- Copyright   :  (c) Alexey Radkov 2018-2022 -- License     :  BSD-style -- -- Maintainer  :  alexey.radkov@gmail.com--- Stability   :  experimental--- Portability :  non-portable (requires Template Haskell)+-- Stability   :  stable+-- Portability :  non-portable (requires POSIX and Template Haskell) -- -- Extra tools for using in custom Haskell code with--- <http://github.com/lyokha/nginx-haskell-module nginx-haskell-module>.+-- <https://github.com/lyokha/nginx-haskell-module nginx-haskell-module>. -- -----------------------------------------------------------------------------   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 (..)+    -- | === Reading custom types from /ByteStrings/+                        module NgxExport.Tools.Read+    -- | === Exporters of simple services+                       ,module NgxExport.Tools.SimpleService+    -- | === Split services+                       ,module NgxExport.Tools.SplitService+    -- | === Various functions to access low-level Nginx API+                       ,module NgxExport.Tools.System+    -- | === A simple implementation of time intervals+                       ,module NgxExport.Tools.TimeInterval                        ) 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+import           NgxExport.Tools.Read+import           NgxExport.Tools.SimpleService+import           NgxExport.Tools.SplitService+import           NgxExport.Tools.System+import           NgxExport.Tools.TimeInterval 

@@ -0,0 +1,231 @@+{-# LANGUAGE TypeFamilies, EmptyDataDecls #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  NgxExport.Tools.Read+-- Copyright   :  (c) Alexey Radkov 2018-2022+-- License     :  BSD-style+--+-- Maintainer  :  alexey.radkov@gmail.com+-- Stability   :  stable+-- Portability :  portable+--+-----------------------------------------------------------------------------+++module NgxExport.Tools.Read (+    -- * Reading custom types from /ByteStrings/+    -- $description++    -- * Exported functions+                             readFromByteString+                            ,readFromByteStringAsJSON+                            ,readFromByteStringWithRPtr+                            ,readFromByteStringWithRPtrAsJSON+                            ,skipRPtr+                            ) where++import           NgxExport.Tools.System++import           Foreign.Ptr+import           Foreign.Storable+import qualified Data.ByteString as B+import           Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as C8+import           Data.Aeson+import           Data.Proxy+import           Control.Arrow+import           Safe++-- $description+--+-- This module provides 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 simple example.+--+-- ==== File /test_tools.hs/+-- @+-- {-\# LANGUAGE TemplateHaskell, DeriveGeneric, TypeApplications \#-}+--+-- module TestTools where+--+-- import           NgxExport+-- import           NgxExport.Tools.Read+--+-- 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+-- 'NgxExport.ngxExportYY' \'testReadIntHandler+--+-- testReadConfHandler :: ByteString -> L.ByteString+-- __/testReadConfHandler/__ = showAsLazyByteString .+--     'readFromByteString' \@Conf+-- 'NgxExport.ngxExportYY' \'testReadConfHandler+--+-- testReadConfJSONHandler :: ByteString -> IO L.ByteString+-- __/testReadConfJSONHandler/__ = return . showAsLazyByteString .+--     'readFromByteStringAsJSON' \@ConfJSON+-- 'NgxExport.ngxExportAsyncIOYY' \'testReadConfJSONHandler+--+-- testReadConfWithRPtrHandler :: ByteString -> L.ByteString+-- __/testReadConfWithRPtrHandler/__ = showAsLazyByteString .+--     'readFromByteStringWithRPtr' \@Conf+-- 'NgxExport.ngxExportYY' \'testReadConfWithRPtrHandler+--+-- testReadConfWithRPtrJSONHandler :: ByteString -> L.ByteString+-- __/testReadConfWithRPtrJSONHandler/__ = showAsLazyByteString .+--     'readFromByteStringWithRPtrAsJSON' \@ConfJSON+-- 'NgxExport.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))++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++-- | 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)+

@@ -0,0 +1,399 @@+{-# LANGUAGE TemplateHaskell #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  NgxExport.Tools.SimpleService+-- Copyright   :  (c) Alexey Radkov 2018-2022+-- License     :  BSD-style+--+-- Maintainer  :  alexey.radkov@gmail.com+-- Stability   :  stable+-- Portability :  non-portable (requires Template Haskell)+--+-----------------------------------------------------------------------------+++module NgxExport.Tools.SimpleService (+    -- * Exporters of simple services+    -- $description++    -- * Exported data and functions+                                      ServiceMode (..)+                                     ,ngxExportSimpleService+                                     ,ngxExportSimpleServiceTyped+                                     ,ngxExportSimpleServiceTypedAsJSON+    -- * 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           NgxExport.Tools.Read+import           NgxExport.Tools.System+import           NgxExport.Tools.TimeInterval++import           Language.Haskell.TH+import           Foreign.C.Types+import           Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as L+import           Data.IORef+import           Data.Maybe+import           Control.Monad+import           Control.Arrow+import           Control.Exception+import           System.IO.Unsafe (unsafePerformIO)++-- $description+--+-- This module implements 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 simple 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/__ = 'NgxExport.Tools.SplitService.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 $ Just $(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+--+-- @+-- 'Data.Aeson.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+-- 'Data.Aeson.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)+

@@ -0,0 +1,62 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  NgxExport.Tools.SplitService+-- Copyright   :  (c) Alexey Radkov 2018-2022+-- License     :  BSD-style+--+-- Maintainer  :  alexey.radkov@gmail.com+-- Stability   :  stable+-- Portability :  portable+--+-----------------------------------------------------------------------------+++module NgxExport.Tools.SplitService (+    -- * Split services+    -- $description++    -- * Exported functions+                                     splitService+                                    ,ignitionService+                                    ,deferredService+                                    ) where++import qualified Data.ByteString.Lazy as L++-- $description+--+-- Split services split the whole service into two separate actions for the+-- first (/ignition/ service) and the following (/deferred/ service) runs.++-- | Sets two different actions as ignition and deferred services.+--+-- When used as a single-shot service (in terms of module+-- "NgxExport.Tools.SimpleService"), 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 (in terms of module+-- "NgxExport.Tools.SimpleService"), 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+

@@ -0,0 +1,106 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  NgxExport.Tools.System+-- Copyright   :  (c) Alexey Radkov 2018-2022+-- License     :  BSD-style+--+-- Maintainer  :  alexey.radkov@gmail.com+-- Stability   :  stable+-- Portability :  non-portable (requires POSIX)+--+-----------------------------------------------------------------------------+++module NgxExport.Tools.System (+    -- * Various functions to access low-level Nginx API+    -- $description++    -- * Exported functions+                               terminateWorkerProcess+                              ,restartWorkerProcess+                              ,finalizeHTTPRequest+                              ,workerProcessIsExiting+                              ,ngxRequestPtr+                              ,ngxNow+                              ,ngxPid+                              ) where++import           NgxExport++import           Foreign.Ptr+import           Foreign.Storable+import           Foreign.C.Types+import           Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as L+import           Data.Binary.Get+import           Data.Maybe+import           Control.Exception+import           System.Posix.Types++-- $description+--+-- Various functions to access low-level Nginx API, mostly wrappers around+-- corresponding functions and data from module "NgxExport".++-- | 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+

@@ -0,0 +1,67 @@+{-# LANGUAGE DeriveGeneric, DeriveLift, NumDecimals #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  NgxExport.Tools.TimeInterval+-- Copyright   :  (c) Alexey Radkov 2018-2022+-- License     :  BSD-style+--+-- Maintainer  :  alexey.radkov@gmail.com+-- Stability   :  stable+-- Portability :  portable+--+-----------------------------------------------------------------------------+++module NgxExport.Tools.TimeInterval (+    -- * A simple implementation of time intervals+    -- $description++    -- * Exported data and functions+                                     TimeInterval (..)+                                    ,toSec+                                    ,threadDelaySec+                                    ) where++import           Language.Haskell.TH.Syntax+import           Data.Aeson.Types+import           Data.Function (on)+import           Data.Ord (comparing)+import           Control.Concurrent+import           GHC.Generics++-- $description+--+-- A simple implementation of time intervals supposed for describing low+-- resolution timeouts.++-- | 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)+

@@ -1,16 +1,16 @@ name:                       ngx-export-tools-version:                    0.4.9.2+version:                    1.0 synopsis:                   Extra tools for Nginx haskell module description:                Extra tools for-        <http://github.com/lyokha/nginx-haskell-module Nginx haskell module>.-homepage:                   http://github.com/lyokha/nginx-haskell-module+        <https://github.com/lyokha/nginx-haskell-module Nginx haskell module>.+homepage:                   https://github.com/lyokha/nginx-haskell-module license:                    BSD3 license-file:               LICENSE extra-source-files:         Changelog.md author:                     Alexey Radkov <alexey.radkov@gmail.com> maintainer:                 Alexey Radkov <alexey.radkov@gmail.com>-stability:                  experimental-copyright:                  2018-2021 Alexey Radkov+stability:                  stable+copyright:                  2018-2022 Alexey Radkov category:                   Network build-type:                 Simple cabal-version:              1.20@@ -26,6 +26,11 @@                           , safe    exposed-modules:          NgxExport.Tools+                            NgxExport.Tools.Read+                            NgxExport.Tools.SimpleService+                            NgxExport.Tools.SplitService+                            NgxExport.Tools.System+                            NgxExport.Tools.TimeInterval    ghc-options:             -Wall