Error with RTS option `--io-manager=native` in `Pantry.Storage.initStorage`

[mpilgrem]

Issue first raised in Stack repository, see commercialhaskell/stack#5851. The suggested workaround in the exception message is not a workaround.

On Windows, the command stack build +RTS --io-manager=native -RTS results in the display of the MigrationFailure PantryException

Encountered error while migrating Pantry database:
    \\.\NUL: hDuplicateTo: illegal operation (handles are incompatible)
Please report this on https://github.com/commercialhaskell/stack/issues
As a workaround you may delete Pantry database in C:\sr\pantry\pantry.sqlite3 triggering its recreation.

This is arising from the Pantry.Storage.initStorage (a wrapper around Pantry.Storage.SQLite.initStorage) in Pantry.withPantryConfig. (Stack uses withPantryConfig in Stack.Config.configFromConfigMonoid.) I am still investigating.

[mpilgrem]

Pantry.SQLite.initStorage includes:

migrates <- withWriteLock (display description) fp $ wrapMigrationFailure $
    withSqliteConnInfo (sqinfo True) $ runSqlConn $
    runMigrationSilent migration

If that is changed to:

  migrates <- withWriteLock (display description) fp $ wrapMigrationFailure $
    withSqliteConnInfo (sqinfo True) $ runSqlConn $ do
      runMigration migration

the issue disappears. Now, Database.Persist.Sql.Migration.runMigrationSilent is:

runMigrationSilent :: MonadUnliftIO m
                   => Migration
                   -> ReaderT SqlBackend m [Text]
runMigrationSilent m = withRunInIO $ \run ->
  hSilence [stderr] $ run $ runMigration' m True

System.IO.Silently.hSilence, from the silently package, has:

mNullDevice :: Maybe FilePath
#ifdef WINDOWS
mNullDevice = Just "\\\\.\\NUL"
#elif UNIX
mNullDevice = Just "/dev/null"
#else
mNullDevice = Nothing
#endif

-- | Run an IO action while preventing all output to the given handles.
hSilence :: forall a. [Handle] -> IO a -> IO a
hSilence handles action =
  case mNullDevice of
    Just nullDevice ->
      E.bracket (openFile nullDevice AppendMode)
                hClose
                prepareAndRun
    Nothing -> withTempFile "silence" prepareAndRun
  where
    prepareAndRun :: Handle -> IO a
    prepareAndRun tmpHandle = go handles
      where
        go []     = action
        go (h:hs) = goBracket go tmpHandle h hs

goBracket :: ([Handle] -> IO a) -> Handle -> Handle -> [Handle] -> IO a
goBracket go tmpHandle h hs = do
  buffering <- hGetBuffering h
  let redirect = do
        old <- hDuplicate h
        hDuplicateTo tmpHandle h
        return old
      restore old = do
        hDuplicateTo old h
        hSetBuffering h buffering
        hClose old
  E.bracket redirect restore (\_ -> go hs)

[mpilgrem]

I think this is an upstream issue. See yesodweb/persistent#1423 and GHC issue #22146.