Make object recovery settlement-safe
This commit is contained in:
parent
cc23211e63
commit
cd83841520
1 changed files with 1054 additions and 90 deletions
29
app/Main.hs
29
app/Main.hs
|
|
@ -1,6 +1,6 @@
|
|||
module Main (main) where
|
||||
|
||||
import Control.Concurrent (forkIO, threadDelay)
|
||||
import Control.Concurrent (threadDelay)
|
||||
import Control.Exception (SomeException, try)
|
||||
import Data.String (fromString)
|
||||
import Database.PostgreSQL.Simple (Only (..))
|
||||
|
|
@ -14,6 +14,7 @@ import Network.Wai.Handler.WarpTLS (runTLS, tlsSettings)
|
|||
import Nuthatch
|
||||
import Nuthatch.Db (migrate, query_, withDb)
|
||||
import Nuthatch.Redis (withRedis)
|
||||
import Nuthatch.Recovery (withLinkedWorker)
|
||||
import Nuthatch.S3 (newS3)
|
||||
import System.Directory (doesDirectoryExist)
|
||||
import System.FilePath ((</>))
|
||||
|
|
@ -30,19 +31,19 @@ main = do
|
|||
withRedis cfg $ \redis -> do
|
||||
s3 <- newS3 cfg
|
||||
let env = newEnv cfg db redis s3
|
||||
_ <- forkIO (runRecovery env)
|
||||
let settings =
|
||||
setPort (cfgListenPort cfg) $
|
||||
setHost (readHost (cfgListenHost cfg)) defaultSettings
|
||||
putStrLn $
|
||||
"nuthatch listening on "
|
||||
<> cfgListenHost cfg
|
||||
<> ":"
|
||||
<> show (cfgListenPort cfg)
|
||||
runTLS
|
||||
(tlsSettings (cfgTlsCertPath cfg) (cfgTlsKeyPath cfg))
|
||||
settings
|
||||
(application env)
|
||||
withLinkedWorker (runRecovery env) $ do
|
||||
let settings =
|
||||
setPort (cfgListenPort cfg) $
|
||||
setHost (readHost (cfgListenHost cfg)) defaultSettings
|
||||
putStrLn $
|
||||
"nuthatch listening on "
|
||||
<> cfgListenHost cfg
|
||||
<> ":"
|
||||
<> show (cfgListenPort cfg)
|
||||
runTLS
|
||||
(tlsSettings (cfgTlsCertPath cfg) (cfgTlsKeyPath cfg))
|
||||
settings
|
||||
(application env)
|
||||
|
||||
waitForPostgres :: Config -> IO ()
|
||||
waitForPostgres cfg = go (60 :: Int)
|
||||
|
|
|
|||
Loading…
Reference in a new issue