1 {-# LANGUAGE OverloadedStrings #-}
    2 {-# LANGUAGE RecordWildCards #-}
    3 module Store.Service
    4   ( Storage
    5   , initStorage
    6   , StorageLocationConfig (..)
    7   ) where
    8 
    9 import Control.Monad (unless, foldM_)
   10 import Data.Maybe (catMaybes)
   11 import System.Directory (getTemporaryDirectory, createDirectoryIfMissing)
   12 import System.IO.Error (mkIOError, doesNotExistErrorType, illegalOperationErrorType)
   13 import System.Posix.FilePath (addTrailingPathSeparator)
   14 import System.Posix.Files.ByteString (isDirectory, deviceID, getFileStatus)
   15 import System.Posix.Types (DeviceID)
   16 
   17 import Files
   18 import Store.Types
   19 
   20 -- | Locations used by Storage. This is almost /identical/ to 'Storage', except
   21 -- in how it's used and what it represents. Future work might merge the two
   22 -- types.
   23 data StorageLocationConfig = StorageLocationConfig
   24     { storageLocTemp :: Maybe RawFilePath
   25     , storageLocMaster :: RawFilePath
   26     , storageLocUpload :: RawFilePath
   27     , storageLocCache :: Maybe RawFilePath
   28     , storageLocStage :: Maybe RawFilePath
   29     , storageLocFallback :: Maybe RawFilePath
   30     }
   31 
   32 -- | Initialize the configured storage location. It checks for the existence of
   33 -- certain directories and adds subdirectories. Primarily, this allows us to
   34 -- interface with third party services (NYU HPC) that have set up certain
   35 -- directories for us to use.
   36 --
   37 -- This may throw a variety of unchecked exceptions, which is probably the right
   38 -- thing to do for initialization.
   39 --
   40 -- TODO:
   41 -- * Combine initCache and initTemp, which are doing the same thing with quite
   42 --   different implementations: appending a subdirectory, and creating it if it
   43 --   doesn't exist
   44 -- * Commit to reordering execution steps, purifying the second arg
   45 -- * Use throwIO instead of error
   46 initStorage
   47     :: Either String StorageLocationConfig
   48     -- ^ Either the set of paths to use for storage, or a message explaining why
   49     -- storage isn't available. This Either will collapse very soon, once use
   50     -- sites of initStorage are rewritten.
   51     -> IO (Maybe Transcoder)
   52     -- ^ An action that might produce a transcoder. I kept this is IO to keep
   53     -- the implementation identical, without reordering error messages. I highly
   54     -- suspect that is overkill, and this will get moved out of IO.
   55     -> IO Storage
   56     -- ^ The 'Storage' resource (presuming no exceptions were thrown).
   57 initStorage (Left e) _ = return $ error $ "Storage unavailable: " ++ e
   58 initStorage (Right StorageLocationConfig {..}) initTc = do
   59     temp <- maybe (rawFilePath =<< getTemporaryDirectory) pure storageLocTemp
   60     foldM_
   61         checkDirs
   62         Nothing
   63         ([storageLocMaster, temp, storageLocUpload]
   64         ++ catMaybes [storageLocStage]
   65         )
   66     mapM_ initCache storageLocCache
   67     tempPath <- initTemp temp
   68     tc <- initTc
   69     pure Storage
   70         { storageMaster = storageLocMaster
   71         , storageFallback = storageLocFallback
   72         , storageTemp = tempPath
   73         , storageUpload = storageLocUpload
   74         , storageCache = storageLocCache
   75         , storageStage = storageLocStage
   76         , storageTranscoder = tc
   77         }
   78   where
   79     -- Check the dir exists (2nd arg) and it's on the same device as the 1st
   80     -- arg (if Just).
   81     checkDirs :: Maybe DeviceID -> RawFilePath -> IO (Maybe DeviceID)
   82     checkDirs dev f = do
   83         s <- getFileStatus f
   84         f' <- unRawFilePath f
   85         unless (isDirectory s) $ ioError $ mkIOError
   86             doesNotExistErrorType
   87             "storage directory"
   88             Nothing
   89             (Just f')
   90         let d = deviceID s
   91         unless (all (d ==) dev) $ ioError $ mkIOError
   92             illegalOperationErrorType
   93             "storage filesystem"
   94             Nothing
   95             (Just f')
   96         return $ Just d
   97     -- @initCache x = mkdir -p "${x}/tmp"@
   98     initCache :: RawFilePath -> IO ()
   99     initCache c = do
  100         let tmp = c </> "tmp"
  101         tmpPath <- unRawFilePath tmp
  102         createDirectoryIfMissing False tmpPath
  103     -- @initTemp x = mkdir -p "${x}/participantUpload"@
  104     initTemp :: RawFilePath -> IO RawFilePath
  105     initTemp t = do
  106         let tempPath = addTrailingPathSeparator t
  107         unTempPath <- unRawFilePath tempPath
  108         createDirectoryIfMissing
  109             False
  110             (getStorageTempParticipantUpload' unTempPath)
  111         pure tempPath