{-# 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)