module IHP.RequestVault.ModelContext
( -- * ModelContext
  modelContextVaultKey
, modelContextMiddleware
, requestModelContext
  -- * RequestBody (re-exported from RequestBodyMiddleware)
, RequestBody (..)
, requestBodyVaultKey
) where

import GHC.Records (HasField(..))
import Network.Wai
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.Vault.Lazy as Vault
import IHP.ModelSupport.Types (ModelContext)
import IHP.RequestVault.Helper
import Wai.Request.Params.Middleware (RequestBody (..), requestBodyVaultKey)

-- request.modelContext
modelContextVaultKey :: Vault.Key ModelContext
modelContextVaultKey :: Key ModelContext
modelContextVaultKey = IO (Key ModelContext) -> Key ModelContext
forall a. IO a -> a
unsafePerformIO IO (Key ModelContext)
forall a. IO (Key a)
Vault.newKey
{-# NOINLINE modelContextVaultKey #-}

{-# INLINE modelContextMiddleware #-}
modelContextMiddleware :: ModelContext -> Middleware
modelContextMiddleware :: ModelContext -> Middleware
modelContextMiddleware = Key ModelContext -> ModelContext -> Middleware
forall value. Key value -> value -> Middleware
insertVaultMiddleware Key ModelContext
modelContextVaultKey

{-# INLINE requestModelContext #-}
requestModelContext :: Request -> ModelContext
requestModelContext :: Request -> ModelContext
requestModelContext = Key ModelContext -> Request -> ModelContext
forall value. Typeable value => Key value -> Request -> value
lookupRequestVault Key ModelContext
modelContextVaultKey

-- request.parsedBody
{-# INLINE requestParsedBody #-}
requestParsedBody :: Request -> RequestBody
requestParsedBody :: Request -> RequestBody
requestParsedBody = Key RequestBody -> Request -> RequestBody
forall value. Typeable value => Key value -> Request -> value
lookupRequestVault Key RequestBody
requestBodyVaultKey

-- Field access helpers
instance HasField "modelContext" Request ModelContext where
    {-# INLINE getField #-}
    getField :: Request -> ModelContext
getField Request
request = Request -> ModelContext
requestModelContext Request
request
instance HasField "parsedBody" Request RequestBody where
    {-# INLINE getField #-}
    getField :: Request -> RequestBody
getField Request
request = Request -> RequestBody
requestParsedBody Request
request