1 {-# LANGUAGE OverloadedStrings, RecordWildCards #-} 2 module Service.Init 3 ( withService 4 ) where 5 6 import Control.Exception (bracket) 7 import Control.Monad (when, void) 8 import Data.IORef (newIORef) 9 import Data.Time.Clock (getCurrentTime) 10 11 import Ops 12 import qualified Store.Config as C 13 import Service.DB (initDB, finiDB, runDBM) 14 import Service.Entropy (initEntropy) 15 import HTTP.Client (initHTTPClient) 16 import Store.Service (initStorage, StorageLocationConfig (..)) 17 import Store.AV (initAV) 18 import Service.Passwd (initPasswd) 19 import Service.Log (initLogs, finiLogs) 20 import Service.Mail (initMailer) 21 import Service.Messages (loadMessages) 22 import Web.Service (initWeb) 23 import Static.Service (initStatic) 24 import Ingest.Service (initIngest) 25 import Model.Stats 26 import Solr.Service (initSolr, finiSolr) 27 import EZID.Service (initEZID) 28 import Service.Notification 29 import Service.Periodic (forkPeriodic) 30 import Service.Types 31 import Controller.Notification (forkNotifier) 32 import Store.Transcoder (initTranscoder) 33 import Store.Types 34 (Transcoder, TranscoderConfig (..), Storage) 35 36 -- | Initialize a Service from a Config 37 initService 38 :: Bool -- ^ Run in foreground? 39 -> C.Config 40 -> IO Service 41 initService fg conf = do 42 time <- getCurrentTime 43 logs <- initLogs (conf C.! (if fg then "log" else "log.bg")) 44 mailer <- pure initMailer 45 entropy <- initEntropy 46 passwd <- initPasswd 47 messages <- loadMessages 48 db <- initDB (conf C.! "db") 49 storage <- initStorage_ (conf C.! "store") 50 av <- initAV 51 web <- initWeb 52 httpc <- initHTTPClient 53 static <- initStatic (conf C.! "static") 54 solr <- initSolr fg (conf C.! "solr") 55 ezid <- initEZID (conf C.! "ezid") 56 ingest <- initIngest 57 notify <- initNotifications (conf C.! "notification") 58 stats <- if fg then runDBM db lookupSiteStats else return (error "siteStats") 59 statsref <- newIORef stats 60 let rc = Service 61 { serviceStartTime = time 62 , serviceSecret = Secret $ conf C.! "secret" 63 , serviceEntropy = entropy 64 , servicePasswd = passwd 65 , serviceLogs = logs 66 , serviceMailer = mailer 67 , serviceMessages = messages 68 , serviceDB = db 69 , serviceStorage = storage 70 , serviceAV = av 71 , serviceWeb = web 72 , serviceHTTPClient = httpc 73 , serviceStatic = static 74 , serviceStats = statsref 75 , serviceIngest = ingest 76 , serviceSolr = solr 77 , serviceEZID = ezid 78 , servicePeriodic = Nothing 79 , serviceNotification = notify 80 , serviceDown = conf C.! "store.DOWN" 81 } 82 periodic <- fg `thenReturn` forkPeriodic rc 83 when fg $ void $ forkNotifier rc 84 return $! rc 85 { servicePeriodic = periodic 86 } 87 where 88 initTranscoder_ :: C.Config -> IO (Maybe Transcoder) 89 initTranscoder_ c = initTranscoder TranscoderConfig 90 { transcoderHost = c C.! "host" 91 , transcoderDir = c C.! "dir" 92 , transcoderMount = c C.! "mount" 93 } 94 initStorage_ :: C.Config -> IO Storage 95 initStorage_ = initStorage . mkLocConf <*> initTranscoder_ . (C.! "transcode") 96 mkLocConf :: C.Config -> Either String StorageLocationConfig 97 mkLocConf c 98 | Just down <- c C.! "DOWN" = Left down 99 | otherwise = Right StorageLocationConfig 100 { storageLocTemp = c C.! "temp" 101 , storageLocMaster = c C.! "master" 102 , storageLocUpload = c C.! "upload" 103 , storageLocCache = c C.! "cache" 104 , storageLocStage = c C.! "stage" 105 , storageLocFallback = c C.! "fallback" 106 } 107 108 -- | Close up Solr, database, and logs 109 finiService :: Service -> IO () 110 finiService Service{..} = do 111 finiSolr serviceSolr 112 finiDB serviceDB 113 finiLogs serviceLogs 114 115 -- | Bracket an action that uses a Service, governed by a Config. 116 withService 117 :: Bool -- ^ Run in foreground? 118 -> C.Config -- ^ Config for the Service 119 -> (Service -> IO a) -- ^ Action to run 120 -> IO a -- ^ Result of action 121 withService fg c = bracket (initService fg c) finiService