{-# LANGUAGE TemplateHaskell, BangPatterns, OverloadedStrings #-}
{-# LANGUAGE ForeignFunctionInterface, CApiFFI #-}

{-# OPTIONS_GHC -fno-warn-dodgy-foreign-imports #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  NgxExport.Tools.PCRE
-- Copyright   :  (c) Alexey Radkov 2021
-- License     :  BSD-style
--
-- Maintainer  :  alexey.radkov@gmail.com
-- Stability   :  experimental
-- Portability :  non-portable (requires Template Haskell)
--
-- PCRE matching and substitution from the more extra tools collection
-- for <http://github.com/lyokha/nginx-haskell-module nginx-haskell-module>.
--
-----------------------------------------------------------------------------

module NgxExport.Tools.PCRE (
    -- * Matching against regular expressions
    -- $matchingPCRE
                             matchRegex
    -- * Substitution with regular expressions
    -- $substitutionPCRE
                            ,SubPasteF
                            ,subRegex
                            ,subRegexWith
                            ,gsubRegex
                            ,gsubRegexWith
                            ) where

import           NgxExport
import           NgxExport.Tools

import qualified Data.HashMap.Strict as HM
import           Data.HashMap.Strict (HashMap)
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as C8
import qualified Data.ByteString.Lazy as L
import           Data.List
import           Data.Maybe
import           Data.IORef
import           Text.Regex.PCRE.Light hiding (compile, compileM)
import           Text.Regex.PCRE.Light.Base
import           Text.Regex.PCRE.Heavy hiding (compileM)
import           Control.Exception (Exception, throwIO)
import           Control.Arrow
import           Foreign.Ptr
import           Foreign.ForeignPtr
import           Foreign.C.String
import           Foreign.Storable
import           Foreign.Marshal.Alloc
import           System.IO.Unsafe

-- $matchingPCRE
--
-- This module provides a simple handler __/matchRegex/__ to match a value
-- against a PCRE regex preliminary declared and compiled in
-- /configuration service/ __/simpleService_declareRegexes/__ (which is an
-- 'ignitionService' in terms of module "NgxExport.Tools") and the corresponding
-- /service update hook/ (in terms of module "NgxExport") __/compileRegexes/__
-- at the start of the service.
--
-- Below is a simple example.
--
-- ==== File /test_tools_extra_pcre.hs/
-- @
-- module TestToolsExtraPCRE where
--
-- import NgxExport.Tools.PCRE ()
-- @
--
-- The file does not contain any significant declarations as we are going to use
-- only the exporters of the handlers.
--
-- ==== 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_extra_pcre.so;
--
--     haskell_run_service __/simpleService_declareRegexes/__ $hs_regexes
--             \'[(\"__/userArea/__\", \"(?:\\\\\\\\|)(\\\\\\\\d+)$\", \"\")
--              ,(\"__/keyValue/__\", \"(k\\\\\\\\w+)(\\\\\\\\|)(v\\\\\\\\w+)\", \"i\")
--              ]\';
--
--     haskell_service_update_hook __/compileRegexes/__ $hs_regexes;
--
--     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 __/matchRegex/__ $hs_user_area '__/userArea|/__$arg_user';
--             rewrite ^ \/internal\/user\/area\/$hs_user_area last;
--         }
--
--         location ~ ^\/internal\/user\/area\/(PCRE\ ERROR:.*) {
--             internal;
--             echo_status 404;
--             echo \"Bad input: $1\";
--         }
--
--         location = \/internal\/user\/area\/ {
--             internal;
--             echo_status 404;
--             echo \"No user area attached\";
--         }
--
--         location ~ ^\/internal\/user\/area\/(.+) {
--             internal;
--             echo \"User area: $1\";
--         }
--     }
-- }
-- @
--
-- In this example, we expect requests with argument /user/ which should
-- supposedly be tagged with an /area/ code containing digits only. The /user/
-- value should match against regex /userArea/ declared alongside with another
-- regex /keyValue/ (the latter has an option /i/ which corresponds to
-- 'caseless'; the regex compiler has also support for options /s/ and /m/ which
-- correspond to 'dotall' and 'multiline' respectively). Notice that regex
-- declarations require 4-fold backslashes as they are getting shrunk while
-- interpreted sequentially by the Nginx configuration interpreter and then by
-- the Haskell compiler too.
--
-- Handler /matchRegex/ finds the named regex /userArea/ from the beginning of
-- its argument: the second part of the argument is delimited by a /bar/ symbol
-- and contains the value to match against. If the regex contains captures, then
-- the matched value shall correspond to the contents of the first capture (in
-- case of /userArea/, this is the area code), otherwise it must correspond to
-- the whole matched value.
--
-- ==== A simple test
--
-- > $ curl 'http://localhost:8010/'
-- > No user area attached
-- > $ curl 'http://localhost:8010/?user=peter|98'
-- > User area: 98
-- > $ curl 'http://localhost:8010/?user=peter|98i'
-- > No user area attached

type InputRegexes = [(ByteString, ByteString, ByteString)]
type Regexes = HashMap ByteString Regex

newtype MatchRegexError = MatchRegexError String

instance Exception MatchRegexError
instance Show MatchRegexError where
    show :: MatchRegexError -> String
show (MatchRegexError s :: String
s) = "PCRE ERROR: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

regexes :: IORef Regexes
regexes :: IORef Regexes
regexes = IO (IORef Regexes) -> IORef Regexes
forall a. IO a -> a
unsafePerformIO (IO (IORef Regexes) -> IORef Regexes)
-> IO (IORef Regexes) -> IORef Regexes
forall a b. (a -> b) -> a -> b
$ Regexes -> IO (IORef Regexes)
forall a. a -> IO (IORef a)
newIORef Regexes
forall k v. HashMap k v
HM.empty
{-# NOINLINE regexes #-}

declareRegexes :: InputRegexes -> Bool -> IO L.ByteString
declareRegexes :: InputRegexes -> Bool -> IO ByteString
declareRegexes = (InputRegexes -> IO ByteString)
-> InputRegexes -> Bool -> IO ByteString
forall a. (a -> IO ByteString) -> a -> Bool -> IO ByteString
ignitionService ((InputRegexes -> IO ByteString)
 -> InputRegexes -> Bool -> IO ByteString)
-> (InputRegexes -> IO ByteString)
-> InputRegexes
-> Bool
-> IO ByteString
forall a b. (a -> b) -> a -> b
$ IO ByteString -> InputRegexes -> IO ByteString
forall a b. a -> b -> a
const (IO ByteString -> InputRegexes -> IO ByteString)
-> IO ByteString -> InputRegexes -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ""

ngxExportSimpleServiceTyped 'declareRegexes ''InputRegexes SingleShotService


{- SPLICE: compile with pcre_free finalizer, mostly adopted from pcre-light -}

foreign import capi "pcre.h value pcre_free" c_pcre_free' :: FinalizerPtr a

compile :: ByteString -> [PCREOption] -> Regex
compile :: ByteString -> [PCREOption] -> Regex
compile s :: ByteString
s o :: [PCREOption]
o = case ByteString -> [PCREOption] -> Either String Regex
compileM ByteString
s [PCREOption]
o of
    Right r :: Regex
r -> Regex
r
    Left e :: String
e -> String -> Regex
forall a. HasCallStack => String -> a
error ("Text.Regex.PCRE.Light: Error in regex: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e)

compileM :: ByteString -> [PCREOption] -> Either String Regex
compileM :: ByteString -> [PCREOption] -> Either String Regex
compileM str :: ByteString
str os :: [PCREOption]
os = IO (Either String Regex) -> Either String Regex
forall a. IO a -> a
unsafePerformIO (IO (Either String Regex) -> Either String Regex)
-> IO (Either String Regex) -> Either String Regex
forall a b. (a -> b) -> a -> b
$
    ByteString
-> (CString -> IO (Either String Regex))
-> IO (Either String Regex)
forall a. ByteString -> (CString -> IO a) -> IO a
C8.useAsCString ByteString
str ((CString -> IO (Either String Regex)) -> IO (Either String Regex))
-> (CString -> IO (Either String Regex))
-> IO (Either String Regex)
forall a b. (a -> b) -> a -> b
$ \ptn :: CString
ptn ->
        (Ptr CString -> IO (Either String Regex))
-> IO (Either String Regex)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CString -> IO (Either String Regex))
 -> IO (Either String Regex))
-> (Ptr CString -> IO (Either String Regex))
-> IO (Either String Regex)
forall a b. (a -> b) -> a -> b
$ \errptr :: Ptr CString
errptr ->
            (Ptr CInt -> IO (Either String Regex)) -> IO (Either String Regex)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Either String Regex))
 -> IO (Either String Regex))
-> (Ptr CInt -> IO (Either String Regex))
-> IO (Either String Regex)
forall a b. (a -> b) -> a -> b
$ \erroffset :: Ptr CInt
erroffset -> do
                Ptr ()
pcre_ptr <- CString
-> PCREOption
-> Ptr CString
-> Ptr CInt
-> Ptr Word8
-> IO (Ptr ())
c_pcre_compile CString
ptn ([PCREOption] -> PCREOption
combineOptions [PCREOption]
os)
                    Ptr CString
errptr Ptr CInt
erroffset Ptr Word8
forall a. Ptr a
nullPtr
                if Ptr ()
pcre_ptr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
nullPtr
                    then do
                        String
err <- CString -> IO String
peekCString (CString -> IO String) -> IO CString -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
errptr
                        Either String Regex -> IO (Either String Regex)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String Regex
forall a b. a -> Either a b
Left String
err)
                    else do
                        ForeignPtr ()
reg <- FinalizerPtr () -> Ptr () -> IO (ForeignPtr ())
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ()
forall a. FinalizerPtr a
c_pcre_free' Ptr ()
pcre_ptr
                        Either String Regex -> IO (Either String Regex)
forall (m :: * -> *) a. Monad m => a -> m a
return (Regex -> Either String Regex
forall a b. b -> Either a b
Right (ForeignPtr () -> ByteString -> Regex
Regex ForeignPtr ()
reg ByteString
str))

{- SPLICE: END -}


compileRegexes :: ByteString -> IO L.ByteString
compileRegexes :: ByteString -> IO ByteString
compileRegexes = IO ByteString -> ByteString -> IO ByteString
forall a b. a -> b -> a
const (IO ByteString -> ByteString -> IO ByteString)
-> IO ByteString -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ do
    !InputRegexes
inputRegexes <- Maybe InputRegexes -> InputRegexes
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe InputRegexes -> InputRegexes)
-> IO (Maybe InputRegexes) -> IO InputRegexes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Maybe InputRegexes) -> IO (Maybe InputRegexes)
forall a. IORef a -> IO a
readIORef IORef (Maybe InputRegexes)
storage_InputRegexes_declareRegexes
    let !compiledRegexes :: Regexes
compiledRegexes =
            (Regexes -> (ByteString, ByteString, ByteString) -> Regexes)
-> Regexes -> InputRegexes -> Regexes
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\a :: Regexes
a (!ByteString
k, !ByteString
v, !ByteString
m) -> let !r :: Regex
r = ByteString -> [PCREOption] -> Regex
compile ByteString
v ([PCREOption] -> Regex) -> [PCREOption] -> Regex
forall a b. (a -> b) -> a -> b
$ String -> [PCREOption]
mods (String -> [PCREOption]) -> String -> [PCREOption]
forall a b. (a -> b) -> a -> b
$ ByteString -> String
C8.unpack ByteString
m
                                           !hm :: Regexes
hm = ByteString -> Regex -> Regexes -> Regexes
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert ByteString
k Regex
r Regexes
a
                                       in Regexes
hm
                   ) Regexes
forall k v. HashMap k v
HM.empty InputRegexes
inputRegexes
    IORef Regexes -> Regexes -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Regexes
regexes Regexes
compiledRegexes
    ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ""
    where md :: Char -> Maybe PCREOption
md 'i' = PCREOption -> Maybe PCREOption
forall a. a -> Maybe a
Just PCREOption
caseless
          md 's' = PCREOption -> Maybe PCREOption
forall a. a -> Maybe a
Just PCREOption
dotall
          md 'm' = PCREOption -> Maybe PCREOption
forall a. a -> Maybe a
Just PCREOption
multiline
          md  _  = Maybe PCREOption
forall a. Maybe a
Nothing
          mods :: String -> [PCREOption]
mods = ([PCREOption] -> PCREOption) -> [[PCREOption]] -> [PCREOption]
forall a b. (a -> b) -> [a] -> [b]
map [PCREOption] -> PCREOption
forall a. [a] -> a
head ([[PCREOption]] -> [PCREOption])
-> (String -> [[PCREOption]]) -> String -> [PCREOption]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PCREOption] -> [[PCREOption]]
forall a. Eq a => [a] -> [[a]]
group ([PCREOption] -> [[PCREOption]])
-> (String -> [PCREOption]) -> String -> [[PCREOption]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PCREOption] -> [PCREOption]
forall a. Ord a => [a] -> [a]
sort ([PCREOption] -> [PCREOption])
-> (String -> [PCREOption]) -> String -> [PCREOption]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Maybe PCREOption) -> String -> [PCREOption]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Char -> Maybe PCREOption
md

ngxExportServiceHook 'compileRegexes

type InputSubs = [(ByteString, ByteString)]
type Subs = HashMap ByteString ByteString

substitutions :: IORef Subs
substitutions :: IORef Subs
substitutions = IO (IORef Subs) -> IORef Subs
forall a. IO a -> a
unsafePerformIO (IO (IORef Subs) -> IORef Subs) -> IO (IORef Subs) -> IORef Subs
forall a b. (a -> b) -> a -> b
$ Subs -> IO (IORef Subs)
forall a. a -> IO (IORef a)
newIORef Subs
forall k v. HashMap k v
HM.empty
{-# NOINLINE substitutions #-}

mapSubs :: InputSubs -> Bool -> IO L.ByteString
mapSubs :: InputSubs -> Bool -> IO ByteString
mapSubs = (InputSubs -> IO ByteString) -> InputSubs -> Bool -> IO ByteString
forall a. (a -> IO ByteString) -> a -> Bool -> IO ByteString
ignitionService ((InputSubs -> IO ByteString)
 -> InputSubs -> Bool -> IO ByteString)
-> (InputSubs -> IO ByteString)
-> InputSubs
-> Bool
-> IO ByteString
forall a b. (a -> b) -> a -> b
$ \isubs :: InputSubs
isubs -> do
    IORef Subs -> Subs -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Subs
substitutions (Subs -> IO ()) -> Subs -> IO ()
forall a b. (a -> b) -> a -> b
$
        (Subs -> (ByteString, ByteString) -> Subs)
-> Subs -> InputSubs -> Subs
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\a :: Subs
a (k :: ByteString
k, v :: ByteString
v) -> ByteString -> ByteString -> Subs -> Subs
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert ByteString
k ByteString
v Subs
a) Subs
forall k v. HashMap k v
HM.empty InputSubs
isubs
    ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ""

ngxExportSimpleServiceTyped 'mapSubs ''InputSubs SingleShotService

type RegexF = Regex -> ByteString -> IO ByteString

rtRegex :: RegexF -> ByteString -> IO L.ByteString
rtRegex :: RegexF -> ByteString -> IO ByteString
rtRegex f :: RegexF
f = (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
L.fromStrict (IO ByteString -> IO ByteString)
-> (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString -> IO ByteString)
-> (ByteString, ByteString) -> IO ByteString
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> IO ByteString
doRtRegex ((ByteString, ByteString) -> IO ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (ByteString -> ByteString)
-> (ByteString, ByteString) -> (ByteString, ByteString)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ByteString -> ByteString
C8.tail ((ByteString, ByteString) -> (ByteString, ByteString))
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> (ByteString, ByteString)
C8.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '|')
    where doRtRegex :: ByteString -> ByteString -> IO ByteString
doRtRegex k :: ByteString
k v :: ByteString
v = do
              Regexes
rgxs <- IORef Regexes -> IO Regexes
forall a. IORef a -> IO a
readIORef IORef Regexes
regexes
              case ByteString -> Regexes -> Maybe Regex
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup ByteString
k Regexes
rgxs of
                  Nothing -> MatchRegexError -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO (MatchRegexError -> IO ByteString)
-> MatchRegexError -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> MatchRegexError
MatchRegexError (String -> MatchRegexError) -> String -> MatchRegexError
forall a b. (a -> b) -> a -> b
$
                      "Regex " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
C8.unpack ByteString
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ " was not found"
                  Just r :: Regex
r -> RegexF
f Regex
r ByteString
v

doMatchRegex :: RegexF
doMatchRegex :: RegexF
doMatchRegex r :: Regex
r v :: ByteString
v = ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$
    case Regex -> ByteString -> [PCREExecOption] -> Maybe [ByteString]
match Regex
r ByteString
v [] of
        Nothing -> ""
        Just cs :: [ByteString]
cs -> if Regex -> Int
captureCount Regex
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
                       then [ByteString] -> ByteString
forall a. [a] -> a
head [ByteString]
cs
                       else [ByteString] -> ByteString
forall a. [a] -> a
head ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
tail [ByteString]
cs

-- | Matches a value against a named regex.
--
-- The regex must be preliminary declared and compiled by service handlers
-- /simpleService_declareRegexes/ and /compileRegexes/. The name of the regex
-- and the value are passed in a single argument: the two parts are delimited by
-- the first /bar/ symbol met from the left, e.g. /key|value/.
--
-- This is the core function of the /matchRegex/ handler.
matchRegex
    :: ByteString           -- ^ Key to find the regex, and the value
    -> IO L.ByteString
matchRegex :: ByteString -> IO ByteString
matchRegex = RegexF -> ByteString -> IO ByteString
rtRegex RegexF
doMatchRegex

ngxExportIOYY 'matchRegex

-- $substitutionPCRE
--
-- There are handlers to make substitutions using PCRE regexes. An
-- 'ignitionService' __/simpleService_mapSubs/__ declares named /plain/
-- substitutions which are made in run-time by handlers __/subRegex/__ and
-- __/gsubRegex/__. Functions 'subRegexWith' and 'gsubRegexWith' make it
-- possible to write custom /functional/ substitutions.
--
-- Let's extend our example by adding ability to erase the captured area code.
-- We also going to implement a /functional/ substitution to swap the keys and
-- the values matched in the /keyValue/ regex.
--
-- ==== File /test_tools_extra_pcre.hs/
-- @
-- {-\# LANGUAGE TemplateHaskell \#-}
--
-- module TestToolsExtraPCRE where
--
-- import           NgxExport
-- import           NgxExport.Tools.PCRE
--
-- import           Data.ByteString (ByteString)
-- import qualified Data.ByteString as B
-- import qualified Data.ByteString.Lazy as L
--
-- gsubSwapAround :: ByteString -> IO L.ByteString
-- __/gsubSwapAround/__ = 'gsubRegexWith' $ \\_ (a : d : b : _) -> B.concat [b, d, a]
--
-- 'ngxExportIOYY' \'gsubSwapAround
-- @
--
-- Functional substitution handler /gsubSwapAround/ expects a regular expression
-- with at least 3 capture groups to swap the contents of the first and the
-- third groups around. We are going to apply this handler against regex
-- /keyValue/.
--
-- ==== File /nginx.conf/: erase area code and swap keys and values
-- @
--     haskell_run_service __/simpleService_mapSubs/__ $hs_subs
--             \'[(\"__/erase/__\", \"\")]\';
--
--     haskell_var_empty_on_error $hs_kv;
-- @
-- @
--         location \/erase\/area {
--             haskell_run __/subRegex/__ $hs_user_no_area \'__/userArea|erase|/__$arg_user\';
--             rewrite ^ \/internal\/user\/noarea\/$hs_user_no_area last;
--         }
--
--         location ~ ^\/internal\/user\/noarea\/(PCRE\\ ERROR:.*) {
--             internal;
--             echo_status 404;
--             echo \"Bad input: $1\";
--         }
--
--         location ~ ^\/internal\/user\/noarea\/(.*) {
--             internal;
--             echo \"User without area: $1\";
--         }
--
--         location \/swap {
--             haskell_run __/gsubSwapAround/__ $hs_kv \'__/keyValue|/__$arg_kv\';
--             echo \"Swap $arg_kv = $hs_kv\";
--         }
-- @
--
-- Service /simpleService_mapSubs/ declares a list of named /plain/
-- substitutions. In this example, it declares only one substitution /erase/
-- which substitutes an empty string, i.e. /erases/ the matched text. Notice
-- that the argument of handler /subRequest/ requires three parts delimited by
-- /bar/ symbols: the named regex, the named substitution, and the value to
-- match against.
--
-- ==== A simple test
--
-- > $ curl 'http://localhost:8010/erase/area?user=peter|98'
-- > User without area: peter
-- > $ curl 'http://localhost:8010/swap?kv=kid|v0012a
-- > Swap kid|v0012a = v0012a|kid

-- | Type of functions to perform /functional/ substitutions.
type SubPasteF =
       ByteString       -- ^ The full match
    -> [ByteString]     -- ^ List of captures
    -> ByteString

type SubF = Regex -> SubPasteF -> ByteString -> ByteString

doSubRegex :: SubF -> Maybe SubPasteF -> RegexF
doSubRegex :: SubF -> Maybe SubPasteF -> RegexF
doSubRegex f :: SubF
f p :: Maybe SubPasteF
p r :: Regex
r v :: ByteString
v =
    case Maybe SubPasteF
p of
        Nothing -> do
            let (k :: ByteString
k, v' :: ByteString
v') = (ByteString -> ByteString)
-> (ByteString, ByteString) -> (ByteString, ByteString)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ByteString -> ByteString
C8.tail ((ByteString, ByteString) -> (ByteString, ByteString))
-> (ByteString, ByteString) -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> (ByteString, ByteString)
C8.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '|') ByteString
v
            Subs
subs <- IORef Subs -> IO Subs
forall a. IORef a -> IO a
readIORef IORef Subs
substitutions
            case ByteString -> Subs -> Maybe ByteString
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup ByteString
k Subs
subs of
                Nothing -> MatchRegexError -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO (MatchRegexError -> IO ByteString)
-> MatchRegexError -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> MatchRegexError
MatchRegexError (String -> MatchRegexError) -> String -> MatchRegexError
forall a b. (a -> b) -> a -> b
$
                    "Substitution " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
C8.unpack ByteString
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ " was not found"
                Just s :: ByteString
s -> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ SubF
f Regex
r (SubPasteF
forall a b. a -> b -> a
const SubPasteF -> (ByteString -> ByteString) -> SubPasteF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> ByteString
forall a b. a -> b -> a
const ByteString
s) ByteString
v'
        Just paste :: SubPasteF
paste -> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ SubF
f Regex
r SubPasteF
paste ByteString
v

-- | Pastes a named /plain/ substitution using a named regex.
--
-- The substitution and the regex must be preliminary declared and compiled by
-- service handlers /simpleService_declareRegexes/, /compileRegexes/, and
-- /simpleService_mapSubs/. The names of the regex and the substitution, and
-- the value are passed in a single argument: the three parts are delimited by
-- /bar/ symbols, e.g. /regex|sub|value/. The substitution gets applied only to
-- the first occurrence of the match.
--
-- This is the core function of the /subRegex/ handler.
subRegex
    :: ByteString       -- ^ Keys to find the regex and the sub, and the value
    -> IO L.ByteString
subRegex :: ByteString -> IO ByteString
subRegex = RegexF -> ByteString -> IO ByteString
rtRegex (RegexF -> ByteString -> IO ByteString)
-> RegexF -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ SubF -> Maybe SubPasteF -> RegexF
doSubRegex SubF
forall a r.
(ConvertibleStrings ByteString a, ConvertibleStrings a ByteString,
 RegexReplacement r) =>
Regex -> r -> a -> a
sub Maybe SubPasteF
forall a. Maybe a
Nothing

ngxExportIOYY 'subRegex

-- | Pastes /functional/ substitutions using a named regex and a function.
--
-- The substitutions get applied only to the first occurrence of the match.
subRegexWith
    :: SubPasteF        -- ^ Function to paste substitutions
    -> ByteString       -- ^ Keys to find the regex and the sub, and the value
    -> IO L.ByteString
subRegexWith :: SubPasteF -> ByteString -> IO ByteString
subRegexWith = RegexF -> ByteString -> IO ByteString
rtRegex (RegexF -> ByteString -> IO ByteString)
-> (SubPasteF -> RegexF)
-> SubPasteF
-> ByteString
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubF -> Maybe SubPasteF -> RegexF
doSubRegex SubF
forall a r.
(ConvertibleStrings ByteString a, ConvertibleStrings a ByteString,
 RegexReplacement r) =>
Regex -> r -> a -> a
sub (Maybe SubPasteF -> RegexF)
-> (SubPasteF -> Maybe SubPasteF) -> SubPasteF -> RegexF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubPasteF -> Maybe SubPasteF
forall a. a -> Maybe a
Just

-- | Pastes a named /plain/ substitution using a named regex.
--
-- The same as 'subRegex' except that the substitution gets applied
-- globally, wherever the match occurs.
--
-- This is the core function of the /gsubRegex/ handler.
gsubRegex
    :: ByteString       -- ^ Keys to find the regex and the sub, and the value
    -> IO L.ByteString
gsubRegex :: ByteString -> IO ByteString
gsubRegex = RegexF -> ByteString -> IO ByteString
rtRegex (RegexF -> ByteString -> IO ByteString)
-> RegexF -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ SubF -> Maybe SubPasteF -> RegexF
doSubRegex SubF
forall a r.
(ConvertibleStrings ByteString a, ConvertibleStrings a ByteString,
 RegexReplacement r) =>
Regex -> r -> a -> a
gsub Maybe SubPasteF
forall a. Maybe a
Nothing

ngxExportIOYY 'gsubRegex

-- | Pastes /functional/ substitutions using a named regex and a function.
--
-- The same as 'subRegexWith' except that the substitutions get applied
-- globally, wherever the match occurs.
gsubRegexWith
    :: SubPasteF        -- ^ Function to paste substitutions
    -> ByteString       -- ^ Keys to find the regex and the sub, and the value
    -> IO L.ByteString
gsubRegexWith :: SubPasteF -> ByteString -> IO ByteString
gsubRegexWith = RegexF -> ByteString -> IO ByteString
rtRegex (RegexF -> ByteString -> IO ByteString)
-> (SubPasteF -> RegexF)
-> SubPasteF
-> ByteString
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubF -> Maybe SubPasteF -> RegexF
doSubRegex SubF
forall a r.
(ConvertibleStrings ByteString a, ConvertibleStrings a ByteString,
 RegexReplacement r) =>
Regex -> r -> a -> a
gsub (Maybe SubPasteF -> RegexF)
-> (SubPasteF -> Maybe SubPasteF) -> SubPasteF -> RegexF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubPasteF -> Maybe SubPasteF
forall a. a -> Maybe a
Just