auto-update: Sync exceptions in auto-update stops auto-update loops indefinitely

[arianvp]

Observed behaviour

When getKeys (our updateAction) throws an exception on the second request, the request to autoUpdatingGetKeys hangs indefinitely. Any follow-up requests fail with the following error:

Control.AutoUpdate.mkAutoUpdate: worker thread exited with exception: divide by zero
CallStack (from HasCallStack):
  error, called at ./Control/AutoUpdate.hs:139:48 in auto-update-0.1.6-KsptkzhzORuBNp20wquSMB:Control.AutoUpdate

Expected Behaviour

Reading the source code of auto-update the code claims that the worker thread should
only be able to exit in case of an unexpected async exception (and even says that the only case
that can happen is RTS exceptions). However in this case it also exits when updateAction throws
a synchronous exception. This feels like a bug to me.

Reproducer

# terminal 1
$ cabal run reproducer

# terminal 2
$ curl http://localhost:8080
hello%                                                                                       
$ curl http://localhost:8080
hello%                                                                                       
$ curl http://localhost:8080
^C
$ curl http://localhost:8080
Something went wrong% 

Now on terminal 1 you will see:

Control.AutoUpdate.mkAutoUpdate: worker thread exited with exception: divide by zero
CallStack (from HasCallStack):
  error, called at ./Control/AutoUpdate.hs:139:48 in auto-update-0.1.6-KsptkzhzORuBNp20wquSMB:Control.AutoUpdate

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.AutoUpdate
  ( UpdateSettings (updateAction),
    defaultUpdateSettings,
    mkAutoUpdate,
  )
import Control.Exception (ArithException (DivideByZero), throwIO)
import Data.ByteString.Lazy (ByteString)
import Network.HTTP.Types (status200)
import Network.Wai (Application, responseLBS)
import Network.Wai.Handler.Warp (run)
import GHC.IORef ( IORef, newIORef, readIORef, writeIORef )

main :: IO ()
main = do
  state <- newIORef  Ok
  getKeys' <- autoUpdatingGetKeys state
  run 8080 $ app getKeys'

data State = Ok | NotOk deriving (Enum)

autoUpdatingGetKeys :: IORef State -> IO (IO ByteString)
autoUpdatingGetKeys state = mkAutoUpdate (defaultUpdateSettings {updateAction = getKeys state})

getKeys :: IORef State -> IO ByteString
getKeys state = do
  s <- readIORef state
  case s of
    Ok -> do
      writeIORef state NotOk
      return "hello"
    NotOk -> do
      writeIORef state Ok
      throwIO DivideByZero

app :: IO ByteString -> Application
app getKeys' _ respond = do
  response <- getKeys'
  respond $ responseLBS status200 [] response

Versions used:

ghc-9.0.2

    Cabal-3.4.1.0
    appar-0.1.8
    array-0.5.4.0
    asn1-encoding-0.9.6
    asn1-parse-0.9.5
    asn1-types-0.3.4
    async-2.2.4
    attoparsec-0.14.4
    z-attoparsec-z-attoparsec-internal-0.14.4
    auto-update-0.1.6
    base-4.15.1.0
    base64-bytestring-1.2.1.0
    basement-0.0.14
    binary-0.8.8.0
    blaze-builder-0.4.2.2
    bsb-http-chunked-0.0.0.4
    byteorder-1.0.4
    bytestring-0.10.12.1
    case-insensitive-1.2.1.0
    containers-0.6.4.1
    cookie-0.4.5
    cryptonite-0.29
    data-default-class-0.1.2.0
    deepseq-1.4.5.0
    directory-1.3.6.2
    exceptions-0.10.4
    filepath-1.4.2.1
    ghc-9.0.2
    ghc-bignum-1.1
    ghc-boot-9.0.2
    ghc-boot-th-9.0.2
    ghc-compact-0.1.0.0
    ghc-heap-9.0.2
    ghc-prim-0.7.0
    ghci-9.0.2
    hashable-1.3.5.0
    haskeline-0.8.2
    hourglass-0.2.12
    hpc-0.6.1.0
    http-client-0.7.11
    http-date-0.0.11
    http-types-0.12.3
    http2-3.0.3
    integer-gmp-1.1
    integer-logarithms-1.0.3.1
    iproute-1.7.12
    libiserv-9.0.2
    memory-0.16.0
    mime-types-0.1.0.9
    mtl-2.2.2
    network-3.1.2.7
    network-byte-order-0.1.6
    network-uri-2.6.4.1
    old-locale-1.0.0.7
    old-time-1.1.0.3
    parsec-3.1.14.0
    pem-0.2.4
    pretty-1.1.3.6
    primitive-0.7.3.0
    process-1.6.13.2
    psqueues-0.2.7.3
    random-1.2.1.1
    rts-1.0.2
    scientific-0.3.7.0
    simple-sendfile-0.2.30
    splitmix-0.1.0.4
    stm-2.5.0.0
    streaming-commons-0.2.2.4
    template-haskell-2.17.0.0
    terminfo-0.4.1.5
    text-1.2.5.0
    th-compat-0.1.3
    time-1.9.3
    time-manager-0.0.0
    transformers-0.5.6.2
    unix-2.7.2.2
    unix-compat-0.5.4
    unix-time-0.4.7
    unliftio-0.2.22.0
    unliftio-core-0.2.0.1
    unordered-containers-0.2.17.0
    vault-0.3.1.5
    wai-3.2.3
    warp-3.3.20
    word8-0.1.3
    x509-1.7.6
    xhtml-3000.2.2.1
    zlib-0.6.3.0
    ```

[arianvp]

The usage of this in warp is to get the current time - which never throws an exception. So perhaps the code wasn't written
with the intent to be resilient against exceptions like I thought?

[snoyberg]

No, it wasn't. It was designed for speed, and leaves exception handling to the called function. That's an oversight in the current documentation, PR certainly welcome to clarify that.

[arianvp]

I'll make a documentation PR