diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,14 @@ +### 1.2.5 + +- Add new exporters of typed simple services *ngxExportSimpleServiceTyped'* and + *ngxExportSimpleServiceTypedAsJSON'* which do not store configurations. + Consider using them when multiple instances of a single persistent service + are required. +- Single-shot simple services do no longer store configurations too. This + ensures their safety when running multiple instances of them. +- Add *rareService* declaration which can be used with *voidService* instead of + *SingleShotService*. + ### 1.2.4.1 - Remove dependency on package *safe*. diff --git a/NgxExport/Tools/Combinators.hs b/NgxExport/Tools/Combinators.hs --- a/NgxExport/Tools/Combinators.hs +++ b/NgxExport/Tools/Combinators.hs @@ -19,11 +19,14 @@ voidHandler ,voidHandler' ,voidService + ,rareService -- * Split services ,module NgxExport.Tools.SplitService ) where +import NgxExport.Tools.SimpleService import NgxExport.Tools.SplitService +import NgxExport.Tools.TimeInterval import qualified Data.ByteString.Lazy as L @@ -49,8 +52,8 @@ -- mapConcurrently_ getUrl upconf -- return L.empty -- --- 'NgxExport.Tools.SimpleService.ngxExportSimpleServiceTyped' \'signalUpconf \'\'Upconf $ --- 'NgxExport.Tools.SimpleService.PersistentService' Nothing +-- 'ngxExportSimpleServiceTyped' \'signalUpconf \'\'Upconf $ +-- 'PersistentService' Nothing -- @ -- -- returns an empty bytestring which is not used in a meaningful way, therefore @@ -108,7 +111,7 @@ -- testLoadConf :: Conf -> t'NgxExport.Tools.Types.NgxExportService' -- testLoadConf = __/voidService/__ -- --- 'NgxExport.Tools.SimpleService.ngxExportSimpleServiceTyped' \'testLoadConf \'\'Conf 'NgxExport.Tools.SimpleService.SingleShotService' +-- 'ngxExportSimpleServiceTyped' \'testLoadConf \'\'Conf 'rareService' -- @ -- -- gets loaded by service /testLoadConf/ from the Nginx configuration, then it @@ -127,4 +130,13 @@ -> Bool -- ^ Ignored boolean value -> IO L.ByteString voidService = const $ voidHandler' $ return () + +-- | A rare service mode. +-- +-- A service that sleeps most of the time. Use this convenient declaration for +-- loading global data from the Nginx configuration with 'voidService'. Services +-- with a more natural 'SingleShotService' strategy do not create storages and +-- thus cannot be used for this purpose. +rareService :: ServiceMode +rareService = PersistentService $ Just $ Hr 24 diff --git a/NgxExport/Tools/SimpleService.hs b/NgxExport/Tools/SimpleService.hs --- a/NgxExport/Tools/SimpleService.hs +++ b/NgxExport/Tools/SimpleService.hs @@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : NgxExport.Tools.SimpleService --- Copyright : (c) Alexey Radkov 2018-2023 +-- Copyright : (c) Alexey Radkov 2018-2024 -- License : BSD-style -- -- Maintainer : alexey.radkov@gmail.com @@ -17,7 +17,7 @@ -- * Exporters of simple services -- $description - -- *** Preloading storages of typed simple services + -- *** Preloading storages of persistent typed services -- $preload -- * Exported data and functions @@ -25,6 +25,8 @@ ,ngxExportSimpleService ,ngxExportSimpleServiceTyped ,ngxExportSimpleServiceTypedAsJSON + ,ngxExportSimpleServiceTyped' + ,ngxExportSimpleServiceTypedAsJSON' -- * Type declarations ,NgxExportService -- * Re-exported data constructors from /Foreign.C/ @@ -147,10 +149,10 @@ -- -- 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_/__. +-- /testReadConfJSON/. /Persistent 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. @@ -161,16 +163,17 @@ -- * 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/). +-- In this contrived example, the most efficient sleeping strategy is a +-- single-shot service because data is not altered during the 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@. @@ -246,9 +249,18 @@ -- > Storages of service variables: -- > hs_testConfStorage: Just (Conf 20) -- +-- In this example, persistent typed services had a single instance running. But +-- if there had been multiple instances of a single persistent typed service, we +-- would have had a problem. Remember that the name of the configuration storage +-- is made up of the names of the type and the service. This means that multiple +-- instances of a single persistent typed service share a single configuration +-- in the runtime which is not what is normally expected. Exporters +-- 'ngxExportSimpleServiceTyped'' and 'ngxExportSimpleServiceTypedAsJSON'' do +-- not store configurations and are preferable in such cases. +-- -- $preload -- --- Storages of typed simple services can be preloaded /synchronously/ with +-- Storages of persistent typed services can be preloaded /synchronously/ with -- 'ngxExportInitHook'. This is useful if a storage gets accessed immediately -- after the start of processing client requests in a request handler which -- expects that the storage has already been initialized (for example, a request @@ -293,41 +305,57 @@ -- | Single-shot service | SingleShotService -ngxExportSimpleService' :: Name -> Maybe (Name, Bool) -> ServiceMode -> Q [Dec] +isPersistentMode :: ServiceMode -> Bool +isPersistentMode (PersistentService _) = True +isPersistentMode _ = False + +ngxExportSimpleService' :: Name -> Maybe (Name, (Bool, Bool)) -> ServiceMode -> + Q [Dec] ngxExportSimpleService' f c m = do confBs <- newName "confBs_" fstRun <- newName "fstRun_" let nameF = nameBase f nameSsf = mkName $ "simpleService_" ++ nameF (hasConf, conf) = maybe (False, undefined) (True ,) c - (sNameC, typeC, readConf, unreadableConfMsg) = - if hasConf - then let ((tName, tNameBase), isJSON) = - first (id &&& nameBase) conf - in (mkName $ "storage_" ++ tNameBase ++ '_' : nameF - ,conT tName - ,if isJSON - then [|readFromByteStringAsJSON|] - else [|readFromByteString|] - ,"Configuration " ++ tNameBase ++ " is not readable" - ) - else undefined + (sNameC, typeC, makeStorage, (readStorage, writeStorage), + readConf, unreadableConfMsg) = + if hasConf + then let ((tName, tNameBase), (isJSON, storeConf)) = + first (id &&& nameBase) conf + storeConf' = storeConf && isPersistentMode m + sName = mkName $ + "storage_" ++ tNameBase ++ '_' : nameF + storage = varE sName + in (sName + ,conT tName + ,storeConf' + ,if storeConf' + then ([|readIORef $(storage)|] + ,[|writeIORef $(storage)|] + ) + else ([|return Nothing|] + ,[|const $ return ()|] + ) + ,if isJSON + then [|readFromByteStringAsJSON|] + else [|readFromByteString|] + ,"Configuration " ++ tNameBase ++ " 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) - |] + then [|$(readStorage) >>= + maybe (do + let conf_data__ = + $(readConf) $(eConfBs) + when (isNothing conf_data__) $ + terminateWorkerProcess + unreadableConfMsg + $(writeStorage) conf_data__ + return conf_data__ + ) (return . Just) + |] else [|return $ Just $(eConfBs)|] (waitTime, runService) = let eF = varE f @@ -357,7 +385,7 @@ ) concat <$> sequence [sequence $ - (if hasConf + (if hasConf && makeStorage then [sigD sNameC [t|IORef (Maybe $(typeC))|] ,funD sNameC [clause [] @@ -406,13 +434,14 @@ -- 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 a 'Maybe' container which --- contains 'Nothing' until the initialization on the first service run. +-- 'Read' at its first argument. For the sake of efficiency, when the service +-- mode is a 'PersistentService', 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 a 'Maybe' container which contains 'Nothing' +-- until the initialization on the first service run. -- -- When reading of the custom object fails on the first service run, the -- service terminates the worker process by calling 'terminateWorkerProcess' @@ -422,7 +451,7 @@ -> ServiceMode -- ^ Service mode -> Q [Dec] ngxExportSimpleServiceTyped f c = - ngxExportSimpleService' f $ Just (c, False) + ngxExportSimpleService' f $ Just (c, (False, True)) -- | Exports a simple service of type -- @@ -434,13 +463,13 @@ -- -- The service expects an object of a custom type implementing an instance of -- t'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 a 'Maybe' --- container which contains 'Nothing' until the initialization on the first --- service run. +-- when the service mode is a 'PersistentService', 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 a 'Maybe' container which +-- contains 'Nothing' until the initialization on the first service run. -- -- When reading of the custom object fails on the first service run, the -- service terminates the worker process by calling 'terminateWorkerProcess' @@ -450,5 +479,43 @@ -> ServiceMode -- ^ Service mode -> Q [Dec] ngxExportSimpleServiceTypedAsJSON f c = - ngxExportSimpleService' f $ Just (c, True) + ngxExportSimpleService' f $ Just (c, (True, True)) + +-- | Exports a simple service of type +-- +-- @ +-- 'Read' a => a -> 'Prelude.Bool' -> 'IO' 'L.ByteString' +-- @ +-- +-- with specified name and service mode. +-- +-- This exporter is similar to 'ngxExportSimpleServiceTyped' except it does not +-- store data in a global storage for persistent services. Use this exporter +-- when multiple instances of the service with different configurations are +-- required. +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, False)) + +-- | Exports a simple service of type +-- +-- @ +-- t'Data.Aeson.FromJSON' a => a -> 'Prelude.Bool' -> 'IO' 'L.ByteString' +-- @ +-- +-- with specified name and service mode. +-- +-- This exporter is similar to 'ngxExportSimpleServiceTypedAsJSON' except it +-- does not store data in a global storage for persistent services. Use this +-- exporter when multiple instances of the service with different configurations +-- are required. +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, False)) diff --git a/ngx-export-tools.cabal b/ngx-export-tools.cabal --- a/ngx-export-tools.cabal +++ b/ngx-export-tools.cabal @@ -1,5 +1,5 @@ name: ngx-export-tools -version: 1.2.4.1 +version: 1.2.5 synopsis: Extra tools for Nginx Haskell module description: Extra tools for .