-----------------------------------------------------------------------------
-- |
-- 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 :: String -> IO ()
terminateWorkerProcess = TerminateWorkerProcess -> IO ()
forall e a. Exception e => e -> IO a
throwIO (TerminateWorkerProcess -> IO ())
-> (String -> TerminateWorkerProcess) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> TerminateWorkerProcess
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 :: String -> IO ()
restartWorkerProcess = RestartWorkerProcess -> IO ()
forall e a. Exception e => e -> IO a
throwIO (RestartWorkerProcess -> IO ())
-> (String -> RestartWorkerProcess) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RestartWorkerProcess
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 :: Int -> Maybe String -> IO ()
finalizeHTTPRequest = (FinalizeHTTPRequest -> IO ()
forall e a. Exception e => e -> IO a
throwIO (FinalizeHTTPRequest -> IO ())
-> (Maybe String -> FinalizeHTTPRequest) -> Maybe String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Maybe String -> FinalizeHTTPRequest) -> Maybe String -> IO ())
-> (Int -> Maybe String -> FinalizeHTTPRequest)
-> Int
-> Maybe String
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe String -> FinalizeHTTPRequest
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 :: SomeException -> Bool
workerProcessIsExiting SomeException
e =
    Maybe WorkerProcessIsExiting -> Bool
forall a. Maybe a -> Bool
isJust (SomeException -> Maybe WorkerProcessIsExiting
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
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 :: ByteString -> Ptr ()
ngxRequestPtr = WordPtr -> Ptr ()
forall a. WordPtr -> Ptr a
wordPtrToPtr (WordPtr -> Ptr ())
-> (ByteString -> WordPtr) -> ByteString -> Ptr ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> WordPtr
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> WordPtr) -> (ByteString -> Word) -> ByteString -> WordPtr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get Word -> ByteString -> Word
forall a. Get a -> ByteString -> a
runGet Get Word
getWordhost (ByteString -> Word)
-> (ByteString -> ByteString) -> ByteString -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
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 :: IO CTime
ngxNow = IO (Ptr (Ptr ()))
ngxCachedTimePtr IO (Ptr (Ptr ())) -> (Ptr (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ())
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek IO (Ptr ()) -> (Ptr () -> IO CTime) -> IO CTime
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr CTime -> IO CTime
forall a. Storable a => Ptr a -> IO a
peek (Ptr CTime -> IO CTime)
-> (Ptr () -> Ptr CTime) -> Ptr () -> IO CTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr () -> Ptr CTime
forall a b. Ptr a -> Ptr b
castPtr

-- | Returns the /PID/ of the current worker process cached in Nginx core.
ngxPid :: IO CPid
ngxPid :: IO CPid
ngxPid = IO CPid
ngxCachedPid