summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorlyokha <>2018-11-08 16:05:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-11-08 16:05:00 (GMT)
commitc05d1158dbb87ab50a53f4500b3937efbc33c07f (patch)
tree2f0391e37998a1fdbca9d0d93de0ae723515493c
parent8f654a73374516e6cb808dd79fe25a3eb6d86a43 (diff)
version 0.3.0.00.3.0.0
-rw-r--r--Changelog.md5
-rw-r--r--NgxExport/Tools.hs207
-rw-r--r--ngx-export-tools.cabal2
3 files changed, 195 insertions, 19 deletions
diff --git a/Changelog.md b/Changelog.md
index cbf271c..fa4beba 100644
--- a/Changelog.md
+++ b/Changelog.md
@@ -1,3 +1,8 @@
+### 0.3.0.0
+
+- Added readers of custom types consuming the Nginx request pointer at first.
+- Extended docs and examples.
+
### 0.2.1.1
- Fixed examples of simple services handlers.
diff --git a/NgxExport/Tools.hs b/NgxExport/Tools.hs
index 5b423b8..a19406e 100644
--- a/NgxExport/Tools.hs
+++ b/NgxExport/Tools.hs
@@ -28,8 +28,11 @@ module NgxExport.Tools (
,toSec
,threadDelaySec
-- *** Reading custom types from /ByteStrings/
+ -- $readingCustomTypes
,readFromByteString
,readFromByteStringAsJSON
+ ,readFromByteStringWithRPtr
+ ,readFromByteStringWithRPtrAsJSON
-- * Exporters of simple services
-- $simpleServices
,ServiceMode (..)
@@ -49,6 +52,7 @@ 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
@@ -57,6 +61,7 @@ import Data.IORef
import Data.Maybe
import Data.Aeson
import Control.Monad
+import Control.Arrow
import Control.Concurrent
import GHC.Generics
import System.IO.Unsafe (unsafePerformIO)
@@ -76,14 +81,15 @@ exitWorkerProcess = exit 1
terminateWorkerProcess :: IO ()
terminateWorkerProcess = exit 2
--- | Unmarshals value of Nginx variable __/$_r_ptr/__ into a pointer to the
--- Nginx request object.
+-- | 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. 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.
+-- 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
@@ -138,18 +144,190 @@ instance FromByteString ByteString where
type WrappedT ByteString = ByteString
fromByteString = const Just
--- | Reads a custom type deriving 'Read' from a 'ByteString'.
+-- $readingCustomTypes
+--
+-- There are a number of functions to support /typed/ exchange between Nginx
+-- and Haskell handlers. Functions 'readFromByteString' and
+-- 'readFromByteStringAsJSON' expect values of custom types deriving from
+-- 'Read' and 'FromJSON' respectively. Functions 'readFromByteStringWithRPtr'
+-- and 'readFromByteStringWithRPtrAsJSON' additionally expect a binary value
+-- of a C pointer size marshalled at the beginning of their arguments before
+-- 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 \#-}
+--
+-- module TestTools where
+--
+-- import NgxExport
+-- import NgxExport.Tools
+--
+-- import Foreign.Ptr
+-- 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
+--
+-- newtype Conf = Conf Int deriving (Read, Show)
+--
+-- data ConfJSON = ConfJSONCon1 Int
+-- | ConfJSONCon2 deriving (Generic, Show)
+-- instance FromJSON ConfJSON
+--
+-- testReadIntHandler :: ByteString -> L.ByteString
+-- __/testReadIntHandler/__ = C8L.pack . show .
+-- (readFromByteString :: ByteString -> Maybe Int)
+-- 'ngxExportYY' \'testReadIntHandler
+--
+-- testReadConfHandler :: ByteString -> L.ByteString
+-- __/testReadConfHandler/__ = C8L.pack . show .
+-- (readFromByteString :: ByteString -> Maybe Conf)
+-- 'ngxExportYY' \'testReadConfHandler
+--
+-- testReadConfJSONHandler :: ByteString -> IO L.ByteString
+-- __/testReadConfJSONHandler/__ = return . C8L.pack . show .
+-- (readFromByteStringAsJSON :: ByteString -> Maybe ConfJSON)
+-- 'ngxExportAsyncIOYY' \'testReadConfJSONHandler
+--
+-- testReadConfWithRPtrHandler :: ByteString -> L.ByteString
+-- __/testReadConfWithRPtrHandler/__ = C8L.pack . show .
+-- (readFromByteStringWithRPtr :: ByteString -> (Ptr (), Maybe Conf))
+-- 'ngxExportYY' \'testReadConfWithRPtrHandler
+--
+-- testReadConfWithRPtrJSONHandler :: ByteString -> L.ByteString
+-- __/testReadConfWithRPtrJSONHandler/__ = C8L.pack . show .
+-- (readFromByteStringWithRPtrAsJSON ::
+-- ByteString -> (Ptr (), Maybe 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:\";
+-- echo \" $hs_testReadIntHandler\";
+-- echo \" hs_testReadConfHandler:\";
+-- echo \" $hs_testReadConfHandler\";
+-- echo \" hs_testReadConfJSONHandler:\";
+-- echo \" $hs_testReadConfJSONHandler\";
+-- echo \" hs_testReadConfJSONHandlerBadInput:\";
+-- echo \" $hs_testReadConfJSONHandlerBadInput\";
+-- echo \" hs_testReadConfWithRPtrHandler:\";
+-- echo \" $hs_testReadConfWithRPtrHandler\";
+-- echo \" hs_testReadConfWithRPtrJSONHandler:\";
+-- echo \" $hs_testReadConfWithRPtrJSONHandler\";
+-- }
+-- }
+-- }
+-- @
+--
+-- Let's run 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 deriving 'Read' from a 'ByteString'.
--
-- Returns 'Nothing' if reading fails.
readFromByteString :: Read a => ByteString -> Maybe a
readFromByteString = fromByteString (Nothing :: Maybe (Readable a))
--- | Reads a custom type deriving 'FromJSON' from a 'ByteString'.
+-- | Reads an object of a custom type deriving 'FromJSON' from a 'ByteString'.
--
-- Returns 'Nothing' if reading fails.
readFromByteStringAsJSON :: FromJSON a => ByteString -> Maybe a
readFromByteStringAsJSON = fromByteString (Nothing :: Maybe (ReadableAsJSON a))
+-- | Reads a pointer to the Nginx request object followed by an object of
+-- a custom type deriving '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 deriving '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
+
+skipRPtr :: ByteString -> ByteString
+skipRPtr = B.drop $ sizeOf (undefined :: Word)
+
-- $simpleServices
--
-- There are a number of exporters for /simple services/. Here /simplicity/
@@ -334,10 +512,6 @@ data ServiceMode
-- | Single-shot service
| SingleShotService
-simpleServiceWrap ::
- (a -> Bool -> IO L.ByteString) -> a -> Bool -> IO L.ByteString
-simpleServiceWrap f = f
-
ngxExportSimpleService' :: Name -> Maybe (Name, Bool) -> ServiceMode -> Q [Dec]
ngxExportSimpleService' f c m = do
confBs <- newName "confBs_"
@@ -377,7 +551,7 @@ ngxExportSimpleService' f c m = do
fromByteString (Nothing :: Maybe ByteString)
$(eConfBs)
|]
- (waitTime, serviceWrap) =
+ (waitTime, runService) =
let eF = varE f
eFstRun = varE fstRun
in case m of
@@ -389,8 +563,7 @@ ngxExportSimpleService' f c m = do
|]
else [|return ()|]
,[|\conf_data__ ->
- simpleServiceWrap
- $(eF) (fromJust conf_data__) $(eFstRun)
+ $(eF) (fromJust conf_data__) $(eFstRun)
|]
)
SingleShotService ->
@@ -398,9 +571,7 @@ ngxExportSimpleService' f c m = do
threadDelaySec $ toSec $ Hr 1|]
,[|\conf_data__ ->
if $(eFstRun)
- then simpleServiceWrap
- $(eF) (fromJust conf_data__)
- $(eFstRun)
+ then $(eF) (fromJust conf_data__) $(eFstRun)
else return L.empty
|]
)
@@ -424,7 +595,7 @@ ngxExportSimpleService' f c m = do
[sigD nameSsf [t|ByteString -> Bool -> IO L.ByteString|]
,funD nameSsf
[clause [varP confBs, varP fstRun]
- (normalB [|$(waitTime) >> $(initConf) >>= $(serviceWrap)|])
+ (normalB [|$(waitTime) >> $(initConf) >>= $(runService)|])
[]
]
]
diff --git a/ngx-export-tools.cabal b/ngx-export-tools.cabal
index 223b9d0..a53a0b0 100644
--- a/ngx-export-tools.cabal
+++ b/ngx-export-tools.cabal
@@ -1,5 +1,5 @@
name: ngx-export-tools
-version: 0.2.1.1
+version: 0.3.0.0
synopsis: Extra tools for Nginx haskell module
description: Extra tools for
<http://github.com/lyokha/nginx-haskell-module Nginx haskell module>