在 http 请求之间保持状态

Question

假设我有一个位于 Scotty 的 http 服务器

scottyServer :: IO ()
scottyServer = do
    print ("Starting Server at port " ++ show port)
    scotty port routes

routes :: ScottyM()
routes = do get "/service" responseService
            get "/users" responseUsers

然后我有一个断路器，我想保持状态CircuitBreakerType

data CircuitBreakerType
  = Close {users::[User], error:: Integer}
  | Open {users::[User], error:: Integer}
  | HalfOpen {users::[User], error:: Integer}
  deriving (Show)

responseUsers :: ActionM ()
responseUsers = do users <- liftAndCatchIO $ searchAllCassandraUsersCB $ Close [] 0
                   json (show users)

searchAllCassandraUsersCB :: CircuitBreakerType ->  IO CircuitBreakerType
searchAllCassandraUsersCB (Close users errors)= do result <- selectAllCassandraUserCB $ Close users errors
                                                   return result

使用 Haskell 如何在 Scootty 的请求/响应之间保持 CircuitBreakerType 的状态

我所做的所有状态机示例都是将 IO monad 中的状态传递给另一个，但是对于 Http 服务器，我不知道如何保持状态。希望与数据库中的持久性无关，因为性能会很糟糕。

问候

Answer 1

在这种情况下，部分应用程序是您的朋友。在 C 语言中，如果您可能使用有罪的全局变量，您可以改为在父（主）例程中显式声明您的值（引用），然后通过部分应用程序将其传递给您的 Web 路由处理程序。

{-# LANGUAGE OverloadedStrings #-}
import Web.Scotty
import Control.Monad.IO.Class
import Data.IORef

port = 8080

scottyServer :: IO ()
scottyServer = do
    print ("Starting Server at port " ++ show port)
    ref <- newState initialState
    scotty port (routes ref)

routes :: MyStateRef -> ScottyM()
routes ref = get "/users" (responseUsers ref)

responseUsers :: MyStateRef -> ActionM ()
responseUsers ref = do x <- statefulStuff ref
                       json (show x)

--------------------------------------------------------------------------------
--  Stateful things

initialState :: Int
initialState = 0
type MyState = Int
type MyStateRef = IORef Int -- Could be TVar, MVar, DB address, etc

newState :: MonadIO m => MyState -> m MyStateRef
newState = liftIO . newIORef

statefulStuff :: MonadIO m => MyStateRef -> m MyState
statefulStuff ref =
 do x <- liftIO (readIORef ref)
    -- N.B. lack of atomicity - that isn't the point of this answer
    let y = x + 1
    y `seq` liftIO (writeIORef ref y)
    pure y