From 0b2f032ac56eba11d84cffec5f920480ea13fb7a Mon Sep 17 00:00:00 2001 From: Anton Kholomiov Date: Thu, 19 Oct 2023 14:00:49 +0300 Subject: [PATCH 1/3] Rename Middleware to Plugin --- examples/mig-example-apps/Html/src/Server.hs | 2 +- examples/mig-example-apps/JsonApi/Server.hs | 6 +- examples/mig-example-apps/RouteArgs/Main.hs | 4 +- .../mig-example-apps/mig-example-apps.cabal | 330 ++++++++---------- mig-client/mig-client.cabal | 49 ++- mig-extra/mig-extra.cabal | 57 ++- .../Mig/Extra/{Middleware => Plugin}/Auth.hs | 6 +- .../Extra/{Middleware => Plugin}/Exception.hs | 8 +- .../Mig/Extra/{Middleware => Plugin}/Trace.hs | 20 +- mig-extra/src/Mig/Extra/Server/Common.hs | 10 +- mig-extra/src/Mig/Extra/Server/Json.hs | 8 +- mig-rio/mig-rio.cabal | 29 +- mig-server/mig-server.cabal | 155 ++++---- mig-server/src/Mig.hs | 10 +- mig-swagger-ui/mig-swagger-ui.cabal | 70 ++-- mig-wai/mig-wai.cabal | 39 +-- mig/mig.cabal | 95 +++-- mig/src/Mig/Core/Class.hs | 2 +- mig/src/Mig/Core/Class/Middleware.hs | 226 ------------ mig/src/Mig/Core/Class/Plugin.hs | 226 ++++++++++++ 20 files changed, 638 insertions(+), 714 deletions(-) rename mig-extra/src/Mig/Extra/{Middleware => Plugin}/Auth.hs (74%) rename mig-extra/src/Mig/Extra/{Middleware => Plugin}/Exception.hs (77%) rename mig-extra/src/Mig/Extra/{Middleware => Plugin}/Trace.hs (93%) delete mode 100644 mig/src/Mig/Core/Class/Middleware.hs create mode 100644 mig/src/Mig/Core/Class/Plugin.hs diff --git a/examples/mig-example-apps/Html/src/Server.hs b/examples/mig-example-apps/Html/src/Server.hs index 2f892b3..c7ef0a2 100644 --- a/examples/mig-example-apps/Html/src/Server.hs +++ b/examples/mig-example-apps/Html/src/Server.hs @@ -60,7 +60,7 @@ server site = ] logRoutes :: Server IO -> Server IO - logRoutes = applyMiddleware $ \(PathInfo path) -> prependServerAction $ + logRoutes = applyPlugin $ \(PathInfo path) -> prependServerAction $ when (path /= ["favicon.ico"] && headMay path /= Just "static") $ do logRoute site (Text.intercalate "/" path) diff --git a/examples/mig-example-apps/JsonApi/Server.hs b/examples/mig-example-apps/JsonApi/Server.hs index 17ed4b5..5ba2ad9 100644 --- a/examples/mig-example-apps/JsonApi/Server.hs +++ b/examples/mig-example-apps/JsonApi/Server.hs @@ -8,7 +8,7 @@ import Control.Monad import Data.Text qualified as Text import Data.Text.Lazy.Encoding qualified as Text import Data.Time -import Mig.Extra.Middleware.Trace qualified as Trace +import Mig.Extra.Plugin.Trace qualified as Trace import Mig.Json.IO import Interface @@ -32,7 +32,7 @@ server env = , "update" /. updateWeather env ] - withTrace = applyMiddleware (Trace.logHttpBy (logInfo env) Trace.V2) + withTrace = applyPlugin (Trace.logHttpBy (logInfo env) Trace.V2) ------------------------------------------------------------------------------------- -- application handlers @@ -79,7 +79,7 @@ requestAuthToken env (Body user) = Send $ do threadDelay (1_000_000 * 60 * 10) -- 10 minutes env.auth.expireToken token -withAuth :: Env -> Header "auth" AuthToken -> Middleware IO +withAuth :: Env -> Header "auth" AuthToken -> Plugin IO withAuth env (Header token) = processResponse $ \getResp -> do isOk <- env.auth.validToken token if isOk diff --git a/examples/mig-example-apps/RouteArgs/Main.hs b/examples/mig-example-apps/RouteArgs/Main.hs index 635a5c5..7af5e1a 100644 --- a/examples/mig-example-apps/RouteArgs/Main.hs +++ b/examples/mig-example-apps/RouteArgs/Main.hs @@ -7,7 +7,7 @@ module Main ( main, ) where -import Mig.Extra.Middleware.Trace qualified as Trace +import Mig.Extra.Plugin.Trace qualified as Trace import Mig.Json.IO main :: IO () @@ -42,7 +42,7 @@ routeArgs = "square-root" /. handleSquareRoot ] where - withTrace = applyMiddleware (Trace.logHttp Trace.V2) + withTrace = applyPlugin (Trace.logHttp Trace.V2) -- | Simple getter helloWorld :: Get (Resp Text) diff --git a/examples/mig-example-apps/mig-example-apps.cabal b/examples/mig-example-apps/mig-example-apps.cabal index def9bed..540a05b 100644 --- a/examples/mig-example-apps/mig-example-apps.cabal +++ b/examples/mig-example-apps/mig-example-apps.cabal @@ -1,4 +1,4 @@ -cabal-version: 1.12 +cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.35.2. -- @@ -6,9 +6,7 @@ cabal-version: 1.12 name: mig-example-apps version: 0.1.0.0 -description: - Please see the README on GitHub at - +description: Please see the README on GitHub at homepage: https://github.com/githubuser/mig-example-apps#readme bug-reports: https://github.com/githubuser/mig-example-apps/issues author: Author name here @@ -18,39 +16,34 @@ license: BSD3 license-file: LICENSE build-type: Simple extra-source-files: - CHANGELOG.md - Html/resources/haskell-logo.png - Html/resources/lambda-logo.png - Html/resources/milligram.min.css - README.md + README.md + Html/resources/haskell-logo.png + Html/resources/lambda-logo.png + Html/resources/milligram.min.css source-repository head - type: git + type: git location: https://github.com/githubuser/mig-example-apps executable counter-mig-example-app - main-is: Main.hs - other-modules: Paths_mig_example_apps - hs-source-dirs: Counter + main-is: Main.hs + other-modules: + Paths_mig_example_apps + hs-source-dirs: + Counter default-extensions: - DataKinds - DeriveAnyClass - DerivingStrategies - DuplicateRecordFields - ImportQualifiedPost - LambdaCase - OverloadedRecordDot - OverloadedStrings - RecordWildCards - StrictData - TypeFamilies - - ghc-options: - -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -threaded -rtsopts -with-rtsopts=-N - + ImportQualifiedPost + OverloadedStrings + TypeFamilies + OverloadedRecordDot + DuplicateRecordFields + LambdaCase + DerivingStrategies + DataKinds + StrictData + DeriveAnyClass + RecordWildCards + ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: aeson , aeson-pretty @@ -70,32 +63,27 @@ executable counter-mig-example-app , safe , text , time - - default-language: GHC2021 + default-language: GHC2021 executable hello-world-client-mig-example-app - main-is: Main.hs - other-modules: Paths_mig_example_apps - hs-source-dirs: HelloClient + main-is: Main.hs + other-modules: + Paths_mig_example_apps + hs-source-dirs: + HelloClient default-extensions: - DataKinds - DeriveAnyClass - DerivingStrategies - DuplicateRecordFields - ImportQualifiedPost - LambdaCase - OverloadedRecordDot - OverloadedStrings - RecordWildCards - StrictData - TypeFamilies - - ghc-options: - -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -threaded -rtsopts -with-rtsopts=-N - + ImportQualifiedPost + OverloadedStrings + TypeFamilies + OverloadedRecordDot + DuplicateRecordFields + LambdaCase + DerivingStrategies + DataKinds + StrictData + DeriveAnyClass + RecordWildCards + ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: aeson , aeson-pretty @@ -115,32 +103,27 @@ executable hello-world-client-mig-example-app , safe , text , time - - default-language: GHC2021 + default-language: GHC2021 executable hello-world-mig-example-app - main-is: Main.hs - other-modules: Paths_mig_example_apps - hs-source-dirs: HelloWorld + main-is: Main.hs + other-modules: + Paths_mig_example_apps + hs-source-dirs: + HelloWorld default-extensions: - DataKinds - DeriveAnyClass - DerivingStrategies - DuplicateRecordFields - ImportQualifiedPost - LambdaCase - OverloadedRecordDot - OverloadedStrings - RecordWildCards - StrictData - TypeFamilies - - ghc-options: - -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -threaded -rtsopts -with-rtsopts=-N - + ImportQualifiedPost + OverloadedStrings + TypeFamilies + OverloadedRecordDot + DuplicateRecordFields + LambdaCase + DerivingStrategies + DataKinds + StrictData + DeriveAnyClass + RecordWildCards + ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: aeson , aeson-pretty @@ -159,41 +142,34 @@ executable hello-world-mig-example-app , safe , text , time - - default-language: GHC2021 + default-language: GHC2021 executable html-mig-example-app - main-is: Main.hs + main-is: Main.hs other-modules: - Content - Init - Interface - Internal.State - Paths_mig_example_apps - Server - Types - View - - hs-source-dirs: Html/src + Content + Init + Interface + Internal.State + Server + Types + View + Paths_mig_example_apps + hs-source-dirs: + Html/src default-extensions: - DataKinds - DeriveAnyClass - DerivingStrategies - DuplicateRecordFields - ImportQualifiedPost - LambdaCase - OverloadedRecordDot - OverloadedStrings - RecordWildCards - StrictData - TypeFamilies - - ghc-options: - -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -threaded -rtsopts -with-rtsopts=-N - + ImportQualifiedPost + OverloadedStrings + TypeFamilies + OverloadedRecordDot + DuplicateRecordFields + LambdaCase + DerivingStrategies + DataKinds + StrictData + DeriveAnyClass + RecordWildCards + ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: aeson , aeson-pretty @@ -217,40 +193,33 @@ executable html-mig-example-app , text , time , uuid - - default-language: GHC2021 + default-language: GHC2021 executable json-api-mig-example-app - main-is: Main.hs + main-is: Main.hs other-modules: - Init - Interface - Internal.State - Paths_mig_example_apps - Server - Server.Swagger - Types - - hs-source-dirs: JsonApi + Init + Interface + Internal.State + Server + Server.Swagger + Types + Paths_mig_example_apps + hs-source-dirs: + JsonApi default-extensions: - DataKinds - DeriveAnyClass - DerivingStrategies - DuplicateRecordFields - ImportQualifiedPost - LambdaCase - OverloadedRecordDot - OverloadedStrings - RecordWildCards - StrictData - TypeFamilies - - ghc-options: - -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -threaded -rtsopts -with-rtsopts=-N - + ImportQualifiedPost + OverloadedStrings + TypeFamilies + OverloadedRecordDot + DuplicateRecordFields + LambdaCase + DerivingStrategies + DataKinds + StrictData + DeriveAnyClass + RecordWildCards + ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: aeson , aeson-pretty @@ -271,32 +240,27 @@ executable json-api-mig-example-app , text , time , yaml - - default-language: GHC2021 + default-language: GHC2021 executable route-args-client-mig-example-app - main-is: Main.hs - other-modules: Paths_mig_example_apps - hs-source-dirs: RouteArgsClient + main-is: Main.hs + other-modules: + Paths_mig_example_apps + hs-source-dirs: + RouteArgsClient default-extensions: - DataKinds - DeriveAnyClass - DerivingStrategies - DuplicateRecordFields - ImportQualifiedPost - LambdaCase - OverloadedRecordDot - OverloadedStrings - RecordWildCards - StrictData - TypeFamilies - - ghc-options: - -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -threaded -rtsopts -with-rtsopts=-N - + ImportQualifiedPost + OverloadedStrings + TypeFamilies + OverloadedRecordDot + DuplicateRecordFields + LambdaCase + DerivingStrategies + DataKinds + StrictData + DeriveAnyClass + RecordWildCards + ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: aeson , aeson-pretty @@ -316,32 +280,27 @@ executable route-args-client-mig-example-app , safe , text , time - - default-language: GHC2021 + default-language: GHC2021 executable route-args-mig-example-app - main-is: Main.hs - other-modules: Paths_mig_example_apps - hs-source-dirs: RouteArgs + main-is: Main.hs + other-modules: + Paths_mig_example_apps + hs-source-dirs: + RouteArgs default-extensions: - DataKinds - DeriveAnyClass - DerivingStrategies - DuplicateRecordFields - ImportQualifiedPost - LambdaCase - OverloadedRecordDot - OverloadedStrings - RecordWildCards - StrictData - TypeFamilies - - ghc-options: - -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -threaded -rtsopts -with-rtsopts=-N - + ImportQualifiedPost + OverloadedStrings + TypeFamilies + OverloadedRecordDot + DuplicateRecordFields + LambdaCase + DerivingStrategies + DataKinds + StrictData + DeriveAnyClass + RecordWildCards + ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: aeson , aeson-pretty @@ -360,5 +319,4 @@ executable route-args-mig-example-app , safe , text , time - - default-language: GHC2021 + default-language: GHC2021 diff --git a/mig-client/mig-client.cabal b/mig-client/mig-client.cabal index 7d5a0e8..08152f9 100644 --- a/mig-client/mig-client.cabal +++ b/mig-client/mig-client.cabal @@ -1,4 +1,4 @@ -cabal-version: 1.12 +cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.35.2. -- @@ -7,10 +7,8 @@ cabal-version: 1.12 name: mig-client version: 0.1.0.0 synopsis: Build http-clients from API definition for mig servers -description: - With this library we can build client functions for HTTP-applications - from the same code as server definition. - +description: With this library we can build client functions for HTTP-applications + from the same code as server definition. category: Web homepage: https://github.com/anton-k/mig#readme bug-reports: https://github.com/anton-k/mig/issues @@ -19,32 +17,30 @@ maintainer: anton.kholomiov@gmail.com copyright: 2023 Anton Kholomiov license: BSD3 build-type: Simple -extra-source-files: README.md +extra-source-files: + README.md source-repository head - type: git + type: git location: https://github.com/anton-k/mig library - exposed-modules: Mig.Client - other-modules: Paths_mig_client - hs-source-dirs: src + exposed-modules: + Mig.Client + other-modules: + Paths_mig_client + hs-source-dirs: + src default-extensions: - AllowAmbiguousTypes - DerivingStrategies - DuplicateRecordFields - LambdaCase - OverloadedRecordDot - OverloadedStrings - StrictData - TypeFamilies - - ghc-options: - -Wall -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -Wunused-packages - + OverloadedStrings + TypeFamilies + OverloadedRecordDot + DuplicateRecordFields + LambdaCase + DerivingStrategies + StrictData + AllowAmbiguousTypes + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wunused-packages build-depends: base >=4.7 && <5 , bytestring @@ -56,5 +52,4 @@ library , mig , mtl , text - - default-language: GHC2021 + default-language: GHC2021 diff --git a/mig-extra/mig-extra.cabal b/mig-extra/mig-extra.cabal index abe1447..9ec0c3b 100644 --- a/mig-extra/mig-extra.cabal +++ b/mig-extra/mig-extra.cabal @@ -1,4 +1,4 @@ -cabal-version: 1.12 +cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.35.2. -- @@ -16,41 +16,37 @@ maintainer: anton.kholomiov@gmail.com copyright: 2023 Anton Kholomiov license: BSD3 build-type: Simple -extra-source-files: README.md +extra-source-files: + README.md source-repository head - type: git + type: git location: https://github.com/anton-k/mig library exposed-modules: - Mig.Extra.Middleware.Auth - Mig.Extra.Middleware.Exception - Mig.Extra.Middleware.Trace - Mig.Extra.Server.Common - Mig.Extra.Server.Html - Mig.Extra.Server.Html.IO - Mig.Extra.Server.IO - Mig.Extra.Server.Json - Mig.Extra.Server.Json.IO - - other-modules: Paths_mig_extra - hs-source-dirs: src + Mig.Extra.Plugin.Auth + Mig.Extra.Plugin.Exception + Mig.Extra.Plugin.Trace + Mig.Extra.Server.Common + Mig.Extra.Server.Html + Mig.Extra.Server.Html.IO + Mig.Extra.Server.IO + Mig.Extra.Server.Json + Mig.Extra.Server.Json.IO + other-modules: + Paths_mig_extra + hs-source-dirs: + src default-extensions: - DataKinds - DerivingStrategies - DuplicateRecordFields - LambdaCase - OverloadedRecordDot - OverloadedStrings - TypeFamilies - - ghc-options: - -Wall -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -Wunused-packages - + DerivingStrategies + TypeFamilies + DataKinds + OverloadedRecordDot + OverloadedStrings + DuplicateRecordFields + LambdaCase + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wunused-packages build-depends: aeson , base >=4.7 && <5 @@ -69,5 +65,4 @@ library , text , time , yaml - - default-language: GHC2021 + default-language: GHC2021 diff --git a/mig-extra/src/Mig/Extra/Middleware/Auth.hs b/mig-extra/src/Mig/Extra/Plugin/Auth.hs similarity index 74% rename from mig-extra/src/Mig/Extra/Middleware/Auth.hs rename to mig-extra/src/Mig/Extra/Plugin/Auth.hs index ba4caee..0f546fc 100644 --- a/mig-extra/src/Mig/Extra/Middleware/Auth.hs +++ b/mig-extra/src/Mig/Extra/Plugin/Auth.hs @@ -1,5 +1,5 @@ --- | Middleware to handle authorization. Just a sketch for now. -module Mig.Extra.Middleware.Auth ( +-- | Plugin to handle authorization. Just a sketch for now. +module Mig.Extra.Plugin.Auth ( WithAuth (..), withHeaderAuth, ) where @@ -13,7 +13,7 @@ data WithAuth m token resp = WithAuth , authFail :: token -> m resp } -withHeaderAuth :: forall m token resp. (IsResp resp, MonadIO m) => WithAuth m token resp -> Header "auth" token -> Middleware m +withHeaderAuth :: forall m token resp. (IsResp resp, MonadIO m) => WithAuth m token resp -> Header "auth" token -> Plugin m withHeaderAuth env (Header token) = processResponse $ \getResp -> do isOk <- env.isValid token if isOk diff --git a/mig-extra/src/Mig/Extra/Middleware/Exception.hs b/mig-extra/src/Mig/Extra/Plugin/Exception.hs similarity index 77% rename from mig-extra/src/Mig/Extra/Middleware/Exception.hs rename to mig-extra/src/Mig/Extra/Plugin/Exception.hs index 914dd1e..a85d7b9 100644 --- a/mig-extra/src/Mig/Extra/Middleware/Exception.hs +++ b/mig-extra/src/Mig/Extra/Plugin/Exception.hs @@ -1,5 +1,5 @@ --- | Middlewares to handle exceptions -module Mig.Extra.Middleware.Exception ( +-- | Plugins to handle exceptions +module Mig.Extra.Plugin.Exception ( handleRespError, ) where @@ -16,8 +16,8 @@ handleRespError :: forall a b m. (MonadIO m, MonadCatch m, Exception a, IsResp b) => (a -> m b) -> - Middleware m -handleRespError handle = fromMiddlewareFun $ \f -> \req -> do + Plugin m +handleRespError handle = fromPluginFun $ \f -> \req -> do eResult <- try @m @a (f req) case eResult of Right res -> pure res diff --git a/mig-extra/src/Mig/Extra/Middleware/Trace.hs b/mig-extra/src/Mig/Extra/Plugin/Trace.hs similarity index 93% rename from mig-extra/src/Mig/Extra/Middleware/Trace.hs rename to mig-extra/src/Mig/Extra/Plugin/Trace.hs index 6b8c640..32c07e7 100644 --- a/mig-extra/src/Mig/Extra/Middleware/Trace.hs +++ b/mig-extra/src/Mig/Extra/Plugin/Trace.hs @@ -5,7 +5,7 @@ with no ordering of the concurrent prints. It can be useful for fast setup of debug for your application. -} -module Mig.Extra.Middleware.Trace ( +module Mig.Extra.Plugin.Trace ( logReq, logResp, logReqBy, @@ -60,23 +60,23 @@ ifLevel current level vals -- through -- | Logging of requests and responses -logHttp :: (MonadIO m) => Verbosity -> Middleware m +logHttp :: (MonadIO m) => Verbosity -> Plugin m logHttp verbosity = logResp verbosity <> logReq verbosity -- | Logging of requests and responses with custom logger -logHttpBy :: (MonadIO m) => (Json.Value -> m ()) -> Verbosity -> Middleware m +logHttpBy :: (MonadIO m) => (Json.Value -> m ()) -> Verbosity -> Plugin m logHttpBy printer verbosity = logRespBy printer verbosity <> logReqBy printer verbosity ------------------------------------------------------------------------------------- -- request -- | Logs requests -logReq :: (MonadIO m) => Verbosity -> Middleware m +logReq :: (MonadIO m) => Verbosity -> Plugin m logReq = logReqBy defaultPrinter -- | Logs requests with custom logger -logReqBy :: (MonadIO m) => (Json.Value -> m ()) -> Verbosity -> Middleware m -logReqBy printer verbosity = toMiddleware $ \(RawRequest req) -> prependServerAction $ do +logReqBy :: (MonadIO m) => (Json.Value -> m ()) -> Verbosity -> Plugin m +logReqBy printer verbosity = toPlugin $ \(RawRequest req) -> prependServerAction $ do when (verbosity > V0) $ do reqTrace <- liftIO $ do eBody <- req.readBody @@ -126,14 +126,14 @@ ppReq verbosity now body req = -- response -- | Logs response -logResp :: (MonadIO m) => Verbosity -> Middleware m +logResp :: (MonadIO m) => Verbosity -> Plugin m logResp = logRespBy defaultPrinter -- | Logs response with custom logger -logRespBy :: forall m. (MonadIO m) => (Json.Value -> m ()) -> Verbosity -> Middleware m -logRespBy printer verbosity = toMiddleware go +logRespBy :: forall m. (MonadIO m) => (Json.Value -> m ()) -> Verbosity -> Plugin m +logRespBy printer verbosity = toPlugin go where - go :: MiddlewareFun m + go :: PluginFun m go = \f -> \req -> do (dur, resp) <- duration (f req) when (verbosity > V0) $ do diff --git a/mig-extra/src/Mig/Extra/Server/Common.hs b/mig-extra/src/Mig/Extra/Server/Common.hs index 062aad0..12fa0dd 100644 --- a/mig-extra/src/Mig/Extra/Server/Common.hs +++ b/mig-extra/src/Mig/Extra/Server/Common.hs @@ -58,11 +58,11 @@ module Mig.Extra.Server.Common ( -- ** specific cases staticFiles, - -- ** Middlewares - Middleware (..), - MiddlewareFun, - ToMiddleware (..), - applyMiddleware, + -- ** Plugins + Plugin (..), + PluginFun, + ToPlugin (..), + applyPlugin, ($:), prependServerAction, appendServerAction, diff --git a/mig-extra/src/Mig/Extra/Server/Json.hs b/mig-extra/src/Mig/Extra/Server/Json.hs index a7e3a0b..212d43e 100644 --- a/mig-extra/src/Mig/Extra/Server/Json.hs +++ b/mig-extra/src/Mig/Extra/Server/Json.hs @@ -62,11 +62,11 @@ instance (ToSchema a, FromJSON a, ToRoute b) => ToServer (Body a -> b) where (toServer :: ((Core.Body Json a -> b) -> Server (Core.MonadOf b))) (\(Core.Body a) -> f (Body a)) -instance (FromJSON a, ToSchema a, ToMiddleware b) => ToMiddleware (Body a -> b) where - toMiddlewareInfo = toMiddlewareInfo @(Core.Body Json a -> b) +instance (FromJSON a, ToSchema a, ToPlugin b) => ToPlugin (Body a -> b) where + toPluginInfo = toPluginInfo @(Core.Body Json a -> b) - toMiddlewareFun f = - (toMiddlewareFun :: ((Core.Body Json a -> b) -> MiddlewareFun (Core.MonadOf b))) + toPluginFun f = + (toPluginFun :: ((Core.Body Json a -> b) -> PluginFun (Core.MonadOf b))) (\(Core.Body a) -> f (Body a)) -- client instances diff --git a/mig-rio/mig-rio.cabal b/mig-rio/mig-rio.cabal index 2b7c186..7191b23 100644 --- a/mig-rio/mig-rio.cabal +++ b/mig-rio/mig-rio.cabal @@ -1,4 +1,4 @@ -cabal-version: 1.12 +cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.35.2. -- @@ -16,26 +16,25 @@ maintainer: anton.kholomiov@gmail.com copyright: 2023 Anton Kholomiov license: BSD3 build-type: Simple -extra-source-files: README.md +extra-source-files: + README.md source-repository head - type: git + type: git location: https://github.com/anton-k/mig library - exposed-modules: Mig.RIO - other-modules: Paths_mig_rio - hs-source-dirs: src - default-extensions: DerivingStrategies - ghc-options: - -Wall -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -Wunused-packages - + exposed-modules: + Mig.RIO + other-modules: + Paths_mig_rio + hs-source-dirs: + src + default-extensions: + DerivingStrategies + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wunused-packages build-depends: base >=4.7 && <5 , mig-server , rio - - default-language: GHC2021 + default-language: GHC2021 diff --git a/mig-server/mig-server.cabal b/mig-server/mig-server.cabal index 1c81d42..4750462 100644 --- a/mig-server/mig-server.cabal +++ b/mig-server/mig-server.cabal @@ -1,4 +1,4 @@ -cabal-version: 1.12 +cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.35.2. -- @@ -7,58 +7,56 @@ cabal-version: 1.12 name: mig-server version: 0.1.0.0 synopsis: Build lightweight and composable servers -description: - With library mig we can build lightweight and composable servers. - There are only couple of combinators to assemble servers from parts. - It supports generic handler functions as servant does. But strives to use more - simple model for API. It does not go to describing Server API at type level which - leads to simpler error messages. - . - The main features are: - . - * lightweight library - . - * expressive DSL to compose servers - . - * type-safe handlers - . - * handlers are encoded with generic haskell functions - . - * built on top of WAI and warp server libraries. - . - Example of hello world server: - . - > import Mig.Json.IO - > - > -- | We can render the server and run it on port 8085. - > -- It uses wai and warp. - > main :: IO () - > main = runServer 8085 server - > - > -- | Init simple hello world server whith two routes: - > server :: Server IO - > server = - > "api" /. "v1" /. - > mconcat - > [ "hello" /. hello - > , "bye" /. bye - > ] - > - > -- | Handler takes no inputs and marked as Get HTTP-request that returns Text. - > hello :: Get (Resp Text) - > hello = Get $ pure $ ok "Hello World" - > - > -- | Handle with URL-param query and json body input as Post HTTP-request that returns Text. - > bye :: Query "name" Text -> Body Text -> Post (Resp Text) - > bye (Query name) (Body greeting) = Post $ - > pure $ ok $ "Bye to " <> name <> " " <> greeting - . - Please see: - . - * quick start guide at - . - * examples directory for more fun servers: at - +description: With library mig we can build lightweight and composable servers. + There are only couple of combinators to assemble servers from parts. + It supports generic handler functions as servant does. But strives to use more + simple model for API. It does not go to describing Server API at type level which + leads to simpler error messages. + . + The main features are: + . + * lightweight library + . + * expressive DSL to compose servers + . + * type-safe handlers + . + * handlers are encoded with generic haskell functions + . + * built on top of WAI and warp server libraries. + . + Example of hello world server: + . + > import Mig.Json.IO + > + > -- | We can render the server and run it on port 8085. + > -- It uses wai and warp. + > main :: IO () + > main = runServer 8085 server + > + > -- | Init simple hello world server whith two routes: + > server :: Server IO + > server = + > "api" /. "v1" /. + > mconcat + > [ "hello" /. hello + > , "bye" /. bye + > ] + > + > -- | Handler takes no inputs and marked as Get HTTP-request that returns Text. + > hello :: Get (Resp Text) + > hello = Get $ pure $ ok "Hello World" + > + > -- | Handle with URL-param query and json body input as Post HTTP-request that returns Text. + > bye :: Query "name" Text -> Body Text -> Post (Resp Text) + > bye (Query name) (Body greeting) = Post $ + > pure $ ok $ "Bye to " <> name <> " " <> greeting + . + Please see: + . + * quick start guide at + . + * examples directory for more fun servers: at category: Web homepage: https://github.com/anton-k/mig#readme bug-reports: https://github.com/anton-k/mig/issues @@ -68,39 +66,35 @@ copyright: 2023 Anton Kholomiov license: BSD3 license-file: LICENSE build-type: Simple -extra-source-files: README.md +extra-source-files: + README.md source-repository head - type: git + type: git location: https://github.com/anton-k/mig library exposed-modules: - Mig - Mig.Html - Mig.Html.IO - Mig.IO - Mig.Json - Mig.Json.IO - Mig.Server.Warp - - other-modules: Paths_mig_server - hs-source-dirs: src + Mig + Mig.Html + Mig.Html.IO + Mig.IO + Mig.Json + Mig.Json.IO + Mig.Server.Warp + other-modules: + Paths_mig_server + hs-source-dirs: + src default-extensions: - DerivingStrategies - DuplicateRecordFields - LambdaCase - OverloadedRecordDot - OverloadedStrings - StrictData - TypeFamilies - - ghc-options: - -Wall -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -Wunused-packages - + DerivingStrategies + DuplicateRecordFields + LambdaCase + OverloadedRecordDot + OverloadedStrings + StrictData + TypeFamilies + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wunused-packages build-depends: aeson , base >=4.7 && <5 @@ -115,5 +109,4 @@ library , openapi3 , text , warp - - default-language: GHC2021 + default-language: GHC2021 diff --git a/mig-server/src/Mig.hs b/mig-server/src/Mig.hs index 99c3d93..af498be 100644 --- a/mig-server/src/Mig.hs +++ b/mig-server/src/Mig.hs @@ -90,11 +90,11 @@ module Mig ( -- ** specific cases staticFiles, - -- ** Middlewares - Middleware (..), - MiddlewareFun, - ToMiddleware (..), - applyMiddleware, + -- ** Plugins + Plugin (..), + PluginFun, + ToPlugin (..), + applyPlugin, ($:), prependServerAction, appendServerAction, diff --git a/mig-swagger-ui/mig-swagger-ui.cabal b/mig-swagger-ui/mig-swagger-ui.cabal index 29247ac..4149be8 100644 --- a/mig-swagger-ui/mig-swagger-ui.cabal +++ b/mig-swagger-ui/mig-swagger-ui.cabal @@ -1,4 +1,4 @@ -cabal-version: 1.12 +cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.35.2. -- @@ -17,46 +17,43 @@ copyright: 2023 Anton Kholomiov license: BSD3 build-type: Simple extra-source-files: - index.html.tmpl - README.md - swagger-ui-dist-5.0.0/favicon-16x16.png - swagger-ui-dist-5.0.0/favicon-32x32.png - swagger-ui-dist-5.0.0/index.css - swagger-ui-dist-5.0.0/oauth2-redirect.html - swagger-ui-dist-5.0.0/swagger-initializer.js - swagger-ui-dist-5.0.0/swagger-ui-bundle.js - swagger-ui-dist-5.0.0/swagger-ui-bundle.js.map - swagger-ui-dist-5.0.0/swagger-ui-es-bundle-core.js - swagger-ui-dist-5.0.0/swagger-ui-es-bundle-core.js.map - swagger-ui-dist-5.0.0/swagger-ui-es-bundle.js - swagger-ui-dist-5.0.0/swagger-ui-es-bundle.js.map - swagger-ui-dist-5.0.0/swagger-ui-standalone-preset.js - swagger-ui-dist-5.0.0/swagger-ui-standalone-preset.js.map - swagger-ui-dist-5.0.0/swagger-ui.css - swagger-ui-dist-5.0.0/swagger-ui.css.map - swagger-ui-dist-5.0.0/swagger-ui.js - swagger-ui-dist-5.0.0/swagger-ui.js.map + README.md + index.html.tmpl + swagger-ui-dist-5.0.0/favicon-16x16.png + swagger-ui-dist-5.0.0/favicon-32x32.png + swagger-ui-dist-5.0.0/oauth2-redirect.html + swagger-ui-dist-5.0.0/swagger-ui-bundle.js + swagger-ui-dist-5.0.0/swagger-ui-bundle.js.map + swagger-ui-dist-5.0.0/swagger-ui-es-bundle-core.js + swagger-ui-dist-5.0.0/swagger-ui-es-bundle-core.js.map + swagger-ui-dist-5.0.0/swagger-ui-es-bundle.js + swagger-ui-dist-5.0.0/swagger-ui-es-bundle.js.map + swagger-ui-dist-5.0.0/swagger-ui-standalone-preset.js + swagger-ui-dist-5.0.0/swagger-ui-standalone-preset.js.map + swagger-ui-dist-5.0.0/swagger-ui.css + swagger-ui-dist-5.0.0/swagger-ui.css.map + swagger-ui-dist-5.0.0/swagger-ui.js + swagger-ui-dist-5.0.0/swagger-ui.js.map + swagger-ui-dist-5.0.0/swagger-initializer.js + swagger-ui-dist-5.0.0/index.css source-repository head - type: git + type: git location: https://github.com/anton-k/mig library - exposed-modules: Mig.Swagger - other-modules: Paths_mig_swagger_ui - hs-source-dirs: src + exposed-modules: + Mig.Swagger + other-modules: + Paths_mig_swagger_ui + hs-source-dirs: + src default-extensions: - OverloadedRecordDot - OverloadedStrings - StrictData - TemplateHaskell - - ghc-options: - -Wall -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -Wunused-packages - + OverloadedStrings + OverloadedRecordDot + TemplateHaskell + StrictData + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wunused-packages build-depends: aeson , aeson-pretty @@ -71,5 +68,4 @@ library , mig , openapi3 , text - - default-language: GHC2021 + default-language: GHC2021 diff --git a/mig-wai/mig-wai.cabal b/mig-wai/mig-wai.cabal index a2e0e42..f6c7c20 100644 --- a/mig-wai/mig-wai.cabal +++ b/mig-wai/mig-wai.cabal @@ -1,4 +1,4 @@ -cabal-version: 1.12 +cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.35.2. -- @@ -7,9 +7,7 @@ cabal-version: 1.12 name: mig-wai version: 0.1.0.0 synopsis: Render mig-servers as wai-applications -description: - Please see the README on GitHub at - +description: Please see the README on GitHub at category: Web homepage: https://github.com/githubuser/mig-wai#readme bug-reports: https://github.com/githubuser/mig-wai/issues @@ -18,28 +16,26 @@ maintainer: example@example.com copyright: 2023 Author name here license: BSD3 build-type: Simple -extra-source-files: README.md +extra-source-files: + README.md source-repository head - type: git + type: git location: https://github.com/githubuser/mig-wai library - exposed-modules: Mig.Server.Wai - other-modules: Paths_mig_wai - hs-source-dirs: src + exposed-modules: + Mig.Server.Wai + other-modules: + Paths_mig_wai + hs-source-dirs: + src default-extensions: - DuplicateRecordFields - LambdaCase - OverloadedRecordDot - OverloadedStrings - - ghc-options: - -Wall -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -Wunused-packages - + OverloadedRecordDot + DuplicateRecordFields + OverloadedStrings + LambdaCase + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wunused-packages build-depends: base >=4.7 && <5 , bytestring @@ -48,5 +44,4 @@ library , mig , text , wai - - default-language: GHC2021 + default-language: GHC2021 diff --git a/mig/mig.cabal b/mig/mig.cabal index 0641548..a4f2324 100644 --- a/mig/mig.cabal +++ b/mig/mig.cabal @@ -1,4 +1,4 @@ -cabal-version: 1.12 +cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.35.2. -- @@ -7,18 +7,16 @@ cabal-version: 1.12 name: mig version: 0.2.0.0 synopsis: Build lightweight and composable servers -description: - Core for the mig server library. - With library mig we can build lightweight and composable servers. - There are only couple of combinators to assemble servers from parts. - It supports generic handler functions as servant does. But strives to use more - simple model for API. It does not go to describing Server API at type level which - leads to simpler error messages. - . - * quick start guide at - . - * examples directory for more fun servers: at - +description: Core for the mig server library. + With library mig we can build lightweight and composable servers. + There are only couple of combinators to assemble servers from parts. + It supports generic handler functions as servant does. But strives to use more + simple model for API. It does not go to describing Server API at type level which + leads to simpler error messages. + . + * quick start guide at + . + * examples directory for more fun servers: at category: Web homepage: https://github.com/anton-k/mig#readme bug-reports: https://github.com/anton-k/mig/issues @@ -27,49 +25,45 @@ maintainer: anton.kholomiov@gmail.com copyright: 2023 Anton Kholomiov license: BSD3 build-type: Simple -extra-source-files: README.md +extra-source-files: + README.md source-repository head - type: git + type: git location: https://github.com/anton-k/mig library exposed-modules: - Mig.Core - Mig.Core.Api - Mig.Core.Class - Mig.Core.Class.MediaType - Mig.Core.Class.Middleware - Mig.Core.Class.Monad - Mig.Core.Class.Response - Mig.Core.Class.Route - Mig.Core.Class.Server - Mig.Core.OpenApi - Mig.Core.Server - Mig.Core.ServerFun - Mig.Core.Types - Mig.Core.Types.Http - Mig.Core.Types.Info - Mig.Core.Types.Route - - other-modules: Paths_mig - hs-source-dirs: src + Mig.Core + Mig.Core.Api + Mig.Core.Class + Mig.Core.Class.MediaType + Mig.Core.Class.Monad + Mig.Core.Class.Plugin + Mig.Core.Class.Response + Mig.Core.Class.Route + Mig.Core.Class.Server + Mig.Core.OpenApi + Mig.Core.Server + Mig.Core.ServerFun + Mig.Core.Types + Mig.Core.Types.Http + Mig.Core.Types.Info + Mig.Core.Types.Route + other-modules: + Paths_mig + hs-source-dirs: + src default-extensions: - AllowAmbiguousTypes - DerivingStrategies - DuplicateRecordFields - LambdaCase - OverloadedRecordDot - OverloadedStrings - StrictData - TypeFamilies - - ghc-options: - -Wall -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wmissing-export-lists - -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints - -Wunused-packages - + OverloadedStrings + TypeFamilies + OverloadedRecordDot + DuplicateRecordFields + LambdaCase + DerivingStrategies + StrictData + AllowAmbiguousTypes + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wunused-packages build-depends: aeson , base >=4.7 && <5 @@ -89,5 +83,4 @@ library , openapi3 , safe , text - - default-language: GHC2021 + default-language: GHC2021 diff --git a/mig/src/Mig/Core/Class.hs b/mig/src/Mig/Core/Class.hs index 048aec7..3780781 100644 --- a/mig/src/Mig/Core/Class.hs +++ b/mig/src/Mig/Core/Class.hs @@ -4,7 +4,7 @@ module Mig.Core.Class ( ) where import Mig.Core.Class.MediaType as X -import Mig.Core.Class.Middleware as X +import Mig.Core.Class.Plugin as X import Mig.Core.Class.Monad as X import Mig.Core.Class.Response as X import Mig.Core.Class.Route as X diff --git a/mig/src/Mig/Core/Class/Middleware.hs b/mig/src/Mig/Core/Class/Middleware.hs deleted file mode 100644 index b673139..0000000 --- a/mig/src/Mig/Core/Class/Middleware.hs +++ /dev/null @@ -1,226 +0,0 @@ -{-| Middlewares are useful to apply certain action to all routes in the server. -For example we can add generic logger or authorization bazed on common query parameter -or field of the body request that contains token of the session. - -The downside is that we work on low level of Requesnce/Response as we have rendered -all routes to ServerFun. But thw good part of it is that we can add generic action -to every route. - -Let's consider a simple example of adding logger to lall routes: - - -> logRoutes :: Server IO -> Server IO -> logRoutes = applyMiddleware $ \(PathInfo path) -> prependServerAction $ -> when (path /= ["favicon.ico"] && headMay path /= Just "static") $ do -> logRoute site (Text.intercalate "/" path) -> -> -- | Logs the route info -> logRoute :: Site -> Text -> IO () -> logRoute site route = do -> time <- getCurrentTime -> site.logInfo $ route <> " page visited at: " <> Text.pack (show time) - -Here we use instance of ToMiddleware for `PathInfo` to read full path for any route -and we use this information in the logger. - -We have various instances for everything that we can query from the request -and we can use this information to transform the server functions inside the routes. - -The instances work in the same manner as route handlers we can use as many arguments as -we wish and we use typed wrappers to query specific part of the request. -Thus we gain type-safety and get convenient interface to request the various parts of request. --} -module Mig.Core.Class.Middleware ( - -- * class - ToMiddleware (..), - Middleware (..), - MiddlewareFun, - toMiddleware, - fromMiddlewareFun, - ($:), - applyMiddleware, - RawResponse (..), - - -- * specific middlewares - prependServerAction, - appendServerAction, - processResponse, - whenSecure, - processNoResponse, -) where - -import Control.Monad.IO.Class -import Data.OpenApi (ToParamSchema (..), ToSchema (..)) -import Data.Proxy -import Data.String -import GHC.TypeLits -import Web.HttpApiData - -import Mig.Core.Class.MediaType -import Mig.Core.Class.Monad -import Mig.Core.Class.Response -import Mig.Core.Server -import Mig.Core.ServerFun -import Mig.Core.Types - --- | Low-level middleware function. -type MiddlewareFun m = ServerFun m -> ServerFun m - -{-| Middleware can convert all routes of the server. -It is wrapper on top of @ServerFun m -> ServerFun m@. -We can apply middlewares to servers with @applyMiddleware@ function -also middleware has Monoid instance which is like Monoid.Endo or functional composition @(.)@. --} -data Middleware m = Middleware - { info :: RouteInfo -> RouteInfo - -- ^ update api schema - , run :: MiddlewareFun m - -- ^ run the middleware - } - -instance Monoid (Middleware m) where - mempty = Middleware id id - -instance Semigroup (Middleware m) where - (<>) a b = Middleware (a.info . b.info) (a.run . b.run) - --- | Infix operator for @applyMiddleware@ -($:) :: forall f. (ToMiddleware f) => f -> Server (MonadOf f) -> Server (MonadOf f) -($:) = applyMiddleware - --- | Applies middleware to all routes of the server. -applyMiddleware :: forall f. (ToMiddleware f) => f -> Server (MonadOf f) -> Server (MonadOf f) -applyMiddleware a = mapRouteInfo (toMiddlewareInfo @f) . mapServerFun (toMiddlewareFun a) - -{-| Values that can represent a middleware. -We use various newtype-wrappers to query type-safe info from request. --} -class (MonadIO (MonadOf f)) => ToMiddleware f where - toMiddlewareInfo :: RouteInfo -> RouteInfo - toMiddlewareFun :: f -> ServerFun (MonadOf f) -> ServerFun (MonadOf f) - --- | Convert middleware-like value to middleware. -toMiddleware :: forall f. (ToMiddleware f) => f -> Middleware (MonadOf f) -toMiddleware a = Middleware (toMiddlewareInfo @f) (toMiddlewareFun a) - --- identity -instance (MonadIO m) => ToMiddleware (MiddlewareFun m) where - toMiddlewareInfo = id - toMiddlewareFun = id - -instance (MonadIO m) => ToMiddleware (Middleware m) where - toMiddlewareInfo = id - toMiddlewareFun = (.run) - -fromMiddlewareFun :: (MonadIO m) => MiddlewareFun m -> Middleware m -fromMiddlewareFun = toMiddleware - --- path info -instance (ToMiddleware a) => ToMiddleware (PathInfo -> a) where - toMiddlewareInfo = id - toMiddlewareFun f = \fun -> withPathInfo (\path -> toMiddlewareFun (f (PathInfo path)) fun) - --- path info -instance (ToMiddleware a) => ToMiddleware (IsSecure -> a) where - toMiddlewareInfo = id - toMiddlewareFun f = \fun -> \req -> (toMiddlewareFun (f (IsSecure req.isSecure)) fun) req - -instance (ToMiddleware a) => ToMiddleware (RawRequest -> a) where - toMiddlewareInfo = id - toMiddlewareFun f = \fun -> \req -> (toMiddlewareFun (f (RawRequest req)) fun) req - --- | Read low-level response. Note that it does not affect the API schema -newtype RawResponse = RawResponse (Maybe Response) - -instance (ToMiddleware a) => ToMiddleware (RawResponse -> a) where - toMiddlewareInfo = id - toMiddlewareFun f = \fun -> \req -> do - resp <- fun req - (toMiddlewareFun (f (RawResponse resp)) fun) req - --- request body -instance (FromReqBody ty a, ToSchema a, ToMiddleware b) => ToMiddleware (Body ty a -> b) where - toMiddlewareInfo = addBodyInfo @ty @a . toMiddlewareInfo @b - toMiddlewareFun f = \fun -> withBody @ty (\body -> toMiddlewareFun (f (Body body)) fun) - --- header -instance (FromHttpApiData a, ToParamSchema a, ToMiddleware b, KnownSymbol sym) => ToMiddleware (Header sym a -> b) where - toMiddlewareInfo = addHeaderInfo @sym @a . toMiddlewareInfo @b - toMiddlewareFun f = \fun -> withHeader (getName @sym) (\a -> toMiddlewareFun (f (Header a)) fun) - --- optional header -instance (FromHttpApiData a, ToParamSchema a, ToMiddleware b, KnownSymbol sym) => ToMiddleware (OptionalHeader sym a -> b) where - toMiddlewareInfo = addOptionalHeaderInfo @sym @a . toMiddlewareInfo @b - toMiddlewareFun f = \fun -> withOptionalHeader (getName @sym) (\a -> toMiddlewareFun (f (OptionalHeader a)) fun) - --- query -instance (FromHttpApiData a, ToParamSchema a, ToMiddleware b, KnownSymbol sym) => ToMiddleware (Query sym a -> b) where - toMiddlewareInfo = addQueryInfo @sym @a . toMiddlewareInfo @b - toMiddlewareFun f = \fun -> withQuery (getName @sym) (\a -> toMiddlewareFun (f (Query a)) fun) - --- optional query -instance (FromHttpApiData a, ToParamSchema a, ToMiddleware b, KnownSymbol sym) => ToMiddleware (Optional sym a -> b) where - toMiddlewareInfo = addOptionalInfo @sym @a . toMiddlewareInfo @b - toMiddlewareFun f = \fun -> withOptional (getName @sym) (\a -> toMiddlewareFun (f (Optional a)) fun) - --- capture -instance (FromHttpApiData a, ToParamSchema a, ToMiddleware b, KnownSymbol sym) => ToMiddleware (Capture sym a -> b) where - toMiddlewareInfo = addCaptureInfo @sym @a . toMiddlewareInfo @b - toMiddlewareFun f = \fun -> withCapture (getName @sym) (\a -> toMiddlewareFun (f (Capture a)) fun) - --- query flag -instance (ToMiddleware b, KnownSymbol sym) => ToMiddleware (QueryFlag sym -> b) where - toMiddlewareInfo = addQueryFlagInfo @sym . toMiddlewareInfo @b - toMiddlewareFun f = \fun -> withQueryFlag (getName @sym) (\a -> toMiddlewareFun (f (QueryFlag a)) fun) - ---------------------------------------------- --- specific middlewares - --- | Prepends action to the server -prependServerAction :: forall m. (MonadIO m) => m () -> Middleware m -prependServerAction act = toMiddleware go - where - go :: ServerFun m -> ServerFun m - go f = \req -> do - act - f req - --- | Post appends action to the server -appendServerAction :: forall m. (MonadIO m) => m () -> Middleware m -appendServerAction act = toMiddleware go - where - go :: ServerFun m -> ServerFun m - go f = \req -> do - resp <- f req - act - pure resp - --- | Applies transformation to the response -processResponse :: forall m. (MonadIO m) => (m (Maybe Response) -> m (Maybe Response)) -> Middleware m -processResponse act = toMiddleware go - where - go :: ServerFun m -> ServerFun m - go f = \req -> do - act (f req) - --- | Execute request only if it is secure (made with SSL connection) -whenSecure :: forall m. (MonadIO m) => Middleware m -whenSecure = toMiddleware $ \(IsSecure isSecure) -> - processResponse (if isSecure then id else const (pure Nothing)) - --- | Sets default response if server response with Nothing. If it can not handle the request. -processNoResponse :: forall m a. (MonadIO m, IsResp a) => m a -> Middleware m -processNoResponse defaultResponse = toMiddleware go - where - go :: MiddlewareFun m - go fun = \req -> do - mResp <- fun req - case mResp of - Just resp -> pure (Just resp) - Nothing -> Just . toResponse <$> defaultResponse - ---------------------------------------------- --- utils - -getName :: forall sym a. (KnownSymbol sym, IsString a) => a -getName = fromString (symbolVal (Proxy @sym)) diff --git a/mig/src/Mig/Core/Class/Plugin.hs b/mig/src/Mig/Core/Class/Plugin.hs new file mode 100644 index 0000000..05072c8 --- /dev/null +++ b/mig/src/Mig/Core/Class/Plugin.hs @@ -0,0 +1,226 @@ +{-| Plugins are useful to apply certain action to all routes in the server. +For example we can add generic logger or authorization bazed on common query parameter +or field of the body request that contains token of the session. + +The downside is that we work on low level of Requesnce/Response as we have rendered +all routes to ServerFun. But thw good part of it is that we can add generic action +to every route. + +Let's consider a simple example of adding logger to lall routes: + + +> logRoutes :: Server IO -> Server IO +> logRoutes = applyPlugin $ \(PathInfo path) -> prependServerAction $ +> when (path /= ["favicon.ico"] && headMay path /= Just "static") $ do +> logRoute site (Text.intercalate "/" path) +> +> -- | Logs the route info +> logRoute :: Site -> Text -> IO () +> logRoute site route = do +> time <- getCurrentTime +> site.logInfo $ route <> " page visited at: " <> Text.pack (show time) + +Here we use instance of ToPlugin for `PathInfo` to read full path for any route +and we use this information in the logger. + +We have various instances for everything that we can query from the request +and we can use this information to transform the server functions inside the routes. + +The instances work in the same manner as route handlers we can use as many arguments as +we wish and we use typed wrappers to query specific part of the request. +Thus we gain type-safety and get convenient interface to request the various parts of request. +-} +module Mig.Core.Class.Plugin ( + -- * class + ToPlugin (..), + Plugin (..), + PluginFun, + toPlugin, + fromPluginFun, + ($:), + applyPlugin, + RawResponse (..), + + -- * specific plugins + prependServerAction, + appendServerAction, + processResponse, + whenSecure, + processNoResponse, +) where + +import Control.Monad.IO.Class +import Data.OpenApi (ToParamSchema (..), ToSchema (..)) +import Data.Proxy +import Data.String +import GHC.TypeLits +import Web.HttpApiData + +import Mig.Core.Class.MediaType +import Mig.Core.Class.Monad +import Mig.Core.Class.Response +import Mig.Core.Server +import Mig.Core.ServerFun +import Mig.Core.Types + +-- | Low-level plugin function. +type PluginFun m = ServerFun m -> ServerFun m + +{-| Plugin can convert all routes of the server. +It is wrapper on top of @ServerFun m -> ServerFun m@. +We can apply plugins to servers with @applyPlugin@ function +also plugin has Monoid instance which is like Monoid.Endo or functional composition @(.)@. +-} +data Plugin m = Plugin + { info :: RouteInfo -> RouteInfo + -- ^ update api schema + , run :: PluginFun m + -- ^ run the plugin + } + +instance Monoid (Plugin m) where + mempty = Plugin id id + +instance Semigroup (Plugin m) where + (<>) a b = Plugin (a.info . b.info) (a.run . b.run) + +-- | Infix operator for @applyPlugin@ +($:) :: forall f. (ToPlugin f) => f -> Server (MonadOf f) -> Server (MonadOf f) +($:) = applyPlugin + +-- | Applies plugin to all routes of the server. +applyPlugin :: forall f. (ToPlugin f) => f -> Server (MonadOf f) -> Server (MonadOf f) +applyPlugin a = mapRouteInfo (toPluginInfo @f) . mapServerFun (toPluginFun a) + +{-| Values that can represent a plugin. +We use various newtype-wrappers to query type-safe info from request. +-} +class (MonadIO (MonadOf f)) => ToPlugin f where + toPluginInfo :: RouteInfo -> RouteInfo + toPluginFun :: f -> ServerFun (MonadOf f) -> ServerFun (MonadOf f) + +-- | Convert plugin-like value to plugin. +toPlugin :: forall f. (ToPlugin f) => f -> Plugin (MonadOf f) +toPlugin a = Plugin (toPluginInfo @f) (toPluginFun a) + +-- identity +instance (MonadIO m) => ToPlugin (PluginFun m) where + toPluginInfo = id + toPluginFun = id + +instance (MonadIO m) => ToPlugin (Plugin m) where + toPluginInfo = id + toPluginFun = (.run) + +fromPluginFun :: (MonadIO m) => PluginFun m -> Plugin m +fromPluginFun = toPlugin + +-- path info +instance (ToPlugin a) => ToPlugin (PathInfo -> a) where + toPluginInfo = id + toPluginFun f = \fun -> withPathInfo (\path -> toPluginFun (f (PathInfo path)) fun) + +-- path info +instance (ToPlugin a) => ToPlugin (IsSecure -> a) where + toPluginInfo = id + toPluginFun f = \fun -> \req -> (toPluginFun (f (IsSecure req.isSecure)) fun) req + +instance (ToPlugin a) => ToPlugin (RawRequest -> a) where + toPluginInfo = id + toPluginFun f = \fun -> \req -> (toPluginFun (f (RawRequest req)) fun) req + +-- | Read low-level response. Note that it does not affect the API schema +newtype RawResponse = RawResponse (Maybe Response) + +instance (ToPlugin a) => ToPlugin (RawResponse -> a) where + toPluginInfo = id + toPluginFun f = \fun -> \req -> do + resp <- fun req + (toPluginFun (f (RawResponse resp)) fun) req + +-- request body +instance (FromReqBody ty a, ToSchema a, ToPlugin b) => ToPlugin (Body ty a -> b) where + toPluginInfo = addBodyInfo @ty @a . toPluginInfo @b + toPluginFun f = \fun -> withBody @ty (\body -> toPluginFun (f (Body body)) fun) + +-- header +instance (FromHttpApiData a, ToParamSchema a, ToPlugin b, KnownSymbol sym) => ToPlugin (Header sym a -> b) where + toPluginInfo = addHeaderInfo @sym @a . toPluginInfo @b + toPluginFun f = \fun -> withHeader (getName @sym) (\a -> toPluginFun (f (Header a)) fun) + +-- optional header +instance (FromHttpApiData a, ToParamSchema a, ToPlugin b, KnownSymbol sym) => ToPlugin (OptionalHeader sym a -> b) where + toPluginInfo = addOptionalHeaderInfo @sym @a . toPluginInfo @b + toPluginFun f = \fun -> withOptionalHeader (getName @sym) (\a -> toPluginFun (f (OptionalHeader a)) fun) + +-- query +instance (FromHttpApiData a, ToParamSchema a, ToPlugin b, KnownSymbol sym) => ToPlugin (Query sym a -> b) where + toPluginInfo = addQueryInfo @sym @a . toPluginInfo @b + toPluginFun f = \fun -> withQuery (getName @sym) (\a -> toPluginFun (f (Query a)) fun) + +-- optional query +instance (FromHttpApiData a, ToParamSchema a, ToPlugin b, KnownSymbol sym) => ToPlugin (Optional sym a -> b) where + toPluginInfo = addOptionalInfo @sym @a . toPluginInfo @b + toPluginFun f = \fun -> withOptional (getName @sym) (\a -> toPluginFun (f (Optional a)) fun) + +-- capture +instance (FromHttpApiData a, ToParamSchema a, ToPlugin b, KnownSymbol sym) => ToPlugin (Capture sym a -> b) where + toPluginInfo = addCaptureInfo @sym @a . toPluginInfo @b + toPluginFun f = \fun -> withCapture (getName @sym) (\a -> toPluginFun (f (Capture a)) fun) + +-- query flag +instance (ToPlugin b, KnownSymbol sym) => ToPlugin (QueryFlag sym -> b) where + toPluginInfo = addQueryFlagInfo @sym . toPluginInfo @b + toPluginFun f = \fun -> withQueryFlag (getName @sym) (\a -> toPluginFun (f (QueryFlag a)) fun) + +--------------------------------------------- +-- specific plugins + +-- | Prepends action to the server +prependServerAction :: forall m. (MonadIO m) => m () -> Plugin m +prependServerAction act = toPlugin go + where + go :: ServerFun m -> ServerFun m + go f = \req -> do + act + f req + +-- | Post appends action to the server +appendServerAction :: forall m. (MonadIO m) => m () -> Plugin m +appendServerAction act = toPlugin go + where + go :: ServerFun m -> ServerFun m + go f = \req -> do + resp <- f req + act + pure resp + +-- | Applies transformation to the response +processResponse :: forall m. (MonadIO m) => (m (Maybe Response) -> m (Maybe Response)) -> Plugin m +processResponse act = toPlugin go + where + go :: ServerFun m -> ServerFun m + go f = \req -> do + act (f req) + +-- | Execute request only if it is secure (made with SSL connection) +whenSecure :: forall m. (MonadIO m) => Plugin m +whenSecure = toPlugin $ \(IsSecure isSecure) -> + processResponse (if isSecure then id else const (pure Nothing)) + +-- | Sets default response if server response with Nothing. If it can not handle the request. +processNoResponse :: forall m a. (MonadIO m, IsResp a) => m a -> Plugin m +processNoResponse defaultResponse = toPlugin go + where + go :: PluginFun m + go fun = \req -> do + mResp <- fun req + case mResp of + Just resp -> pure (Just resp) + Nothing -> Just . toResponse <$> defaultResponse + +--------------------------------------------- +-- utils + +getName :: forall sym a. (KnownSymbol sym, IsString a) => a +getName = fromString (symbolVal (Proxy @sym)) From e172f589d13384eb5e0ec930ea01449120b1d513 Mon Sep 17 00:00:00 2001 From: Anton Kholomiov Date: Thu, 19 Oct 2023 14:04:56 +0300 Subject: [PATCH 2/3] Rename Middleware to Plugin in docs --- docs/src/02-request-anatomy.md | 26 ++++---- docs/src/{05-middleware.md => 05-plugin.md} | 66 ++++++++++----------- docs/src/06-json-api-example.md | 12 ++-- docs/src/08-reference.md | 20 +++---- docs/src/SUMMARY.md | 2 +- todo.md | 1 - 6 files changed, 63 insertions(+), 64 deletions(-) rename docs/src/{05-middleware.md => 05-plugin.md} (68%) diff --git a/docs/src/02-request-anatomy.md b/docs/src/02-request-anatomy.md index 1d13bae..b80d6c9 100644 --- a/docs/src/02-request-anatomy.md +++ b/docs/src/02-request-anatomy.md @@ -407,38 +407,38 @@ is fine. ### Add simple logs to the server We can look at the request and trsponse data with tracing functions -which come from library `mig-extra` from the module `Mig.Extra.Middleware.Trace`: +which come from library `mig-extra` from the module `Mig.Extra.Plugin.Trace`: ```haskell data Verbosity = V0 | V1 | V2 | V3 -- log http requests and responses -logHttp :: Verbosity -> Middleware m +logHttp :: Verbosity -> Plugin m -- | log requests -logReq :: Verbosity -> Middleware m +logReq :: Verbosity -> Plugin m -- | Log responses -logResp :: Verbosity -> Middleware m +logResp :: Verbosity -> Plugin m ``` -The `Middleware m` is a function that can be applied to all routes of the server -and modify their behavior. To apply middleware to server we can use functions: +The `Plugin m` is a function that can be applied to all routes of the server +and modify their behavior. To apply plugin to server we can use functions: ```haskell -applyMiddleware :: Middleware m -> Server m -> Server m +applyPlugin :: Plugin m -> Server m -> Server m -($:) :: Middleware m -> Server m -> Server m +($:) :: Plugin m -> Server m -> Server m ``` We show simplified signatures here. The real ones are overloaded by the first argument. -but we will dicuss middlewares in depth in the separate chapter. For now it's +but we will dicuss plugins in depth in the separate chapter. For now it's ok to assume that those functions are defined in that simplified way. So let's look at the data that goes through our server: ```haskell -import Mig.Extra.Middleware.Trace qualified as Trace +import Mig.Extra.Plugin.Trace qualified as Trace ... @@ -446,7 +446,7 @@ server = withSwagger def $ withTrace $ {-# the rest of the server code #-} where - withTrace = applyMiddleware (Trace.logHttp Trace.V2) + withTrace = applyPlugin (Trace.logHttp Trace.V2) ``` Let's restart the server and see what it logs: @@ -484,7 +484,7 @@ of one of the standard haskell logging libraries, say `katip` or `fast-logger`: ```haskell import Data.Aeson as Json -logHttpBy :: (Json.Value -> m ()) -> Verbosity -> Middleware m +logHttpBy :: (Json.Value -> m ()) -> Verbosity -> Plugin m ``` ## Summary @@ -510,7 +510,7 @@ we have learned how by ony-liners we can add to the server some useful features: * swagger: `(withSwagger def server)` For calls to the server in the UI -* trace logs: `(applyMiddleware (logHttp V2))` +* trace logs: `(applyPlugin (logHttp V2))` To see the data that flows through the server Both expressions transform servers and have signatures: diff --git a/docs/src/05-middleware.md b/docs/src/05-plugin.md similarity index 68% rename from docs/src/05-middleware.md rename to docs/src/05-plugin.md index c998fa4..e3d1870 100644 --- a/docs/src/05-middleware.md +++ b/docs/src/05-plugin.md @@ -1,51 +1,51 @@ -# Middlewares +# Plugins -A middleware is a transformation which is applied to all routes in the server. +A plugin is a transformation which is applied to all routes in the server. It is a pair of functions which transform API-description and server function: ```haskell -data Middleware m = Middleware +data Plugin m = Plugin { info :: RouteInfo -> RouteInfo -- ^ update api schema - , run :: MiddlewareFun m + , run :: PluginFun m -- ^ update server function } --- | Low-level middleware function. -type MiddlewareFun m = ServerFun m -> ServerFun m +-- | Low-level plugin function. +type PluginFun m = ServerFun m -> ServerFun m ``` -To apply middleware to server we ca use function `applyMiddleware`: +To apply plugin to server we ca use function `applyPlugin`: ```haskell --- | Applies middleware to all routes of the server. -applyMiddleware :: forall f. (ToMiddleware f) => +-- | Applies plugin to all routes of the server. +applyPlugin :: forall f. (ToPlugin f) => f -> Server (MonadOf f) -> Server (MonadOf f) ``` There is also infix operatore for application `($:)`. -The class `ToMiddleware` contains all types that can be converted to middleware. +The class `ToPlugin` contains all types that can be converted to plugin. Here we use the same trick as with `ToServer` class to be able to read type-safe parts of the request and update the API-schema. The type-level function `MonadOf` knows how to find underlying monad `m` in various types. -We have recursive set of rules for types that can be converted to `Middleware`: +We have recursive set of rules for types that can be converted to `Plugin`: The identity rule: -> `MiddlewareFun` has instance of `ToMiddleware` with obvious identity instance +> `PluginFun` has instance of `ToPlugin` with obvious identity instance Recursive steps for inputs -> if `f` is `ToMiddleware` then `(Query name queryType -> f)` is `ToMiddleware` too +> if `f` is `ToPlugin` then `(Query name queryType -> f)` is `ToPlugin` too and so on for other types of request input (query params, headers, captures, request bodies). -See the full list of instances in the module `Mig.Core.Class.Middleware`. +See the full list of instances in the module `Mig.Core.Class.Plugin`. ## Examples -So the middleware allows us to apply some behavior to all routes in the server. +So the plugin allows us to apply some behavior to all routes in the server. Let's discuss some examples ### Add logging @@ -65,15 +65,15 @@ We can query the path with `PathInfo` newtype: newtype PathInfo = PathInfo [Text] ``` -And we have a rule for `ToMiddleware` class: +And we have a rule for `ToPlugin` class: -> if `f` is `ToMiddleware` then `(PathInfo -> ToMiddleware f)` is `ToMiddleware` +> if `f` is `ToPlugin` then `(PathInfo -> ToPlugin f)` is `ToPlugin` -so we can create a middleware function: +so we can create a plugin function: ```haskell -logRoutes :: Middleware IO -logRoutes = toMiddleware $ \(PathInfo pathItems) -> prependServerAction $ do +logRoutes :: Plugin IO +logRoutes = toPlugin $ \(PathInfo pathItems) -> prependServerAction $ do now <- getCurrentTime logInfo $ mconcat [ "Call route: ", Text.intercalata "/" pathItems @@ -81,35 +81,35 @@ logRoutes = toMiddleware $ \(PathInfo pathItems) -> prependServerAction $ do ] ``` -We use function `prependServerAction` that creates a `Middleware` +We use function `prependServerAction` that creates a `Plugin` from actino which is performed prior to call to server function: ```haskell -prependServerAction :: MonadIO m => m () -> Middleware m +prependServerAction :: MonadIO m => m () -> Plugin m ``` also there are similar functions in the module: `appendServerAction` and `processResponse`. ### Allow only secure routes -Another great example of middleware at work is to block routes on some conditions. +Another great example of plugin at work is to block routes on some conditions. For example if we want certain routes to be used only under secure SSL connection. We have a standard function for that `whenSecure`. But let's dive into it's definition to -see how middlewares can be used: +see how plugins can be used: ```haskell -- | Execute request only if it is secure (made with SSL connection) -whenSecure :: forall m. (MonadIO m) => Middleware m -whenSecure = toMiddleware $ \(IsSecure isSecure) -> +whenSecure :: forall m. (MonadIO m) => Plugin m +whenSecure = toPlugin $ \(IsSecure isSecure) -> processResponse (if isSecure then id else const (pure Nothing)) ``` -Here we use standard middleware `processResponse` which allows +Here we use standard plugin `processResponse` which allows us to alter the result of the HTTP-response: ```haskell processResponse :: MonadIO m => - (m (Maybe Response) -> m (Maybe Response)) -> Middleware m + (m (Maybe Response) -> m (Maybe Response)) -> Plugin m ``` Also we use query input `IsSecure` which is true if connection is made over SSL: @@ -123,7 +123,7 @@ and we block the execution by returning `Nothing` if connection is secure. The cool part of it is that due to Haskell's laziness there is no performance overhead and underlying route is not going to be performed if connection is insecure. -### Authorization with middleware +### Authorization with plugin Let's use this schema for authorization to site. There is a route that provides authorized users with session tokens. @@ -155,7 +155,7 @@ We can create it in similiar way as `whenSecure`: isValid :: AuthToken -> IO Bool isValid = ... -headerAuth :: Header "auth" AuthToken -> Middleware IO +headerAuth :: Header "auth" AuthToken -> Plugin IO headerAuth (Header token) = processResponse $ \getResp -> do isOk <- isValid token if isOk @@ -163,15 +163,15 @@ headerAuth (Header token) = processResponse $ \getResp -> do else pure $ Just $ bad badRequest400 "Auth token is invalid" whenAuth :: Server IO -> Server IO -whenAuth = applyMiddleware headerAuth +whenAuth = applyPlugin headerAuth ``` In this example we use `IsResp` instance for low-level http `Response` to report authorization error. The header with name `"auth"` is required -for all routes which are part of the server to which we apply the middleware. +for all routes which are part of the server to which we apply the plugin. ## Summary -In this chapter we have learned on middlewares. They provide a tool to apply +In this chapter we have learned on plugins. They provide a tool to apply transformation to all routes in the server. Which can be useful for logging, authrization and adding common behavior to all routes. diff --git a/docs/src/06-json-api-example.md b/docs/src/06-json-api-example.md index ce0260b..187feef 100644 --- a/docs/src/06-json-api-example.md +++ b/docs/src/06-json-api-example.md @@ -134,7 +134,7 @@ updateWeather = undefined requestAuthToken :: Env -> Body User -> Post (RespOr Text AuthToken) requestAuthToken = undefined -withAuth :: Env -> Header "auth" AuthToken -> Middleware IO +withAuth :: Env -> Header "auth" AuthToken -> Plugin IO withAuth = undefined ``` @@ -160,10 +160,10 @@ updateWeather :: Post (RespOr Text ()) ``` -also we have a middleware that filters out non aunthorized calls: +also we have a plugin that filters out non aunthorized calls: ```haskell -withAuth :: Env -> Header "auth" AuthToken -> Middleware IO +withAuth :: Env -> Header "auth" AuthToken -> Plugin IO ``` From its type-signature we can assume that authroization token @@ -353,11 +353,11 @@ that hnadles the request. If user has no rights to use our service we report err Let's check for authorization tokens. Ideally we would like to add this action to all handlers of our application. We would like to keep the business logic handlers for the weather domain the same. -And we can do it with middleware. Let's define such a middleware +And we can do it with plugin. Let's define such a plugin that expects authorization tokens with required header: ```haskell -withAuth :: Env -> Header "auth" AuthToken -> Middleware IO +withAuth :: Env -> Header "auth" AuthToken -> Plugin IO withAuth env (Header token) = processResponse $ \getResp -> do isOk <- env.auth.validToken token if isOk @@ -369,7 +369,7 @@ withAuth env (Header token) = processResponse $ \getResp -> do errMessage = "Token is invalid" ``` -we have covered in depth how to implement it in the chapter on Middlewares +we have covered in depth how to implement it in the chapter on Plugins so this code should look familiar to us. diff --git a/docs/src/08-reference.md b/docs/src/08-reference.md index 3e250a9..828e661 100644 --- a/docs/src/08-reference.md +++ b/docs/src/08-reference.md @@ -149,13 +149,13 @@ notImplemented :: (IsResp a) => RespError a -> a redirect :: (IsResp a) => Text -> a ``` -### Middlewares +### Plugins ```haskell -applyMiddleware, ($:) :: ToMiddleware a => +applyPlugin, ($:) :: ToPlugin a => a -> Server (MonadOf a) -> Server (MonadOf a) --- composition of middlewares: +-- composition of plugins: Monoid(..): mconcat, (<>), mempty ``` @@ -172,27 +172,27 @@ addPathLink :: Path -> Path -> Server m staticFiles :: [(FilePath, ByteString)] -> Server m ``` -### specific middlewares +### specific plugins ```haskell -- prepend or append some acction to all routes -prependServerAction, appendServerAction :: MonadIO m => m () -> Middleware m +prependServerAction, appendServerAction :: MonadIO m => m () -> Plugin m -- change the response -processResponse :: (m (Maybe Response) -> m (Maybe Response)) -> Middleware m +processResponse :: (m (Maybe Response) -> m (Maybe Response)) -> Plugin m -- only secure routes are allowed -whenSecure :: forall m. (MonadIO m) => Middleware m +whenSecure :: forall m. (MonadIO m) => Plugin m -- logging with putStrLn for debug traces -logHttp :: Verbosity -> Middleware m +logHttp :: Verbosity -> Plugin m -- logging with custom logger -logHttpBy :: (Json.Value -> m ()) -> Verbosity -> Middleware m +logHttpBy :: (Json.Value -> m ()) -> Verbosity -> Plugin m -- | simple authorization -withHeaderAuth :: WithHeaderAuth -> Middleware m +withHeaderAuth :: WithHeaderAuth -> Plugin m ``` ### How to use Reader diff --git a/docs/src/SUMMARY.md b/docs/src/SUMMARY.md index 44fbe9f..c653665 100644 --- a/docs/src/SUMMARY.md +++ b/docs/src/SUMMARY.md @@ -6,7 +6,7 @@ - [Anatomy of the request](./02-request-anatomy.md) - [Anatomy of the response](./03-response-anatomy.md) - [Using other monads](./04-other-monads.md) -- [Middlewares](./05-middleware.md) +- [Plugins](./05-plugin.md) - [Using Swagger](./06-swagger.md) - [JSON application: weather forecast](./06-json-api-example.md) - [HTML example: blog site](./07-blog-post-example.md) diff --git a/todo.md b/todo.md index e27adc8..e61b6f2 100644 --- a/todo.md +++ b/todo.md @@ -5,7 +5,6 @@ Features, improvements and open problems for releases: ### Curent: v2 -* rename `Middleware` to `Plugin` as it is less mouthful. * update external handler and reader apps examples * add TH for deriving of all classes by type: `IsParam`, `IsBody`, `IsParaBody`, `IsReaderServer` * deriveParam ''Type From daa371604a491c8ad8b12e89fe2d893a74c92fb2 Mon Sep 17 00:00:00 2001 From: Anton Kholomiov Date: Thu, 19 Oct 2023 14:05:26 +0300 Subject: [PATCH 3/3] Fix typo --- docs/src/08-reference.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/docs/src/08-reference.md b/docs/src/08-reference.md index 828e661..a6b3159 100644 --- a/docs/src/08-reference.md +++ b/docs/src/08-reference.md @@ -49,16 +49,16 @@ runServer' :: ServerConfig -> Int -> Server IO -> IO () ### Request inputs ```haskell --- rewquired query parameter +-- required query parameter newtype Body media value = Body value --- rewquired query parameter +-- required query parameter newtype Query name value = Query value -- optional query parameter newtype Optional name value = Optional (Maybe value) --- rewquired header parameter +-- required header parameter newtype Header name value = Header value -- optional header parameter