1 {-# LANGUAGE OverloadedStrings, TemplateHaskell, RecordWildCards #-}
    2 module Databrary.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 Databrary.Ops
   12 import qualified Databrary.Store.Config as C
   13 import Databrary.Service.DB (initDB, finiDB, runDBM)
   14 import Databrary.Service.Entropy (initEntropy)
   15 import Databrary.HTTP.Client (initHTTPClient)
   16 import Databrary.Store.Service (initStorage)
   17 import Databrary.Store.AV (initAV)
   18 import Databrary.Service.Passwd (initPasswd)
   19 import Databrary.Service.Log (initLogs, finiLogs)
   20 import Databrary.Service.Messages (loadMessages)
   21 import Databrary.Web.Service (initWeb)
   22 import Databrary.Static.Service (initStatic)
   23 import Databrary.Ingest.Service (initIngest)
   24 import Databrary.Model.Stats
   25 import Databrary.Solr.Service (initSolr, finiSolr)
   26 import Databrary.EZID.Service (initEZID)
   27 import Databrary.Service.Notification
   28 import Databrary.Service.Periodic (forkPeriodic)
   29 import Databrary.Service.Types
   30 import Databrary.Controller.Notification (forkNotifier)
   31 
   32 -- | Initialize a Service from a Config
   33 initService
   34     :: Bool -- ^ Run in foreground?
   35     -> C.Config
   36     -> IO Service
   37 initService fg conf = do
   38   time <- getCurrentTime
   39   logs <- initLogs (conf C.! (if fg then "log" else "log.bg"))
   40   entropy <- initEntropy
   41   passwd <- initPasswd
   42   messages <- loadMessages
   43   db <- initDB (conf C.! "db")
   44   storage <- initStorage (conf C.! "store")
   45   av <- initAV
   46   web <- initWeb
   47   httpc <- initHTTPClient
   48   static <- initStatic (conf C.! "static")
   49   solr <- initSolr fg (conf C.! "solr")
   50   ezid <- initEZID (conf C.! "ezid")
   51   ingest <- initIngest
   52   notify <- initNotifications (conf C.! "notification")
   53   stats <- if fg then runDBM db lookupSiteStats else return (error "siteStats")
   54   statsref <- newIORef stats
   55   let rc = Service
   56         { serviceStartTime = time
   57         , serviceSecret = Secret $ conf C.! "secret"
   58         , serviceEntropy = entropy
   59         , servicePasswd = passwd
   60         , serviceLogs = logs
   61         , serviceMessages = messages
   62         , serviceDB = db
   63         , serviceStorage = storage
   64         , serviceAV = av
   65         , serviceWeb = web
   66         , serviceHTTPClient = httpc
   67         , serviceStatic = static
   68         , serviceStats = statsref
   69         , serviceIngest = ingest
   70         , serviceSolr = solr
   71         , serviceEZID = ezid
   72         , servicePeriodic = Nothing
   73         , serviceNotification = notify
   74         , serviceDown = conf C.! "store.DOWN"
   75         }
   76   periodic <- fg `thenReturn` (forkPeriodic rc)
   77   when fg $ void $ forkNotifier rc
   78   return $! rc
   79     { servicePeriodic = periodic
   80     }
   81 
   82 -- | Close up Solr, database, and logs
   83 finiService :: Service -> IO ()
   84 finiService Service{..} = do
   85   finiSolr serviceSolr
   86   finiDB serviceDB
   87   finiLogs serviceLogs
   88 
   89 -- | Bracket an action that uses a Service, governed by a Config.
   90 withService
   91     :: Bool -- ^ Run in foreground?
   92     -> C.Config -- ^ Config for the Service
   93     -> (Service -> IO a) -- ^ Action to run
   94     -> IO a -- ^ Result of action
   95 withService fg c = bracket (initService fg c) finiService