diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,21 @@
+The MIT License (MIT)
+
+Copyright (c) 2020 digitally induced GmbH
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
diff --git a/Network/Wai/Middleware/FlashMessages.hs b/Network/Wai/Middleware/FlashMessages.hs
new file mode 100644
--- /dev/null
+++ b/Network/Wai/Middleware/FlashMessages.hs
@@ -0,0 +1,131 @@
+module Network.Wai.Middleware.FlashMessages
+( setSuccessMessage
+, setErrorMessage
+, getSuccessMessage
+, clearSuccessMessage
+, consumeFlashMessagesMiddleware
+, FlashMessage (..)
+, requestFlashMessages
+)
+where
+
+import Prelude
+import Network.Wai
+import Data.ByteString
+import qualified Data.Serialize as Serialize
+import Data.Serialize.Text ()
+import qualified Data.Vault.Lazy as Vault
+import qualified Network.Wai.Session as Session
+import qualified Data.Maybe as Maybe
+import Data.Text (Text)
+
+data FlashMessage
+ = SuccessFlashMessage !Text
+ | ErrorFlashMessage !Text
+
+type SessionVaultKey = Vault.Key (Session.Session IO ByteString ByteString)
+type FlashVaultKey = Vault.Key [FlashMessage]
+
+-- | Sets a flash messages. This is shown to the user when the next view is rendered.
+--
+-- Will be rendered in a bootstrap alert, with the @alert-success@ styling.
+-- Take a look at https://getbootstrap.com/docs/4.5/components/alerts/ for how this will look like.
+--
+-- This requires 'IHP.ViewSupport.renderFlashMessages' to be placed somewhere in the layout or page of the next view.
+-- For example:
+--
+-- > myLayout view = [hsx|
+-- > {renderFlashMessages}
+-- > {view}
+-- > |]
+setSuccessMessage :: SessionVaultKey -> Request -> Text -> IO ()
+setSuccessMessage vaultKey request message =
+ sessionInsertText vaultKey request successMessageKey message
+
+-- | Sets a flash messages. This is shown to the user when the next view is rendered.
+--
+-- Will be rendered in a bootstrap alert, with the @alert-danger@ styling.
+-- Take a look at https://getbootstrap.com/docs/4.5/components/alerts/ for how this will look like.
+--
+-- This requires 'IHP.ViewSupport.renderFlashMessages' to be placed somewhere in the layout or page of the next view.
+-- For example:
+--
+-- > myLayout view = [hsx|
+-- > {renderFlashMessages}
+-- > {view}
+-- > |]
+setErrorMessage :: SessionVaultKey -> Request -> Text -> IO ()
+setErrorMessage vaultKey request message =
+ sessionInsertText vaultKey request errorMessageKey message
+
+-- | Returns the flash message currently set
+getSuccessMessage :: SessionVaultKey -> Request -> IO (Maybe Text)
+getSuccessMessage vaultKey request =
+ sessionLookupText vaultKey request successMessageKey
+
+-- | Removes the current flash message
+clearSuccessMessage :: SessionVaultKey -> Request -> IO ()
+clearSuccessMessage vaultKey request =
+ setSuccessMessage vaultKey request ""
+
+successMessageKey :: ByteString
+successMessageKey = "flashSuccessMessage"
+
+errorMessageKey :: ByteString
+errorMessageKey = "flashErrorMessage"
+
+{-# INLINE consumeFlashMessagesMiddleware #-}
+consumeFlashMessagesMiddleware :: SessionVaultKey -> FlashVaultKey -> Middleware
+consumeFlashMessagesMiddleware sessionVaultKey flashVaultKey next request respond =
+ case Vault.lookup sessionVaultKey request.vault of
+ Just (lookup, insert) -> do
+ rawSuccess <- lookup successMessageKey
+ rawError <- lookup errorMessageKey
+
+ case (rawSuccess, rawError) of
+ (Nothing, Nothing) ->
+ -- No flash messages set, skip decoding/clearing/vault-insert
+ next request respond
+ _ -> do
+ let decodeAndClear name rawValue = do
+ case rawValue of
+ Just value -> do
+ insert name "" -- Clear the flash message
+ pure case Serialize.decode value of
+ Left _ -> Nothing
+ Right text -> Just text
+ Nothing -> pure Nothing
+
+ successMessage <- decodeAndClear successMessageKey rawSuccess
+ errorMessage <- decodeAndClear errorMessageKey rawError
+
+ let
+ allFlashMessages = Maybe.catMaybes ((fmap SuccessFlashMessage successMessage):(fmap ErrorFlashMessage errorMessage):[])
+ request' = request { vault = Vault.insert flashVaultKey allFlashMessages request.vault }
+
+ next request' respond
+ Nothing -> next request respond
+
+requestFlashMessages :: FlashVaultKey -> Request -> Maybe [FlashMessage]
+requestFlashMessages flashVaultKey request =
+ Vault.lookup flashVaultKey request.vault
+
+sessionInsertText :: SessionVaultKey -> Request -> ByteString -> Text -> IO ()
+sessionInsertText vaultKey request name value =
+ let insert = snd (requestSessionVault vaultKey request)
+ in insert name (Serialize.encode value)
+
+sessionLookupText :: SessionVaultKey -> Request -> ByteString -> IO (Maybe Text)
+sessionLookupText vaultKey request name = do
+ value <- fst (requestSessionVault vaultKey request) $ name
+ pure case value of
+ Just value -> case Serialize.decode value of
+ Left error -> Nothing
+ Right value -> Just value
+ Nothing -> Nothing
+
+requestSessionVault :: SessionVaultKey -> Request -> (ByteString -> IO (Maybe ByteString), ByteString -> ByteString -> IO ())
+requestSessionVault vaultKey request =
+ case Vault.lookup vaultKey request.vault of
+ Just session -> session
+ Nothing -> error "requestSessionVault: The session vault is missing in the request"
diff --git a/wai-flash-messages.cabal b/wai-flash-messages.cabal
new file mode 100644
--- /dev/null
+++ b/wai-flash-messages.cabal
@@ -0,0 +1,29 @@
+cabal-version: 2.2
+name: wai-flash-messages
+version: 1.0.0
+synopsis: Flash messages for wai apps
+description: Flash messages middleware for WAI
+license: MIT
+license-file: LICENSE
+author: digitally induced GmbH
+maintainer: support@digitallyinduced.com
+bug-reports: https://github.com/digitallyinduced/ihp/issues
+category: Web
+build-type: Simple
+
+source-repository head
+ type: git
+ location: https://github.com/digitallyinduced/ihp.git
+
+library
+ default-language: GHC2021
+ default-extensions:
+ OverloadedRecordDot
+ DuplicateRecordFields
+ DisambiguateRecordFields
+ BlockArguments
+ OverloadedStrings
+ ghc-options: -Werror=incomplete-patterns -Werror=unused-imports -Werror=missing-fields
+ build-depends: base >= 4.17.0 && < 4.22, text, wai, vault, cereal, cereal-text, bytestring, wai-session
+ hs-source-dirs: .
+ exposed-modules: Network.Wai.Middleware.FlashMessages