diff --git a/cabal.project b/cabal.project index db44c23..e4323ec 100644 --- a/cabal.project +++ b/cabal.project @@ -2,11 +2,12 @@ documentation: True tests: True jobs: $ncpus packages: + df1-html/ + df1-wai/ df1/ - di/ di-core/ di-df1/ di-handle/ di-monad/ - df1-html/ - df1-wai/ + di-wai/ + di/ diff --git a/di-wai/CHANGELOG.md b/di-wai/CHANGELOG.md new file mode 100644 index 0000000..642e9b1 --- /dev/null +++ b/di-wai/CHANGELOG.md @@ -0,0 +1,4 @@ +# Version 0.1 + +* Initial version. + diff --git a/di-wai/LICENSE.txt b/di-wai/LICENSE.txt new file mode 100644 index 0000000..5203ac6 --- /dev/null +++ b/di-wai/LICENSE.txt @@ -0,0 +1,30 @@ +Copyright (c) 2024, Renzo Carbonara + +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. + + * Neither the name of Renzo Carbonara nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"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 +OWNER OR CONTRIBUTORS 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. diff --git a/di-wai/README.md b/di-wai/README.md new file mode 100644 index 0000000..fac097a --- /dev/null +++ b/di-wai/README.md @@ -0,0 +1,3 @@ +# di-wai + +`di` logging of `wai` requests and responses. diff --git a/di-wai/default.nix b/di-wai/default.nix new file mode 100644 index 0000000..3da53c7 --- /dev/null +++ b/di-wai/default.nix @@ -0,0 +1,10 @@ +{ mkDerivation, base, df1-wai, di-df1, lib, vault, wai }: +mkDerivation { + pname = "di-wai"; + version = "0.1"; + src = ./.; + libraryHaskellDepends = [ base df1-wai di-df1 vault wai ]; + homepage = "https://github.com/k0001/di"; + description = "Di logging for WAI requests and responses"; + license = lib.licenses.bsd3; +} diff --git a/di-wai/di-wai.cabal b/di-wai/di-wai.cabal new file mode 100644 index 0000000..6f203d6 --- /dev/null +++ b/di-wai/di-wai.cabal @@ -0,0 +1,28 @@ +cabal-version: >=1.18 +name: di-wai +version: 0.1 +author: Renzo Carbonara +maintainer: renĪ»ren.zone +copyright: Renzo Carbonara 2024 +license: BSD3 +license-file: LICENSE.txt +extra-source-files: README.md CHANGELOG.md +category: Logging +build-type: Simple +synopsis: Di logging for WAI requests and responses +description: Di loggign for WAI requests and responses +homepage: https://github.com/k0001/di +bug-reports: https://github.com/k0001/di/issues + +library + hs-source-dirs: lib + default-language: GHC2021 + exposed-modules: Di.Wai + build-depends: + base >=4.9 && <5.0, + df1-wai, + di-df1, + vault, + wai + ghc-options: -Wall -O2 + diff --git a/di-wai/lib/Di/Wai.hs b/di-wai/lib/Di/Wai.hs new file mode 100644 index 0000000..394a65f --- /dev/null +++ b/di-wai/lib/Di/Wai.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +-- | This module is designed to be imported as follows: +-- +-- @ +-- import qualified "Di.Wai" +-- @ +module Di.Wai (middleware) where + +import Control.Monad.IO.Class +import Data.IORef +import Data.Vault.Lazy qualified as V +import Data.Word +import Data.Foldable +import Df1.Wai qualified +import Di.Df1 qualified +import Network.Wai qualified as Wai + +-- | Obtain a 'Wai.Middleware' that will log incomming 'Wai.Request's +-- and outgoing 'Wai.Response's. +-- +-- @ +-- do (__middleware__, __lookup__) <- "Di.Wai".'middleware' di +-- @ +-- +-- * The obtained @__middleware__@ shall be applied to your 'Wai.Application'. +-- +-- * The obtained @__lookup__@ function can be used to obtain the 'Di.Df1.Df1' +-- that includes 'Df1.Path' data about 'Wai.Request'. It returns 'Nothing' if +-- this particular @__middleware__@ was not used on the given 'Wai.Request'. +middleware + :: (MonadIO m) + => Di.Df1.Df1 + -> m (Wai.Middleware, Wai.Request -> Maybe Di.Df1.Df1) +middleware di0 = liftIO $ do + ref :: IORef Word64 <- newIORef 0 + vk :: V.Key Di.Df1.Df1 <- V.newKey + pure + ( \app req respond -> do + reqId <- atomicModifyIORef' ref $ \ol -> (ol + 1, ol) + let di1 = + foldl' + (\di (k, v) -> Di.Df1.attr k v di) + (Di.Df1.push "request" di0) + (("id", Di.Df1.value reqId) : Df1.Wai.request req) + Di.Df1.notice_ di1 "Request coming in" + app (req{Wai.vault = V.insert vk di1 (Wai.vault req)}) $ \res -> do + let di2 = + foldl' + (\di (k, v) -> Di.Df1.attr k v di) + (Di.Df1.push "response" di0) + (Df1.Wai.response res) + Di.Df1.notice_ di2 "Response going out" + respond res + , \req -> V.lookup vk (Wai.vault req) + ) diff --git a/flake.nix b/flake.nix index e1ca3e4..28e9b85 100644 --- a/flake.nix +++ b/flake.nix @@ -28,6 +28,7 @@ di-df1 = hsClean (hself.callPackage ./di-df1 { }); di-handle = hsClean (hself.callPackage ./di-handle { }); di-monad = hsClean (hself.callPackage ./di-monad { }); + di-wai = hsClean (hself.callPackage ./di-wai { }); }); }; }) @@ -50,11 +51,12 @@ config.packages.di-df1 config.packages.di-handle config.packages.di-monad + config.packages.di-wai config.devShells.ghc ]; }; inherit (pkgs.haskell.packages.ghc98) - df1 df1-html df1-wai di di-core di-df1 di-handle di-monad; + df1 df1-html df1-wai di di-core di-df1 di-handle di-monad di-wai; }; devShells = { default = config.devShells.ghc; @@ -68,6 +70,7 @@ p.di-df1 p.di-handle p.di-monad + p.di-wai ]; withHoogle = true; nativeBuildInputs =