module Service.Init
( withService
) where
import Control.Exception (bracket)
import Control.Monad (when, void)
import Data.IORef (newIORef)
import Data.Time.Clock (getCurrentTime)
import Ops
import qualified Store.Config as C
import Service.DB (initDB, finiDB, runDBM)
import Service.Entropy (initEntropy)
import HTTP.Client (initHTTPClient)
import Store.Service (initStorage, StorageLocationConfig (..))
import Store.AV (initAV)
import Service.Passwd (initPasswd)
import Service.Log (initLogs, finiLogs)
import Service.Mail (initMailer)
import Service.Messages (loadMessages)
import Web.Service (initWeb)
import Static.Service (initStatic)
import Ingest.Service (initIngest)
import Model.Stats
import Solr.Service (initSolr, finiSolr)
import EZID.Service (initEZID)
import Service.Notification
import Service.Periodic (forkPeriodic)
import Service.Types
import Controller.Notification (forkNotifier)
import Store.Transcoder (initTranscoder)
import Store.Types
(Transcoder, TranscoderConfig (..), Storage)
initService
:: Bool
-> C.Config
-> IO Service
initService fg conf = do
time <- getCurrentTime
logs <- initLogs (conf C.! (if fg then "log" else "log.bg"))
mailer <- pure initMailer
entropy <- initEntropy
passwd <- initPasswd
messages <- loadMessages
db <- initDB (conf C.! "db")
storage <- initStorage_ (conf C.! "store")
av <- initAV
web <- initWeb
httpc <- initHTTPClient
static <- initStatic (conf C.! "static")
solr <- initSolr fg (conf C.! "solr")
ezid <- initEZID (conf C.! "ezid")
ingest <- initIngest
notify <- initNotifications (conf C.! "notification")
stats <- if fg then runDBM db lookupSiteStats else return (error "siteStats")
statsref <- newIORef stats
let rc = Service
{ serviceStartTime = time
, serviceSecret = Secret $ conf C.! "secret"
, serviceEntropy = entropy
, servicePasswd = passwd
, serviceLogs = logs
, serviceMailer = mailer
, serviceMessages = messages
, serviceDB = db
, serviceStorage = storage
, serviceAV = av
, serviceWeb = web
, serviceHTTPClient = httpc
, serviceStatic = static
, serviceStats = statsref
, serviceIngest = ingest
, serviceSolr = solr
, serviceEZID = ezid
, servicePeriodic = Nothing
, serviceNotification = notify
, serviceDown = conf C.! "store.DOWN"
}
periodic <- fg `thenReturn` forkPeriodic rc
when fg $ void $ forkNotifier rc
return $! rc
{ servicePeriodic = periodic
}
where
initTranscoder_ :: C.Config -> IO (Maybe Transcoder)
initTranscoder_ c = initTranscoder TranscoderConfig
{ transcoderHost = c C.! "host"
, transcoderDir = c C.! "dir"
, transcoderMount = c C.! "mount"
}
initStorage_ :: C.Config -> IO Storage
initStorage_ = initStorage . mkLocConf <*> initTranscoder_ . (C.! "transcode")
mkLocConf :: C.Config -> Either String StorageLocationConfig
mkLocConf c
| Just down <- c C.! "DOWN" = Left down
| otherwise = Right StorageLocationConfig
{ storageLocTemp = c C.! "temp"
, storageLocMaster = c C.! "master"
, storageLocUpload = c C.! "upload"
, storageLocCache = c C.! "cache"
, storageLocStage = c C.! "stage"
, storageLocFallback = c C.! "fallback"
}
finiService :: Service -> IO ()
finiService Service{..} = do
finiSolr serviceSolr
finiDB serviceDB
finiLogs serviceLogs
withService
:: Bool
-> C.Config
-> (Service -> IO a)
-> IO a
withService fg c = bracket (initService fg c) finiService