1 {-# LANGUAGE ViewPatterns #-}
    2 module Databrary.Store.Asset
    3   ( maxAssetSize
    4   , assetFile
    5   , getAssetFile
    6   , storeAssetFile
    7   ) where
    8 
    9 import Control.Monad ((<=<), unless)
   10 import Control.Monad.IO.Class (liftIO)
   11 import Crypto.Hash (Digest, SHA1)
   12 import Data.ByteArray (convert)
   13 import qualified Data.ByteString as BS
   14 import qualified Data.ByteString.Builder as BSB
   15 import qualified Data.ByteString.Lazy as BSL
   16 import Data.Word (Word64)
   17 import System.Posix.FilePath (takeDirectory)
   18 import System.Posix.Files.ByteString (fileSize, createLink, fileExist, getFileStatus)
   19 
   20 import Databrary.Ops
   21 import Databrary.Has (peek, peeks)
   22 import Databrary.Files
   23 import Databrary.Store.Types
   24 import Databrary.Model.Asset.Types
   25 
   26 maxAssetSize :: Word64
   27 maxAssetSize = 128*1024*1024*1024
   28 
   29 assetFile :: Asset -> Maybe RawFilePath
   30 assetFile = fmap sf . BS.uncons <=< assetSHA1 . assetRow where
   31   sf (h,t) = bs (BSB.word8HexFixed h) </> bs (BSB.byteStringHex t)
   32   bs = BSL.toStrict . BSB.toLazyByteString
   33 
   34 getAssetFile :: MonadStorage c m => Asset -> m (Maybe RawFilePath)
   35 getAssetFile a = do
   36   s <- peek
   37   let
   38     mf Nothing p = return $ storageMaster s </> p
   39     mf (Just sf) p = do
   40       me <- fileExist m
   41       if me
   42         then return m
   43         else do
   44           fe <- fileExist f
   45           return $ if fe then f else m
   46       where
   47       m = storageMaster s </> p
   48       f = sf </> p
   49   mapM (liftIO . mf (storageFallback s)) $ assetFile a
   50 
   51 storeAssetFile :: MonadStorage c m => Asset -> RawFilePath -> m Asset
   52 storeAssetFile ba@Asset{ assetRow = bar } fp = peeks storageMaster >>= \sm -> liftIO $ do
   53   -- liftIO $ print "inside storeAssetFile..." --DEBUG
   54   size <- (fromIntegral . fileSize              <$> getFileStatus fp) `fromMaybeM` assetSize bar
   55   -- liftIO $ print "assetFile size recorded..." --DEBUG
   56   sha1 <- ((convert :: Digest SHA1 -> BS.ByteString) <$> hashFile fp) `fromMaybeM` assetSHA1 bar
   57   -- liftIO $ print "assetFile sha1 recorded..." --DEBUG
   58   let a = ba{ assetRow = bar
   59         { assetSize = Just size
   60         , assetSHA1 = Just sha1
   61         } }
   62       Just af = assetFile a
   63       as = sm </> af
   64   ase <- fileExist as
   65   if ase
   66     then do
   67       -- liftIO $ print "assetFile exists..." --DEBUG
   68       sf <- compareFiles fp as
   69       unless sf $ fail "storage hash collision"
   70     else do
   71       -- liftIO $ print "assetFile does not exists..." --DEBUG
   72       _ <- createDir (takeDirectory as) 0o750
   73       createLink fp as
   74   return a