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