Request suspension in Scotty with STM

May 23, 2017

This expands on request suspension in Scotty with MVar by replacing MVar, which can result in deadlocks, with STM.

{-# LANGUAGE OverloadedStrings #-}

import Control.Monad.Trans (liftIO)
import qualified Control.Concurrent.STM as STM
import qualified Control.Monad.Trans.Class as Class
import qualified Data.Text.Lazy as TL
import qualified Web.Scotty as Scotty

main :: IO ()
main = do
  sem <- STM.newTVarIO (Nothing :: Maybe String)
  Scotty.scotty 3000 $ do
    Scotty.get "/suspend" $ do
      key <- liftIO $ STM.atomically $ do
        keyM <- STM.readTVar sem
        case keyM of
          Nothing -> STM.retry
          Just key -> STM.writeTVar sem Nothing >> return key
      Scotty.text $ TL.concat $ [ "Resumed with \""
                                , TL.pack key
                                , "\"."
                                ]
    Scotty.get "/resume/:key" $ do
      key <- Scotty.param "key"
      liftIO $ STM.atomically $ STM.writeTVar sem $ Just key
      Scotty.text $ TL.concat $ [ "Resuming with \""
                                , TL.pack key
                                , "\"."
                                ]