di-wai

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/

di-wai/CHANGELOG.md

@@ -0,0 +1,4 @@
+# Version 0.1
+
+* Initial version.
+

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.

di-wai/README.md

@@ -0,0 +1,3 @@
+# di-wai
+
+`di` logging of `wai` requests and responses.

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;
+}

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
+

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)
+      )

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 =