ngx-export 1.5.0 → 1.6.0
raw patch · 3 files changed
+86/−54 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Changelog.md +8/−2
- NgxExport.hs +77/−51
- ngx-export.cabal +1/−1
Changelog.md view
@@ -1,7 +1,13 @@+### 1.6.0++- Implemented type and role disambiguation helper to prevent segfaults in+ Nginx when a handler of an appropriate type (say, IOYY with a role of a+ synchronous handler) gets used in a wrong role (say, as an async handler).+ ### 1.5.0 -- Services are now terminated with `cancelWith ThreadKilled` because `cancel`- throws `AsyncCancelled` starting from version *async-2.2*.+- Services are now terminated with *cancelWith ThreadKilled* because *cancel*+ throws *AsyncCancelled* starting from *async-2.2*. ### 1.4.2
NgxExport.hs view
@@ -48,7 +48,7 @@ ,ngxUpstreamMainConfPtr ,ngxCachedTimePtr -- * Re-exported data constructors from /Foreign.C/- -- (for marshalling in foreign calls)+ -- | Re-exports are needed by exporters for marshalling in foreign calls. ,Foreign.C.CInt (..) ,Foreign.C.CUInt (..) ) where@@ -137,40 +137,66 @@ | AsyncHandlerRB (L.ByteString -> B.ByteString -> IO ContentHandlerResult) -let name = mkName "exportType" in do- TyConI (DataD _ _ _ EXTRA_WILDCARD_BEFORE_CON cs _) <- reify ''NgxExport- let cons = map (\(NormalC con [(_, typ)]) -> (con, typ)) cs- sequence $- [sigD name [t|NgxExport -> IO CInt|],- funD name $- map (\(fst -> c, i) ->- clause [conP c [wildP]] (normalB [|return i|]) [])- (zip cons [1 ..] :: [((Name, Type), Int)])- ] ++ map (\(c, t) -> tySynD (mkName $ nameBase c) [] $ return t) cons+data NgxExportDisambiguation = Unambiguous+ | YYSync+ | YYDefHandler+ | IOYYSync+ | IOYYAsync -ngxExport' :: (Name -> Q Exp) -> Name -> Name -> Q Type -> Name -> Q [Dec]-ngxExport' m e h t f = sequence- [sigD nameFt typeFt,- funD nameFt $ body [|exportType $cefVar|],- ForeignD . ExportF CCall ftName nameFt <$> typeFt,- sigD nameF t,- funD nameF $ body [|$hVar $efVar|],- ForeignD . ExportF CCall fName nameF <$> t+$(do+ TyConI (DataD _ _ _ EXTRA_WILDCARD_BEFORE_CON tCs _) <-+ reify ''NgxExport+ TyConI (DataD _ _ _ EXTRA_WILDCARD_BEFORE_CON aCs _) <-+ reify ''NgxExportDisambiguation+ let tName = mkName "exportType"+ aName = mkName "exportTypeAmbiguity"+ tCons = map (\(NormalC con [(_, typ)]) -> (con, typ)) tCs+ aCons = map (\(NormalC con []) -> con) aCs+ sequence $+ [sigD tName [t|NgxExport -> IO CInt|]+ ,funD tName $+ map (\(fst -> c, i) ->+ clause [conP c [wildP]] (normalB [|return i|]) []+ ) (zip tCons [1 ..] :: [((Name, Type), Int)])+ ,sigD aName [t|NgxExportDisambiguation -> IO CInt|]+ ,funD aName $+ map (\(c, i) ->+ clause [conP c []] (normalB [|return i|]) []+ ) (zip aCons [0 ..] :: [(Name, Int)])+ ]+ +++ map (\(c, t) -> tySynD (mkName $ nameBase c) [] $ return t) tCons+ )++ngxExport' :: (Name -> Q Exp) ->+ Name -> Name -> Name -> Q Type -> Name -> Q [Dec]+ngxExport' m e a h t f = sequence+ [sigD nameFt typeFt+ ,funD nameFt $ body [|exportType $cefVar|]+ ,ForeignD . ExportF CCall ftName nameFt <$> typeFt+ ,sigD nameFta typeFta+ ,funD nameFta $ body [|exportTypeAmbiguity $(conE a)|]+ ,ForeignD . ExportF CCall ftaName nameFta <$> typeFta+ ,sigD nameF t+ ,funD nameF $ body [|$(varE h) $efVar|]+ ,ForeignD . ExportF CCall fName nameF <$> t ]- where hVar = varE h- efVar = m f- cefVar = conE e `appE` efVar- fName = "ngx_hs_" ++ nameBase f- nameF = mkName fName- ftName = "type_" ++ fName- nameFt = mkName ftName- typeFt = [t|IO CInt|]- body b = [clause [] (normalB b) []]+ where efVar = m f+ cefVar = conE e `appE` efVar+ fName = "ngx_hs_" ++ nameBase f+ nameF = mkName fName+ ftName = "type_" ++ fName+ nameFt = mkName ftName+ typeFt = [t|IO CInt|]+ ftaName = "ambiguity_" ++ fName+ nameFta = mkName ftaName+ typeFta = [t|IO CInt|]+ body b = [clause [] (normalB b) []] -ngxExport :: Name -> Name -> Q Type -> Name -> Q [Dec]+ngxExport :: Name -> Name -> Name -> Q Type -> Name -> Q [Dec] ngxExport = ngxExport' varE -ngxExportC :: Name -> Name -> Q Type -> Name -> Q [Dec]+ngxExportC :: Name -> Name -> Name -> Q Type -> Name -> Q [Dec] ngxExportC = ngxExport' $ infixE (Just $ varE 'const) (varE '(.)) . Just . varE -- | Exports a function of type@@ -182,7 +208,7 @@ -- for using in directive __/haskell_run/__. ngxExportSS :: Name -> Q [Dec] ngxExportSS =- ngxExport 'SS 'sS+ ngxExport 'SS 'Unambiguous 'sS [t|CString -> CInt -> Ptr CString -> Ptr CInt -> IO CUInt|] @@ -195,7 +221,7 @@ -- for using in directive __/haskell_run/__. ngxExportSSS :: Name -> Q [Dec] ngxExportSSS =- ngxExport 'SSS 'sSS+ ngxExport 'SSS 'Unambiguous 'sSS [t|CString -> CInt -> CString -> CInt -> Ptr CString -> Ptr CInt -> IO CUInt|] @@ -208,7 +234,7 @@ -- for using in directive __/haskell_run/__. ngxExportSLS :: Name -> Q [Dec] ngxExportSLS =- ngxExport 'SLS 'sLS+ ngxExport 'SLS 'Unambiguous 'sLS [t|Ptr NgxStrType -> CInt -> Ptr CString -> Ptr CInt -> IO CUInt|] @@ -221,7 +247,7 @@ -- for using in directive __/haskell_run/__. ngxExportBS :: Name -> Q [Dec] ngxExportBS =- ngxExport 'BS 'bS+ ngxExport 'BS 'Unambiguous 'bS [t|CString -> CInt -> Ptr CString -> Ptr CInt -> IO CUInt|] @@ -234,7 +260,7 @@ -- for using in directive __/haskell_run/__. ngxExportBSS :: Name -> Q [Dec] ngxExportBSS =- ngxExport 'BSS 'bSS+ ngxExport 'BSS 'Unambiguous 'bSS [t|CString -> CInt -> CString -> CInt -> Ptr CString -> Ptr CInt -> IO CUInt|] @@ -247,7 +273,7 @@ -- for using in directive __/haskell_run/__. ngxExportBLS :: Name -> Q [Dec] ngxExportBLS =- ngxExport 'BLS 'bLS+ ngxExport 'BLS 'Unambiguous 'bLS [t|Ptr NgxStrType -> CInt -> Ptr CString -> Ptr CInt -> IO CUInt|] @@ -260,7 +286,7 @@ -- for using in directive __/haskell_run/__. ngxExportYY :: Name -> Q [Dec] ngxExportYY =- ngxExport 'YY 'yY+ ngxExport 'YY 'YYSync 'yY [t|CString -> CInt -> Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr (StablePtr L.ByteString) -> IO CUInt|]@@ -274,7 +300,7 @@ -- for using in directive __/haskell_run/__. ngxExportBY :: Name -> Q [Dec] ngxExportBY =- ngxExport 'BY 'bY+ ngxExport 'BY 'Unambiguous 'bY [t|CString -> CInt -> Ptr CString -> Ptr CInt -> IO CUInt|] @@ -287,7 +313,7 @@ -- for using in directive __/haskell_run/__. ngxExportIOYY :: Name -> Q [Dec] ngxExportIOYY =- ngxExportC 'IOYY 'ioyY+ ngxExportC 'IOYY 'IOYYSync 'ioyY [t|CString -> CInt -> Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr (StablePtr L.ByteString) -> IO CUInt|]@@ -301,7 +327,7 @@ -- for using in directive __/haskell_run_async/__. ngxExportAsyncIOYY :: Name -> Q [Dec] ngxExportAsyncIOYY =- ngxExportC 'IOYY 'asyncIOYY+ ngxExportC 'IOYY 'IOYYAsync 'asyncIOYY [t|CString -> CInt -> CInt -> CInt -> Ptr CUInt -> CUInt -> CUInt -> Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr CUInt -> Ptr (StablePtr L.ByteString) -> IO (StablePtr (Async ()))|]@@ -318,7 +344,7 @@ -- request body. ngxExportAsyncOnReqBody :: Name -> Q [Dec] ngxExportAsyncOnReqBody =- ngxExport 'IOYYY 'asyncIOYYY+ ngxExport 'IOYYY 'Unambiguous 'asyncIOYYY [t|Ptr NgxStrType -> Ptr NgxStrType -> CInt -> CString -> CInt -> CInt -> CUInt -> Ptr (Ptr NgxStrType) -> Ptr CInt ->@@ -337,7 +363,7 @@ -- being run for the first time. ngxExportServiceIOYY :: Name -> Q [Dec] ngxExportServiceIOYY =- ngxExport 'IOYY 'asyncIOYY+ ngxExport 'IOYY 'IOYYAsync 'asyncIOYY [t|CString -> CInt -> CInt -> CInt -> Ptr CUInt -> CUInt -> CUInt -> Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr CUInt -> Ptr (StablePtr L.ByteString) -> IO (StablePtr (Async ()))|]@@ -352,7 +378,7 @@ -- __/haskell_static_content/__. ngxExportHandler :: Name -> Q [Dec] ngxExportHandler =- ngxExport 'Handler 'handler+ ngxExport 'Handler 'Unambiguous 'handler [t|CString -> CInt -> Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr CString -> Ptr CSize -> Ptr (StablePtr B.ByteString) -> Ptr CInt -> Ptr (StablePtr L.ByteString) -> IO CUInt|]@@ -367,7 +393,7 @@ -- __/haskell_static_content/__. ngxExportDefHandler :: Name -> Q [Dec] ngxExportDefHandler =- ngxExport 'YY 'defHandler+ ngxExport 'YY 'YYDefHandler 'defHandler [t|CString -> CInt -> Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr CString -> Ptr (StablePtr L.ByteString) -> IO CUInt|]@@ -381,7 +407,7 @@ -- for using in directive __/haskell_unsafe_content/__. ngxExportUnsafeHandler :: Name -> Q [Dec] ngxExportUnsafeHandler =- ngxExport 'UnsafeHandler 'unsafeHandler+ ngxExport 'UnsafeHandler 'Unambiguous 'unsafeHandler [t|CString -> CInt -> Ptr CString -> Ptr CSize -> Ptr CString -> Ptr CSize -> Ptr CInt -> IO CUInt|] @@ -394,7 +420,7 @@ -- for using in directive __/haskell_async_content/__. ngxExportAsyncHandler :: Name -> Q [Dec] ngxExportAsyncHandler =- ngxExport 'AsyncHandler 'asyncHandler+ ngxExport 'AsyncHandler 'Unambiguous 'asyncHandler [t|CString -> CInt -> CInt -> CUInt -> Ptr CString -> Ptr CSize -> Ptr (StablePtr B.ByteString) -> Ptr CInt -> Ptr (Ptr NgxStrType) -> Ptr CInt ->@@ -412,7 +438,7 @@ -- request body. ngxExportAsyncHandlerOnReqBody :: Name -> Q [Dec] ngxExportAsyncHandlerOnReqBody =- ngxExport 'AsyncHandlerRB 'asyncHandlerRB+ ngxExport 'AsyncHandlerRB 'Unambiguous 'asyncHandlerRB [t|Ptr NgxStrType -> Ptr NgxStrType -> CInt -> CString -> CInt -> CInt -> CUInt -> Ptr CString -> Ptr CSize -> Ptr (StablePtr B.ByteString) -> Ptr CInt ->@@ -429,7 +455,7 @@ -- __/haskell_service_update_hook/__. ngxExportServiceHook :: Name -> Q [Dec] ngxExportServiceHook =- ngxExportC 'IOYY 'ioyYWithFree+ ngxExportC 'IOYY 'IOYYSync 'ioyYWithFree [t|CString -> CInt -> Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr (StablePtr L.ByteString) -> IO CUInt|]@@ -863,7 +889,7 @@ (take n $ versionBranch version) -- | Returns an opaque pointer to the Nginx /cycle object/--- for using it in C plugins.+-- for using it in C plugins. -- -- Actual type of the returned pointer is --@@ -874,7 +900,7 @@ ngxCyclePtr = readIORef ngxCyclePtrStore -- | Returns an opaque pointer to the Nginx /upstream main configuration/--- for using it in C plugins.+-- for using it in C plugins. -- -- Actual type of the returned pointer is --@@ -889,7 +915,7 @@ ngxUpstreamMainConfPtr = readIORef ngxUpstreamMainConfPtrStore -- | Returns an opaque pointer to the Nginx /cached time object/--- for using it in C plugins.+-- for using it in C plugins. -- -- Actual type of the returned pointer is --
ngx-export.cabal view
@@ -1,5 +1,5 @@ name: ngx-export-version: 1.5.0+version: 1.6.0 synopsis: Helper module for Nginx haskell module description: Helper module for <http://github.com/lyokha/nginx-haskell-module Nginx haskell module>