ngx-export-tools-1.2.6: NgxExport/Tools/SimpleService.hs
{-# LANGUAGE TemplateHaskell, TupleSections #-}
-----------------------------------------------------------------------------
-- |
-- Module : NgxExport.Tools.SimpleService
-- Copyright : (c) Alexey Radkov 2018-2024
-- 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
-- *** Preloading storages of persistent typed services
-- $preload
-- * Exported data and functions
ServiceMode (..)
,ngxExportSimpleService
,ngxExportSimpleServiceTyped
,ngxExportSimpleServiceTypedAsJSON
,ngxExportSimpleServiceTyped'
,ngxExportSimpleServiceTypedAsJSON'
-- * Type declarations
,NgxExportService
-- * 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 NgxExport.Tools.Types (NgxExportService)
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 are classified as /untyped/ or /typed/. The untyped
-- services have type
--
-- @
-- 'ByteString' -> 'Prelude.Bool' -> 'IO' 'L.ByteString'
-- @
--
-- which corresponds to the type of usual services from module "NgxExport". The
-- typed services are backed by functions from module "NgxExport.Tools.Read"
-- and may have two different types:
--
-- @
-- 'Read' a => a -> 'Prelude.Bool' -> 'IO' 'L.ByteString'
-- @
-- @
-- t'Data.Aeson.FromJSON' a => a -> 'Prelude.Bool' -> 'IO' 'L.ByteString'
-- @
--
-- The choice of a certain type of a typed service depends on the format in
-- which the typed data will be passed from the Nginx configuration.
--
-- 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/. /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.
-- 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 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@.
--
-- ==== 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)
--
-- 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 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
-- handler may unpack the storage with 'fromJust' without checking errors).
--
-- ==== File /test_tools.hs/: preload storage_Int_testReadInt
-- @
-- import System.Environment
--
-- -- ...
--
-- initTestReadInt :: IO ()
-- __/initTestReadInt/__ = do
-- _ : v : _ \<- dropWhile (\/= \"__/--testReadInt/__\") \<$\> 'System.Environment.getArgs'
-- let i = read v
-- i \`seq\` writeIORef __/storage_Int_testReadInt/__ (Just i)
-- 'ngxExportInitHook' \'initTestReadInt
-- @
--
-- Note that the preloaded value gets evaluated inside the hook to spot any
-- parse errors inplace before the start of processing client requests.
--
-- ==== File /nginx.conf/: read data for storage_Int_testReadInt
-- @
-- haskell program_options __/--testReadInt/__ 800;
--
-- # ...
--
-- haskell_run_service __/simpleService_testReadInt/__
-- $hs_testReadInt
-- __/-/__;
-- @
--
-- The preloaded value gets passed in directive /haskell program_options/. The
-- value in the service declaration can be replaced by any lexeme as it won't
-- be parsed. In this example, it was replaced by a dash.
-- | Defines a sleeping strategy.
data ServiceMode
-- | Persistent service (with or without periodical sleeps)
= PersistentService (Maybe TimeInterval)
-- | Single-shot service
| SingleShotService
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, 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 [|$(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
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 && makeStorage
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, 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'
-- 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, True))
-- | Exports a simple service of type
--
-- @
-- t'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
-- t'Data.Aeson.FromJSON' 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'
-- 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, 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.
--
-- @since 1.2.5
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.
--
-- @since 1.2.5
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))