ngx-export (empty) → 0.1.0.0
raw patch · 4 files changed
+304/−0 lines, 4 filesdep +basedep +bytestringdep +template-haskellsetup-changed
Dependencies added: base, bytestring, template-haskell
Files
- LICENSE +25/−0
- NgxExport.hs +256/−0
- Setup.hs +3/−0
- ngx-export.cabal +20/−0
+ LICENSE view
@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2016, 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:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ NgxExport.hs view
@@ -0,0 +1,256 @@+{-# LANGUAGE TemplateHaskell, ViewPatterns #-}++module NgxExport (module Foreign.C+ ,ngxExportSS+ ,ngxExportSSS+ ,ngxExportSLS+ ,ngxExportBS+ ,ngxExportBSS+ ,ngxExportBLS+ ,ngxExportYY+ ,ngxExportBY+ ,ngxExportHandler+ ,ngxExportDefHandler+ ,ngxExportUnsafeHandler) where++import Language.Haskell.TH+import Foreign.C+import Foreign.Ptr+import Foreign.Storable+import Foreign.Marshal.Alloc+import Foreign.Marshal.Utils+import System.IO.Error+import Control.Monad+import Data.Maybe+import qualified Data.ByteString as B+import qualified Data.ByteString.Unsafe as B+import qualified Data.ByteString.Lazy as L++ngxExport :: Name -> Name -> Q Type -> Name -> Q [Dec]+ngxExport e h t f = sequence+ [funD nameFt $ body [|exportType $ $eVar $fVar|],+ fmap (ForeignD . ExportF CCall ftName nameFt) [t|IO CInt|],+ funD nameF $ body [|$hVar $ $eVar $fVar|],+ fmap (ForeignD . ExportF CCall fName nameF) t+ ]+ where eVar = conE e+ hVar = varE h+ fVar = varE f+ fName = "ngx_hs_" ++ nameBase f+ nameF = mkName fName+ ftName = "type_" ++ fName+ nameFt = mkName ftName+ body b = [clause [] (normalB b) []]++ngxExportSS =+ ngxExport 'SS 'sS+ [t|CString -> CInt -> Ptr CString -> IO CInt|]+ngxExportSSS =+ ngxExport 'SSS 'sSS+ [t|CString -> CInt -> CString -> CInt -> Ptr CString -> IO CInt|]+ngxExportSLS =+ ngxExport 'SLS 'sLS+ [t|Ptr NgxStrType -> CInt -> Ptr CString -> IO CInt|]+ngxExportBS =+ ngxExport 'BS 'bS+ [t|CString -> CInt -> IO CUInt|]+ngxExportBSS =+ ngxExport 'BSS 'bSS+ [t|CString -> CInt -> CString -> CInt -> IO CUInt|]+ngxExportBLS =+ ngxExport 'BLS 'bLS+ [t|Ptr NgxStrType -> CInt -> IO CUInt|]+ngxExportYY =+ ngxExport 'YY 'yY+ [t|CString -> CInt -> Ptr CString -> IO CInt|]+ngxExportBY =+ ngxExport 'BY 'bY+ [t|CString -> CInt -> IO CUInt|]+ngxExportHandler =+ ngxExport 'Handler 'handler+ [t|CString -> CInt ->+ Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr CString -> Ptr CSize -> IO CInt|]+ngxExportDefHandler =+ ngxExport 'YY 'defHandler+ [t|CString -> CInt -> Ptr (Ptr NgxStrType) -> IO CInt|]+ngxExportUnsafeHandler =+ ngxExport 'UnsafeHandler 'unsafeHandler+ [t|CString -> CInt ->+ Ptr CString -> Ptr CSize -> Ptr CString -> Ptr CSize -> IO CInt|]++data NgxExport = SS (String -> String)+ | SSS (String -> String -> String)+ | SLS ([String] -> String)+ | BS (String -> Bool)+ | BSS (String -> String -> Bool)+ | BLS ([String] -> Bool)+ | YY (B.ByteString -> L.ByteString)+ | BY (B.ByteString -> Bool)+ | Handler (B.ByteString -> (L.ByteString, String, Int))+ | UnsafeHandler (B.ByteString ->+ (B.ByteString, B.ByteString, Int))++instance Enum NgxExport where+ toEnum _ = SS id -- not used+ fromEnum (SS _) = 1+ fromEnum (SSS _) = 2+ fromEnum (SLS _) = 3+ fromEnum (BS _) = 4+ fromEnum (BSS _) = 5+ fromEnum (BLS _) = 6+ fromEnum (YY _) = 7+ fromEnum (BY _) = 8+ fromEnum (Handler _) = 9+ fromEnum (UnsafeHandler _) = 10++exportType :: NgxExport -> IO CInt+exportType = return . fromIntegral . fromEnum++data NgxStrType = NgxStrType CSize CString++instance Storable NgxStrType where+ alignment _ = max (alignment (undefined :: CSize))+ (alignment (undefined :: CString))+ sizeOf = (* 2) . alignment -- must always be correct for+ -- aligned struct ngx_str_t+ peek p = do+ n <- peekByteOff p 0+ s <- peekByteOff p $ alignment (undefined :: NgxStrType)+ return $ NgxStrType n s+ poke p a@(NgxStrType n s) = do+ poke (castPtr p) n+ poke (plusPtr p $ alignment a) s++catchAlloc :: IO (Ptr a) -> IO (Ptr a)+catchAlloc = (`catchIOError` const (return nullPtr))++peekNgxStringArrayLen :: Ptr NgxStrType -> Int -> IO [String]+peekNgxStringArrayLen x n = sequence $+ foldr (\k ->+ ((peekElemOff x k >>=+ (\(NgxStrType (fromIntegral -> m) y) ->+ peekCStringLen (y, m))) :)) [] [0 .. n - 1]++pokeCStringLen :: CString -> CSize -> Ptr CString -> Ptr CSize -> IO ()+pokeCStringLen x n p s = poke p x >> poke s n++toSingleBuffer :: L.ByteString -> IO (Maybe (CString, Int))+toSingleBuffer (L.uncons -> Nothing) =+ return $ Just (nullPtr, 0)+toSingleBuffer s = do+ let (fromIntegral -> l) = L.length s+ t <- catchAlloc $ mallocBytes l+ if t /= nullPtr+ then do+ void $ L.foldlChunks+ (\a s -> do+ off <- a+ let l = B.length s+ B.unsafeUseAsCString s $ flip (copyBytes $ plusPtr t off) l+ return $ off + l+ ) (return 0) s+ return $ Just (t, l)+ else return Nothing++toBuffers :: L.ByteString -> IO (Maybe (Ptr NgxStrType, Int))+toBuffers (L.uncons -> Nothing) =+ return $ Just (nullPtr, 0)+toBuffers s = do+ t <- catchAlloc $ mallocBytes $+ L.foldlChunks (const . succ) 0 s * sizeOf (undefined :: NgxStrType)+ l <- L.foldlChunks+ (\a s -> do+ off <- a+ maybe (return Nothing)+ (\off -> do+ let l = B.length s+ -- l cannot be zero at this point+ dst <- catchAlloc $ mallocBytes l+ if dst /= nullPtr+ then do+ B.unsafeUseAsCString s $ flip (copyBytes dst) l+ pokeElemOff t off $ NgxStrType (fromIntegral l) dst+ return $ Just $ off + 1+ else do+ mapM_+ (peekElemOff t >=> \(NgxStrType _ x) -> free x)+ [0 .. off - 1] -- [0 .. -1] makes [], so wise!+ free t+ return Nothing+ ) off+ ) (return $ if t /= nullPtr then Just 0 else Nothing) s+ return $ l >>= Just . (,) t++sS :: NgxExport -> CString -> CInt -> Ptr CString -> IO CInt+sS (SS f) x (fromIntegral -> n) p = do+ (s, fromIntegral -> l) <- f <$> peekCStringLen (x, n)+ >>= newCStringLen+ poke p s+ return l++sSS :: NgxExport -> CString -> CInt -> CString -> CInt -> Ptr CString -> IO CInt+sSS (SSS f) x (fromIntegral -> n) y (fromIntegral -> m) p = do+ (s, fromIntegral -> l) <- f <$> peekCStringLen (x, n)+ <*> peekCStringLen (y, m)+ >>= newCStringLen+ poke p s+ return l++sLS :: NgxExport -> Ptr NgxStrType -> CInt -> Ptr CString -> IO CInt+sLS (SLS f) x (fromIntegral -> n) p = do+ (s, fromIntegral -> l) <- f <$> peekNgxStringArrayLen x n+ >>= newCStringLen+ poke p s+ return l++yY :: NgxExport -> CString -> CInt -> Ptr CString -> IO CInt+yY (YY f) x (fromIntegral -> n) p = do+ s <- f <$> B.unsafePackCStringLen (x, n)+ (fromMaybe (nullPtr, -1) -> (t, fromIntegral -> l)) <- toSingleBuffer s+ poke p t+ return l++bS :: NgxExport -> CString -> CInt -> IO CUInt+bS (BS f) x (fromIntegral -> n) =+ fromBool . f <$> peekCStringLen (x, n)++bSS :: NgxExport -> CString -> CInt -> CString -> CInt -> IO CUInt+bSS (BSS f) x (fromIntegral -> n) y (fromIntegral -> m) =+ (fromBool .) . f <$> peekCStringLen (x, n)+ <*> peekCStringLen (y, m)++bLS :: NgxExport -> Ptr NgxStrType -> CInt -> IO CUInt+bLS (BLS f) x (fromIntegral -> n) =+ fromBool . f <$> peekNgxStringArrayLen x n++bY :: NgxExport -> CString -> CInt -> IO CUInt+bY (BY f) x (fromIntegral -> n) =+ fromBool . f <$> B.unsafePackCStringLen (x, n)++handler :: NgxExport -> CString -> CInt ->+ Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr CString -> Ptr CSize -> IO CInt+handler (Handler f) x (fromIntegral -> n) ps pls pt plt = do+ (s, mt, fromIntegral -> st) <- f <$> B.unsafePackCStringLen (x, n)+ (fromMaybe (nullPtr, -1) -> (t, fromIntegral -> l)) <- toBuffers s+ poke ps t+ poke pls l+ (smt, fromIntegral -> lmt) <- newCStringLen mt+ pokeCStringLen smt lmt pt plt+ return st++defHandler :: NgxExport -> CString -> CInt -> Ptr (Ptr NgxStrType) -> IO CInt+defHandler (YY f) x (fromIntegral -> n) ps = do+ s <- f <$> B.unsafePackCStringLen (x, n)+ (fromMaybe (nullPtr, -1) -> (t, fromIntegral -> l)) <- toBuffers s+ poke ps t+ return l++unsafeHandler :: NgxExport -> CString -> CInt ->+ Ptr CString -> Ptr CSize -> Ptr CString -> Ptr CSize -> IO CInt+unsafeHandler (UnsafeHandler f) x (fromIntegral -> n) ps pls pt plt = do+ (s, mt, fromIntegral -> st) <- f <$> B.unsafePackCStringLen (x, n)+ (t, fromIntegral -> lt) <- B.unsafeUseAsCStringLen s return+ pokeCStringLen t lt ps pls+ (smt, fromIntegral -> lmt) <- B.unsafeUseAsCStringLen mt return+ pokeCStringLen smt lmt pt plt+ return st
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple+main = defaultMain+
+ ngx-export.cabal view
@@ -0,0 +1,20 @@+name: ngx-export+version: 0.1.0.0+synopsis: Export custom haskell functions into nginx configuration+description: Please see README.md+homepage: http://github.com/lyokha/nginx-haskell-module+license: BSD3+license-file: LICENSE+author: Alexey Radkov <alexey.radkov@gmail.com>+maintainer: Alexey Radkov <alexey.radkov@gmail.com>+copyright: 2016 Alexey Radkov+category: Unclassified+build-type: Simple+cabal-version: >= 1.8++library+ build-depends: base >= 4.7 && < 5+ , template-haskell+ , bytestring >= 0.10.0.0+ exposed-modules: NgxExport+