nginx-haskell-module 是一个 nginx 的扩展模块，有了它我们就可以用 haskell 来写 nginx 的配置文件，甚至做一些很高级的应用。我们现在先把他的例子跑起来看看。

编译 nginx

首先下载 nginx 源码 ，然后解压：

wget https://nginx.org/download/nginx-1.15.5.tar.gz
tar xvf nginx-1.15.5.tar.gz
cd nginx-1.15.5

下载模块 echo-nginx-module 和 nginx-haskell-module

mkdir modules
cd modules
git clone https://github.com/openresty/echo-nginx-module.git
git clone https://github.com/lyokha/nginx-haskell-module.git
cd ..

然后编译

./configure --prefix=/root/nginx \
    --add-module=modules/nginx-haskell-module \
    --add-module=modules/echo-nginx-module \
    --with-http_ssl_module
make install

编译 Haskell 模块

使用 stack 来编译 haskell 模块

cd modules/nginx-haskell-module/haskell/ngx-export
stack init
stack build

写一个 haskell 模块

mkdir test
cd test
vim haskell.hs

内容如下：

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MagicHash         #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE ViewPatterns      #-}

module NgxHaskellUserRuntime where

import           Control.Exception
import           Control.Monad
import           Data.Aeson
import qualified Data.ByteString            as B
import qualified Data.ByteString.Char8      as C8
import           Data.ByteString.Internal   (accursedUnutterablePerformIO)
import qualified Data.ByteString.Lazy       as L
import qualified Data.ByteString.Lazy.Char8 as C8L
import           Data.ByteString.Unsafe
import qualified Data.Char                  as C
import           Data.Function              (on)
import           Data.Maybe
import qualified Data.Text.Encoding         as T
import           NgxExport
import           Safe
import           Text.Pandoc
import           Text.Pandoc.Builder
import           Text.Regex.PCRE

toUpper = map C.toUpper
ngxExportSS 'toUpper

takeN = take . readDef 0
ngxExportSSS 'takeN

ngxExportSS 'reverse

class UrlDecodable a
    where doURLDecode :: a -> Maybe a

instance UrlDecodable String where
    -- adopted from
    -- http://www.rosettacode.org/wiki/URL_decoding#Haskell
    doURLDecode [] = Just []
    doURLDecode ('%' : xs) =
        case xs of
            (a : b : xss) ->
                (:) . C.chr <$> readMay ('0' : 'x' : [a, b])
                            <*> doURLDecode xss
            _ -> Nothing
    doURLDecode ('+' : xs) = (' ' :) <$> doURLDecode xs
    doURLDecode (x : xs) = (x :) <$> doURLDecode xs

instance UrlDecodable L.ByteString where
    -- adopted for ByteString arguments from
    -- http://www.rosettacode.org/wiki/URL_decoding#Haskell
    doURLDecode (L.null -> True) = Just L.empty
    doURLDecode (L.uncons -> Just (37, xs))
        | L.length xs > 1 =
            let (C8L.unpack -> c, xss) = L.splitAt 2 xs
            in L.cons <$> readMay ('0' : 'x' : c)
                      <*> doURLDecode xss
        | otherwise = Nothing
    doURLDecode (L.uncons -> Just (43, xs)) = (32 `L.cons`) <$> doURLDecode xs
    doURLDecode (L.uncons -> Just (x, xs)) = (x `L.cons`) <$> doURLDecode xs

-- does not match when any of the 2 args is empty or not decodable
matches = (fromMaybe False .) . liftM2 (=~) `on` (doURLDecode =<<) . toMaybe
    where toMaybe [] = Nothing
          toMaybe a  = Just a
ngxExportBSS 'matches

firstNotEmpty = headDef "" . filter (not . null)
ngxExportSLS 'firstNotEmpty

isInList []       = False
isInList (x : xs) = x `elem` xs
ngxExportBLS 'isInList

jSONListOfInts :: B.ByteString -> Maybe [Int]
jSONListOfInts = (decode =<<) . doURLDecode . L.fromStrict

isJSONListOfInts = isJust . jSONListOfInts
ngxExportBY 'isJSONListOfInts

jSONListOfIntsTakeN x = encode $ maybe [] (take n) $ jSONListOfInts y
    where (readDef 0 . C8.unpack -> n, B.tail -> y) = B.break (== 124) x
ngxExportYY 'jSONListOfIntsTakeN

urlDecode = fromMaybe "" . doURLDecode
ngxExportSS 'urlDecode

-- compatible with Pandoc 2.0 (will not compile for older versions)
fromMd (T.decodeUtf8 -> x) = uncurry (, packLiteral 9 "text/html"#, ) $
    case runPure $ readMarkdown def x >>= writeHtml of
        Right p -> (fromText p, 200)
        Left (displayException -> e) -> (case runPure $ writeError e of
                                             Right p -> fromText p
                                             Left  _ -> C8L.pack e, 500)
    where packLiteral l s =
              accursedUnutterablePerformIO $ unsafePackAddressLen l s
          fromText = C8L.fromStrict . T.encodeUtf8
          writeHtml = writeHtml5String defHtmlWriterOptions
          writeError = writeHtml . doc . para . singleton . Str
          defHtmlWriterOptions = def
              { writerTemplate = Just "<html>\\n<body>\\n$body$</body></html>" }
ngxExportHandler 'fromMd

toYesNo "0" = "No"
toYesNo "1" = "Yes"
toYesNo  _  = "Unknown"
ngxExportSS 'toYesNo

安装一下相关的依赖:

stack install pandoc

然后编译:

stack ghc -- -O2 -dynamic -shared -fPIC -L$(ghc --print-libdir)/rts -lHSrts_thr-ghc$(ghc --numeric-version) haskell.hs -o test.so
mkdir -p /root/nginx/modules
cp test.so /root/nginx/modules/

配置运行

vim /root/nginx/conf/nginx.conf

内容如下:

user                    nobody;
worker_processes        2;

events {
    worker_connections  1024;
}

http {
    default_type        application/octet-stream;
    sendfile            on;

    haskell load /root/nginx/modules/test.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 toUpper $hs_a $arg_a;
            echo "toUpper ($arg_a) = $hs_a";
            if ($arg_b) {
                haskell_run takeN $hs_a $arg_b $arg_a;
                echo "takeN ($arg_a, $arg_b) = $hs_a";
                break;
            }
            if ($arg_c) {
                haskell_run reverse $hs_a $arg_c;
                echo "reverse ($arg_c) = $hs_a";
                break;
            }
            if ($arg_d) {
                haskell_run matches $hs_a $arg_d $arg_a;
                haskell_run urlDecode $hs_b $arg_a;
                echo "matches ($arg_d, $hs_b) = $hs_a";
                break;
            }
            if ($arg_e) {
                haskell_run firstNotEmpty $hs_a $arg_f $arg_g $arg_a;
                echo "firstNotEmpty ($arg_f, $arg_g, $arg_a) = $hs_a";
                break;
            }
            if ($arg_l) {
                haskell_run isInList $hs_a $arg_a secret1 secret2 secret3;
                echo "isInList ($arg_a, <secret words>) = $hs_a";
                break;
            }
            if ($arg_m) {
                haskell_run isJSONListOfInts $hs_a $arg_m;
                haskell_run urlDecode $hs_b $arg_m;
                echo "isJSONListOfInts ($hs_b) = $hs_a";
                break;
            }
            if ($arg_n) {
                haskell_run jSONListOfIntsTakeN $hs_a $arg_take|$arg_n;
                haskell_run urlDecode $hs_b $arg_n;
                echo "jSONListOfIntsTakeN ($hs_b, $arg_take) = $hs_a";
                break;
            }
        }

        location /content {
            haskell_run isJSONListOfInts $hs_a $arg_n;
            haskell_run toYesNo $hs_b $hs_a;
            haskell_run jSONListOfIntsTakeN $hs_c $arg_take|$arg_n;
            haskell_run urlDecode $hs_d $arg_n;
            haskell_content fromMd "
## Do some JSON parsing

### Given ``$hs_d``

* Is this list of integer numbers?

    + *$hs_b*

* Take $arg_take elements

    + *``$hs_c``*
    ";

        }
    }
}

测试

$ curl 'http://localhost:8010/?a=hello_world'
toUpper (hello_world) = HELLO_WORLD
$ curl 'http://localhost:8010/?a=hello_world&b=4'
takeN (hello_world, 4) = hell
$ curl 'http://localhost:8010/?a=hello_world&b=oops'
takeN (hello_world, oops) = 
$ curl 'http://localhost:8010/?c=intelligence'
reverse (intelligence) = ecnegilletni
$ curl 'http://localhost:8010/?d=intelligence&a=%5Ei'              # URL-encoded ^i
matches (intelligence, ^i) = 1
$ curl 'http://localhost:8010/?d=intelligence&a=%5EI'              # URL-encoded ^I
matches (intelligence, ^I) = 0
$ curl 'http://localhost:8010/?e=1&g=intelligence&a=smart'
firstNotEmpty (, intelligence, smart) = intelligence
$ curl 'http://localhost:8010/?e=1&g=intelligence&f=smart'
firstNotEmpty (smart, intelligence, ) = smart
$ curl 'http://localhost:8010/?e=1'
firstNotEmpty (, , ) = 
$ curl 'http://localhost:8010/?l=1'
isInList (, <secret words>) = 0
$ curl 'http://localhost:8010/?l=1&a=s'
isInList (s, <secret words>) = 0
$ curl 'http://localhost:8010/?l=1&a=secret2'
isInList (secret2, <secret words>) = 1
$ curl 'http://localhost:8010/?m=%5B1%2C2%2C3%5D'                  # URL-encoded [1,2,3]
isJSONListOfInts ([1,2,3]) = 1
$ curl 'http://localhost:8010/?m=unknown'
isJSONListOfInts (unknown) = 0
$ curl 'http://localhost:8010/?n=%5B10%2C20%2C30%2C40%5D&take=3'   # URL-encoded [10,20,30,40]
jSONListOfIntsTakeN ([10,20,30,40], 3) = [10,20,30]
$ curl 'http://localhost:8010/?n=%5B10%2C20%2C30%2C40%5D&take=undefined'
jSONListOfIntsTakeN ([10,20,30,40], undefined) = []
$ curl -D- 'http://localhost:8010/content?n=%5B10%2C20%2C30%2C40%5D&take=3'
HTTP/1.1 200 OK
Server: nginx/1.8.0
Date: Fri, 04 Mar 2016 15:17:44 GMT
Content-Type: text/html
Content-Length: 323
Connection: keep-alive

<html>
<body>
<h2 id="do-some-json-parsing">Do some JSON parsing</h2>
<h3 id="given-10203040">Given <code>[10,20,30,40]</code></h3>
<ul>
<li><p>Is this list of integer numbers?</p>
<ul>
<li><em>Yes</em></li>
</ul></li>
<li><p>Take 3 elements</p>
<ul>
<li><em><code>[10,20,30]</code></em></li>
</ul></li>
</ul></body></html>

结语

到这儿我们已经把模块基本的东西给跑起来了。这只是个开始，有了他我们可以做很多事情，具体可以看看 README。