diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,10 @@ +### 1.0 + +- Added an asynchronous content handler exported with *ngxExportAsyncHandler*. +- Content type in all content handlers gets packed in a strict bytestring now, + which allows for using static strings without dynamic memory allocation. +- Package stability tag was promoted to stable. + ### 0.9.1.1 - yY handler must be strict against exceptions in safeYYHandler. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,7 +1,7 @@ The following license covers this documentation, and the source code, except where otherwise indicated. -Copyright 2016-2017, Alexey Radkov. All rights reserved. +Copyright 2016-2018, Alexey Radkov. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: diff --git a/NgxExport.hs b/NgxExport.hs --- a/NgxExport.hs +++ b/NgxExport.hs @@ -4,11 +4,11 @@ ----------------------------------------------------------------------------- -- | -- Module : NgxExport --- Copyright : (c) Alexey Radkov 2016-2017 +-- Copyright : (c) Alexey Radkov 2016-2018 -- License : BSD-style -- -- Maintainer : alexey.radkov@gmail.com --- Stability : experimental +-- Stability : stable -- Portability : non-portable (requires POSIX) -- -- Export regular haskell functions for using in directives of @@ -33,6 +33,7 @@ ,ngxExportHandler ,ngxExportDefHandler ,ngxExportUnsafeHandler + ,ngxExportAsyncHandler -- * Re-exported data constructors from /"Foreign.C"/ -- (for marshalling in foreign calls) ,Foreign.C.CInt (..) @@ -91,6 +92,9 @@ {-# COMPLETE ToBool :: CUInt #-} #endif +type ContentHandlerData = (L.ByteString, B.ByteString, Int) +type UnsafeContentHandlerData = (B.ByteString, B.ByteString, Int) + data NgxExport = SS (String -> String) | SSS (String -> String -> String) | SLS ([String] -> String) @@ -101,9 +105,9 @@ | BY (B.ByteString -> Bool) | IOYY (B.ByteString -> Bool -> IO L.ByteString) | IOYYY (L.ByteString -> B.ByteString -> IO L.ByteString) - | Handler (B.ByteString -> (L.ByteString, String, Int)) - | UnsafeHandler (B.ByteString -> - (B.ByteString, B.ByteString, Int)) + | Handler (B.ByteString -> ContentHandlerData) + | UnsafeHandler (B.ByteString -> UnsafeContentHandlerData) + | AsyncHandler (B.ByteString -> IO ContentHandlerData) let name = mkName "exportType" in do TyConI (DataD _ _ _ EXTRA_WILDCARD_BEFORE_CON cs _) <- reify ''NgxExport @@ -261,7 +265,7 @@ Ptr CUInt -> Ptr (StablePtr L.ByteString) -> IO (StablePtr (Async ()))|] -- | Exports a function of type --- /'B.ByteString' -> ('L.ByteString', 'String', 'Int')/ +-- /'B.ByteString' -> ('L.ByteString', 'B.ByteString', 'Int')/ -- for using in directives /haskell_content/ and /haskell_static_content/. -- -- The first element in the returned /3-tuple/ of the exported function is @@ -271,7 +275,7 @@ ngxExportHandler = ngxExport 'Handler 'handler [t|CString -> CInt -> Ptr (Ptr NgxStrType) -> Ptr CInt -> - Ptr CString -> Ptr CSize -> Ptr CInt -> + Ptr CString -> Ptr CSize -> Ptr (StablePtr B.ByteString) -> Ptr CInt -> Ptr (StablePtr L.ByteString) -> IO CUInt|] -- | Exports a function of type @@ -299,6 +303,21 @@ [t|CString -> CInt -> Ptr CString -> Ptr CSize -> Ptr CString -> Ptr CSize -> Ptr CInt -> IO CUInt|] +-- | Exports a function of type +-- /'B.ByteString' -> IO ('L.ByteString', 'B.ByteString', 'Int')/ +-- for using in directive /haskell_async_content/. +-- +-- The first element in the returned /3-tuple/ of the exported function is +-- the /content/, the second is the /content type/, and the third is the +-- /HTTP status/. +ngxExportAsyncHandler :: Name -> Q [Dec] +ngxExportAsyncHandler = + ngxExport 'AsyncHandler 'asyncHandler + [t|CString -> CInt -> CInt -> CUInt -> + Ptr CString -> Ptr CSize -> Ptr (StablePtr B.ByteString) -> Ptr CInt -> + Ptr (Ptr NgxStrType) -> Ptr CInt -> + Ptr CUInt -> Ptr (StablePtr L.ByteString) -> IO (StablePtr (Async ()))|] + data NgxStrType = NgxStrType CSize CString instance Storable NgxStrType where @@ -383,6 +402,12 @@ when (l /= 1) (poke p t) >> poke pl l when (t /= nullPtr) $ newStablePtr s >>= poke spd +pokeContentTypeAndStatus :: B.ByteString -> + Ptr CString -> Ptr CSize -> Ptr CInt -> CInt -> IO () +pokeContentTypeAndStatus ct pct plct pst st = do + PtrLen sct lct <- B.unsafeUseAsCStringLen ct return + pokeCStringLen sct lct pct plct >> poke pst st + safeHandler :: Ptr CString -> Ptr CInt -> IO CUInt -> IO CUInt safeHandler p pl = handle $ \e -> do PtrLen x l <- safeNewCStringLen $ show (e :: SomeException) @@ -458,7 +483,7 @@ asyncIOFlag8b :: B.ByteString asyncIOFlag8b = L.toStrict $ runPut $ putInt64host 1 -asyncIOCommon :: IO (C8L.ByteString, Bool) -> +asyncIOCommon :: IO (L.ByteString, Bool) -> CInt -> Bool -> Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr CUInt -> Ptr (StablePtr L.ByteString) -> IO (StablePtr (Async ())) asyncIOCommon a (I fd) efd p pl pr spd = @@ -509,7 +534,7 @@ ] else return False if exiting - then return (C8L.empty, True) + then return (L.empty, True) else do x' <- B.unsafePackCStringLen (x, n) flip (,) False <$> f x' fstRun @@ -526,6 +551,21 @@ flip (,) False <$> f b' x' ) fd efd +asyncHandler :: AsyncHandler -> CString -> CInt -> + CInt -> CUInt -> + Ptr CString -> Ptr CSize -> Ptr (StablePtr B.ByteString) -> Ptr CInt -> + Ptr (Ptr NgxStrType) -> Ptr CInt -> + Ptr CUInt -> Ptr (StablePtr L.ByteString) -> IO (StablePtr (Async ())) +asyncHandler f x (I n) fd (ToBool efd) pct plct spct pst = + asyncIOCommon + (do + x' <- B.unsafePackCStringLen (x, n) + (s, ct, I st) <- f x' + (return $! s) >> pokeContentTypeAndStatus ct pct plct pst st + newStablePtr ct >>= poke spct + return (s, False) + ) fd efd + bS :: BS -> CString -> CInt -> Ptr CString -> Ptr CInt -> IO CUInt bS f x (I n) p pl = @@ -560,14 +600,14 @@ return r handler :: Handler -> CString -> CInt -> Ptr (Ptr NgxStrType) -> Ptr CInt -> - Ptr CString -> Ptr CSize -> Ptr CInt -> + Ptr CString -> Ptr CSize -> Ptr (StablePtr B.ByteString) -> Ptr CInt -> Ptr (StablePtr L.ByteString) -> IO CUInt -handler f x (I n) p pl pct plct pst spd = +handler f x (I n) p pl pct plct spct pst spd = safeHandler pct pst $ do (s, ct, I st) <- f <$> B.unsafePackCStringLen (x, n) - PtrLen sct lct <- newCStringLen ct - pokeCStringLen sct lct pct plct >> poke pst st + pokeContentTypeAndStatus ct pct plct pst st pokeLazyByteString s p pl spd + newStablePtr ct >>= poke spct return 0 defHandler :: YY -> CString -> CInt -> @@ -584,8 +624,7 @@ unsafeHandler f x (I n) p pl pct plct pst = safeHandler pct pst $ do (s, ct, I st) <- f <$> B.unsafePackCStringLen (x, n) - PtrLen sct lct <- B.unsafeUseAsCStringLen ct return - pokeCStringLen sct lct pct plct >> poke pst st + pokeContentTypeAndStatus ct pct plct pst st PtrLen t l <- B.unsafeUseAsCStringLen s return pokeCStringLen t l p pl return 0 diff --git a/ngx-export.cabal b/ngx-export.cabal --- a/ngx-export.cabal +++ b/ngx-export.cabal @@ -1,5 +1,5 @@ name: ngx-export -version: 0.9.1.2 +version: 1.0 synopsis: Helper module for Nginx haskell module description: Helper module for @@ -9,8 +9,8 @@ extra-source-files: Changelog.md author: Alexey Radkov maintainer: Alexey Radkov -stability: experimental -copyright: 2016-2017 Alexey Radkov +stability: stable +copyright: 2016-2018 Alexey Radkov category: Network build-type: Simple cabal-version: >= 1.8