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。
