1 {-# LANGUAGE OverloadedStrings #-} 2 module Databrary.Store.Service 3 ( Storage 4 , initStorage 5 ) where 6 7 import Control.Monad (unless, foldM_, forM_) 8 import Data.Maybe (catMaybes) 9 import System.Directory (getTemporaryDirectory, createDirectoryIfMissing) 10 import System.IO.Error (mkIOError, doesNotExistErrorType, illegalOperationErrorType) 11 import System.Posix.FilePath (addTrailingPathSeparator) 12 import System.Posix.Files.ByteString (isDirectory, deviceID, getFileStatus) 13 14 import Databrary.Ops 15 import qualified Databrary.Store.Config as C 16 import Databrary.Files 17 import Databrary.Store.Types 18 import Databrary.Store.Transcoder 19 20 initStorage :: C.Config -> IO Storage 21 initStorage conf 22 | Just down <- conf C.! "DOWN" = return $ error $ "Storage unavailable: " ++ down 23 | otherwise = do 24 fp <- getTemporaryDirectory 25 temp <- fromMaybeM (rawFilePath fp) $ conf C.! "temp" 26 27 foldM_ (\dev f -> do 28 s <- getFileStatus f 29 f' <- unRawFilePath f 30 unless (isDirectory s) 31 $ ioError $ mkIOError doesNotExistErrorType "storage directory" Nothing (Just f') 32 let d = deviceID s 33 unless (all (d ==) dev) 34 $ ioError $ mkIOError illegalOperationErrorType "storage filesystem" Nothing (Just f') 35 return $ Just d) 36 Nothing $ catMaybes [Just master, Just temp, Just upload, stage] 37 38 forM_ cache $ \c -> do 39 let tmp = c </> "tmp" 40 tmpPath <- unRawFilePath tmp 41 createDirectoryIfMissing False tmpPath 42 43 let tempPath = addTrailingPathSeparator temp 44 unTempPath <- unRawFilePath tempPath 45 createDirectoryIfMissing False (getStorageTempParticipantUpload' unTempPath) 46 47 tc <- initTranscoder (conf C.! "transcode") 48 49 return $ Storage 50 { storageMaster = master 51 , storageFallback = conf C.! "fallback" 52 , storageTemp = tempPath 53 , storageUpload = upload 54 , storageCache = cache 55 , storageStage = stage 56 , storageTranscoder = tc 57 } 58 where 59 master = conf C.! "master" 60 upload = conf C.! "upload" 61 cache = conf C.! "cache" 62 stage = conf C.! "stage"