58 lines
2.0 KiB
Haskell
58 lines
2.0 KiB
Haskell
module Handler.Utils.Files
|
|
( sourceFile, sourceFile'
|
|
, sourceFiles, sourceFiles'
|
|
, SourceFilesException(..)
|
|
) where
|
|
|
|
import Import
|
|
|
|
import qualified Data.Conduit.Combinators as C
|
|
|
|
import Handler.Utils.Minio
|
|
import qualified Network.Minio as Minio
|
|
|
|
import qualified Data.ByteString.Base64.URL as Base64
|
|
import qualified Data.ByteArray as ByteArray
|
|
|
|
|
|
data SourceFilesException
|
|
= SourceFilesMismatchedHashes
|
|
| SourceFilesContentUnavailable
|
|
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
|
deriving anyclass (Exception)
|
|
|
|
|
|
sourceFiles :: ConduitT FileReference File (YesodDB UniWorX) ()
|
|
sourceFiles = C.mapM sourceFile
|
|
|
|
sourceFile :: FileReference -> DB File
|
|
sourceFile FileReference{..} = do
|
|
mFileContent <- traverse get $ FileContentKey <$> fileReferenceContent
|
|
fileContent <- if
|
|
| is (_Just . _Nothing) mFileContent
|
|
, Just fileContentHash <- fileReferenceContent -- Not a restriction
|
|
-> maybeT (throwM SourceFilesContentUnavailable) $ do
|
|
let uploadName = decodeUtf8 . Base64.encodeUnpadded $ ByteArray.convert fileContentHash
|
|
uploadBucket <- getsYesod $ views appSettings appUploadCacheBucket
|
|
fmap Just . (hoistMaybe =<<) . runAppMinio . runMaybeT $ do
|
|
objRes <- catchIfMaybeT minioIsDoesNotExist $ Minio.getObject uploadBucket uploadName Minio.defaultGetObjectOptions
|
|
lift . runConduit $ Minio.gorObjectStream objRes .| C.fold
|
|
| fmap (fmap fileContentHash) mFileContent /= fmap Just fileReferenceContent
|
|
-> throwM SourceFilesMismatchedHashes
|
|
| Just fileContent' <- fileContentContent <$> join mFileContent
|
|
-> return $ Just fileContent'
|
|
| otherwise
|
|
-> return Nothing
|
|
|
|
return File
|
|
{ fileTitle = fileReferenceTitle
|
|
, fileContent
|
|
, fileModified = fileReferenceModified
|
|
}
|
|
|
|
sourceFiles' :: forall file. HasFileReference file => ConduitT file File (YesodDB UniWorX) ()
|
|
sourceFiles' = C.mapM sourceFile'
|
|
|
|
sourceFile' :: forall file. HasFileReference file => file -> DB File
|
|
sourceFile' = sourceFile . view (_FileReference . _1)
|