make media replacable
This commit is contained in:
parent
c374443fdc
commit
154e211e19
3 changed files with 214 additions and 158 deletions
|
@ -20,8 +20,19 @@ import Import
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.String
|
import Data.String
|
||||||
import qualified Data.List as L
|
import qualified Data.List as L
|
||||||
|
import Data.Time
|
||||||
|
import Data.Maybe (fromJust)
|
||||||
|
import Data.Int (Int64(..))
|
||||||
import System.FilePath as FP
|
import System.FilePath as FP
|
||||||
import System.Directory
|
import System.Directory
|
||||||
|
import Text.Markdown
|
||||||
|
import Codec.Picture as P
|
||||||
|
import Codec.Picture.Metadata as PM hiding (insert, delete)
|
||||||
|
import Codec.Picture.ScaleDCT
|
||||||
|
import Codec.ImageType
|
||||||
|
import Graphics.Svg
|
||||||
|
import Graphics.Rasterific.Svg
|
||||||
|
import Graphics.Text.TrueType
|
||||||
|
|
||||||
loginIsAdmin :: IsString t => Handler (Either (t, Route App) ())
|
loginIsAdmin :: IsString t => Handler (Either (t, Route App) ())
|
||||||
loginIsAdmin = do
|
loginIsAdmin = do
|
||||||
|
@ -152,3 +163,145 @@ removeReference mId aId = do
|
||||||
let newMediaList = removeItem mId $ albumContent album
|
let newMediaList = removeItem mId $ albumContent album
|
||||||
-- update reference list
|
-- update reference list
|
||||||
runDB $ update aId [AlbumContent =. newMediaList]
|
runDB $ update aId [AlbumContent =. newMediaList]
|
||||||
|
|
||||||
|
data UploadSpec
|
||||||
|
= NewFile
|
||||||
|
| Replace MediumId
|
||||||
|
|
||||||
|
handleUpload
|
||||||
|
:: Int
|
||||||
|
-> AlbumId
|
||||||
|
-> T.Text
|
||||||
|
-> UTCTime
|
||||||
|
-> UserId
|
||||||
|
-> Maybe Markdown
|
||||||
|
-> [T.Text]
|
||||||
|
-> Int
|
||||||
|
-> UploadSpec
|
||||||
|
-> (Int, FileInfo)
|
||||||
|
-> Handler (Maybe T.Text)
|
||||||
|
handleUpload len albumId prefix time owner desc tags licence spec (index, file) = do
|
||||||
|
let mime = fileContentType file
|
||||||
|
if mime `elem` acceptedTypes
|
||||||
|
then do
|
||||||
|
albRef <- runDB $ getJust albumId
|
||||||
|
let ownerId = albumOwner albRef
|
||||||
|
path <- writeOnDrive file ownerId albumId spec
|
||||||
|
isOk <- liftIO $ checkCVE_2016_3714 path mime
|
||||||
|
if isOk
|
||||||
|
then do
|
||||||
|
meta <- generateThumbs path ownerId albumId mime
|
||||||
|
tempName <- if len == 1
|
||||||
|
then return prefix
|
||||||
|
else return
|
||||||
|
( prefix `T.append` " " `T.append` T.pack (show index) `T.append`
|
||||||
|
" of " `T.append` T.pack (show len))
|
||||||
|
medium <- return $ Medium
|
||||||
|
tempName
|
||||||
|
('/' : path)
|
||||||
|
('/' : metaThumbPath meta)
|
||||||
|
mime
|
||||||
|
time
|
||||||
|
owner
|
||||||
|
desc
|
||||||
|
tags
|
||||||
|
albumId
|
||||||
|
('/' : metaPreviewPath meta)
|
||||||
|
licence
|
||||||
|
case spec of
|
||||||
|
NewFile ->
|
||||||
|
insertMedium medium albumId
|
||||||
|
Replace _ ->
|
||||||
|
return ()
|
||||||
|
return Nothing
|
||||||
|
else do
|
||||||
|
liftIO $ removeFile (FP.normalise path)
|
||||||
|
return $ Just $ fileName file
|
||||||
|
else
|
||||||
|
return $ Just $ fileName file
|
||||||
|
|
||||||
|
data ThumbsMeta = ThumbsMeta
|
||||||
|
{ metaThumbPath :: FP.FilePath
|
||||||
|
, metaPreviewPath :: FP.FilePath
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | generate thumbnail and preview images from uploaded image
|
||||||
|
generateThumbs
|
||||||
|
:: FP.FilePath -- ^ Path to original image
|
||||||
|
-> UserId -- ^ Uploading user
|
||||||
|
-> AlbumId -- ^ Destination album
|
||||||
|
-> T.Text -- ^ MIME-Type (used for svg et al.)
|
||||||
|
-> Handler ThumbsMeta -- ^ Resulting metadata to store
|
||||||
|
generateThumbs path uId aId mime = do
|
||||||
|
orig <- case mime of
|
||||||
|
"image/svg+xml" -> do
|
||||||
|
svg <- liftIO $ loadSvgFile path
|
||||||
|
(img, _) <- liftIO $ renderSvgDocument emptyFontCache Nothing 100 $ fromJust svg
|
||||||
|
return img
|
||||||
|
_ -> do
|
||||||
|
eimg <- liftIO $ readImage path
|
||||||
|
case eimg of
|
||||||
|
Left err ->
|
||||||
|
error err
|
||||||
|
Right img -> -- This branch contains "classical" image formats like bmp or png
|
||||||
|
return $ convertRGBA8 img
|
||||||
|
let thumbName = FP.takeBaseName path ++ "_thumb.png"
|
||||||
|
prevName = FP.takeBaseName path ++ "_preview.png"
|
||||||
|
pathPrefix = "static" FP.</> "data" FP.</> T.unpack (extractKey uId) FP.</> T.unpack (extractKey aId)
|
||||||
|
tPath = pathPrefix FP.</> thumbName
|
||||||
|
pPath = pathPrefix FP.</> prevName
|
||||||
|
-- origPix = convertRGBA8 orig
|
||||||
|
oWidth = P.imageWidth orig :: Int
|
||||||
|
oHeight = P.imageHeight orig :: Int
|
||||||
|
tWidth = floor (fromIntegral oWidth / fromIntegral oHeight * fromIntegral tHeight :: Double)
|
||||||
|
tHeight = 230 :: Int
|
||||||
|
pHeight = 600 :: Int
|
||||||
|
pScale = (fromIntegral pHeight :: Double) / (fromIntegral oHeight :: Double)
|
||||||
|
pWidth = floor (fromIntegral oWidth * pScale)
|
||||||
|
tPix = scale (tWidth, tHeight) orig
|
||||||
|
pPix = scale (pWidth, pHeight) orig
|
||||||
|
liftIO $ savePngImage tPath $ ImageRGBA8 tPix
|
||||||
|
liftIO $ savePngImage pPath $ ImageRGBA8 pPix
|
||||||
|
return $ ThumbsMeta
|
||||||
|
{ metaThumbPath = tPath
|
||||||
|
, metaPreviewPath = pPath
|
||||||
|
}
|
||||||
|
|
||||||
|
checkCVE_2016_3714 :: FP.FilePath -> T.Text -> IO Bool
|
||||||
|
checkCVE_2016_3714 p m =
|
||||||
|
case m of
|
||||||
|
"image/jpeg" -> isJpeg p
|
||||||
|
"image/jpg" -> isJpeg p
|
||||||
|
"image/png" -> isPng p
|
||||||
|
"image/x-ms-bmp" -> isBmp p
|
||||||
|
"image/x-bmp" -> isBmp p
|
||||||
|
"image/bmp" -> isBmp p
|
||||||
|
"image/tiff" -> isTiff p
|
||||||
|
"image/tiff-fx" -> isTiff p
|
||||||
|
"image/svg+xml" -> return True -- TODO: have to check XML for that.
|
||||||
|
"image/gif" -> isGif p
|
||||||
|
_ -> return False
|
||||||
|
|
||||||
|
writeOnDrive :: FileInfo -> UserId -> AlbumId -> UploadSpec -> Handler FP.FilePath
|
||||||
|
writeOnDrive fil userId albumId spec = do
|
||||||
|
album <- runDB $ getJust albumId
|
||||||
|
let ac = albumContent album
|
||||||
|
[PersistInt64 int] <- case spec of
|
||||||
|
NewFile ->
|
||||||
|
if L.null ac then return [PersistInt64 1] else return $ keyToValues $ maximum $ ac
|
||||||
|
Replace mId -> do
|
||||||
|
medium <- runDB $ getJust mId
|
||||||
|
return $ (PersistInt64 (read $ takeBaseName $ mediumPath medium :: Int64)) : []
|
||||||
|
let filen = show $ fromIntegral int + case spec of
|
||||||
|
Replace _ -> 0
|
||||||
|
NewFile -> 1
|
||||||
|
ext = FP.takeExtension $ T.unpack $ fileName fil
|
||||||
|
path = "static" FP.</> "data" FP.</> T.unpack (extractKey userId) FP.</> T.unpack (extractKey albumId) FP.</> filen ++ ext
|
||||||
|
dde <- liftIO $ doesDirectoryExist $ FP.dropFileName path
|
||||||
|
if not dde
|
||||||
|
then
|
||||||
|
liftIO $ createDirectoryIfMissing True $ FP.dropFileName path
|
||||||
|
else
|
||||||
|
return ()
|
||||||
|
liftIO $ fileMove fil path
|
||||||
|
return path
|
||||||
|
|
|
@ -21,7 +21,9 @@ import Yesod.Text.Markdown
|
||||||
import Handler.Commons
|
import Handler.Commons
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Maybe (catMaybes)
|
import Data.Maybe
|
||||||
|
import Text.Markdown
|
||||||
|
import Control.Monad (when)
|
||||||
|
|
||||||
getMediumSettingsR :: MediumId -> Handler Html
|
getMediumSettingsR :: MediumId -> Handler Html
|
||||||
getMediumSettingsR mediumId = do
|
getMediumSettingsR mediumId = do
|
||||||
|
@ -49,11 +51,26 @@ postMediumSettingsR mediumId = do
|
||||||
case result of
|
case result of
|
||||||
FormSuccess temp -> do
|
FormSuccess temp -> do
|
||||||
_ <- runDB $ update mediumId
|
_ <- runDB $ update mediumId
|
||||||
[ MediumTitle =. mediumTitle temp
|
[ MediumTitle =. msTitle temp
|
||||||
, MediumDescription =. mediumDescription temp
|
, MediumDescription =. msDescription temp
|
||||||
, MediumTags =. mediumTags temp
|
, MediumTags =. msTags temp
|
||||||
, MediumLicence =. mediumLicence temp
|
, MediumLicence =. msLicence temp
|
||||||
]
|
]
|
||||||
|
when (not $ isNothing $ msData temp) $ do
|
||||||
|
err <- handleUpload
|
||||||
|
1
|
||||||
|
(mediumAlbum medium)
|
||||||
|
(msTitle temp)
|
||||||
|
(mediumTime medium)
|
||||||
|
(mediumOwner medium)
|
||||||
|
(msDescription temp)
|
||||||
|
(msTags temp)
|
||||||
|
(msLicence temp)
|
||||||
|
(Replace mediumId)
|
||||||
|
(1, (fromJust $ msData temp))
|
||||||
|
when (not $ isNothing err) $ do
|
||||||
|
setMessage "There was an error uploading the File"
|
||||||
|
redirect $ MediumSettingsR mediumId
|
||||||
setMessage "Medium settings changed succesfully"
|
setMessage "Medium settings changed succesfully"
|
||||||
redirect $ MediumR mediumId
|
redirect $ MediumR mediumId
|
||||||
_ -> do
|
_ -> do
|
||||||
|
@ -63,18 +80,20 @@ postMediumSettingsR mediumId = do
|
||||||
setMessage errorMsg
|
setMessage errorMsg
|
||||||
redirect route
|
redirect route
|
||||||
|
|
||||||
mediumSettingsForm :: Medium -> AForm Handler Medium
|
data MediumSettings = MediumSettings
|
||||||
mediumSettingsForm medium = Medium
|
{ msTitle :: T.Text
|
||||||
|
, msData :: Maybe FileInfo
|
||||||
|
, msDescription :: Maybe Markdown
|
||||||
|
, msTags :: [T.Text]
|
||||||
|
, msLicence :: Int
|
||||||
|
}
|
||||||
|
|
||||||
|
mediumSettingsForm :: Medium -> AForm Handler MediumSettings
|
||||||
|
mediumSettingsForm medium = MediumSettings
|
||||||
<$> areq textField (bfs ("Title" :: T.Text)) (Just $ mediumTitle medium)
|
<$> areq textField (bfs ("Title" :: T.Text)) (Just $ mediumTitle medium)
|
||||||
<*> pure (mediumPath medium)
|
<*> aopt fileField (bfs ("Update medium" :: T.Text)) (Nothing)
|
||||||
<*> pure (mediumThumb medium)
|
|
||||||
<*> pure (mediumMime medium)
|
|
||||||
<*> pure (mediumTime medium)
|
|
||||||
<*> pure (mediumOwner medium)
|
|
||||||
<*> aopt markdownField (bfs ("Description" :: T.Text)) (Just $ mediumDescription medium)
|
<*> aopt markdownField (bfs ("Description" :: T.Text)) (Just $ mediumDescription medium)
|
||||||
<*> areq tagField (bfs ("Tags" :: T.Text)) (Just $ mediumTags medium)
|
<*> areq tagField (bfs ("Tags" :: T.Text)) (Just $ mediumTags medium)
|
||||||
<*> pure (mediumAlbum medium)
|
|
||||||
<*> pure (mediumPreview medium)
|
|
||||||
<*> areq (selectField licences) (bfs ("Licence" :: T.Text)) (Just $ mediumLicence medium)
|
<*> areq (selectField licences) (bfs ("Licence" :: T.Text)) (Just $ mediumLicence medium)
|
||||||
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit T.Text)
|
<* bootstrapSubmit ("Change settings" :: BootstrapSubmit T.Text)
|
||||||
where
|
where
|
||||||
|
|
|
@ -27,13 +27,13 @@ import Data.List as L
|
||||||
import qualified System.FilePath as FP
|
import qualified System.FilePath as FP
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import Text.Blaze.Internal
|
import Text.Blaze.Internal
|
||||||
import Codec.ImageType
|
-- import Codec.ImageType
|
||||||
import Codec.Picture as P
|
-- import Codec.Picture as P
|
||||||
import Codec.Picture.Metadata as PM
|
-- import Codec.Picture.Metadata as PM
|
||||||
import Codec.Picture.ScaleDCT
|
-- import Codec.Picture.ScaleDCT
|
||||||
import Graphics.Rasterific.Svg as SVG
|
import Graphics.Rasterific.Svg as SVG
|
||||||
import Graphics.Svg
|
-- import Graphics.Svg
|
||||||
import Graphics.Text.TrueType
|
-- import Graphics.Text.TrueType
|
||||||
|
|
||||||
import Debug.Trace
|
import Debug.Trace
|
||||||
|
|
||||||
|
@ -86,27 +86,17 @@ postDirectUploadR albumId = do
|
||||||
let fils = fileBulkFiles temp
|
let fils = fileBulkFiles temp
|
||||||
let indFils = zip [1..] fils
|
let indFils = zip [1..] fils
|
||||||
errNames <- mapM
|
errNames <- mapM
|
||||||
(\(index, file) -> do
|
(handleUpload
|
||||||
let mime = fileContentType file
|
(length indFils)
|
||||||
if mime `elem` acceptedTypes
|
(fileBulkAlbum temp)
|
||||||
then do
|
(fileBulkPrefix temp)
|
||||||
path <- writeOnDrive file ownerId albumId
|
(fileBulkTime temp)
|
||||||
isOk <- liftIO $ checkCVE_2016_3714 path mime
|
(fileBulkOwner temp)
|
||||||
if isOk
|
(fileBulkDesc temp)
|
||||||
then do
|
(fileBulkTags temp)
|
||||||
meta <- generateThumbs path ownerId albumId mime
|
(fileBulkLicence temp)
|
||||||
tempName <- if length indFils == 1
|
NewFile
|
||||||
then return $ fileBulkPrefix temp
|
)indFils
|
||||||
else return (fileBulkPrefix temp `T.append` " " `T.append` T.pack (show (index :: Int)) `T.append` " of " `T.append` T.pack (show (length indFils)))
|
|
||||||
let medium = Medium tempName ('/' : path) ('/' : metaThumbPath meta) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) albumId ('/' : metaPreviewPath meta) (fileBulkLicence temp)
|
|
||||||
insertMedium medium albumId
|
|
||||||
return Nothing
|
|
||||||
else do
|
|
||||||
liftIO $ removeFile (FP.normalise path)
|
|
||||||
return $ Just $ fileName file
|
|
||||||
else
|
|
||||||
return $ Just $ fileName file
|
|
||||||
) indFils
|
|
||||||
let onlyErrNames = removeItem Nothing errNames
|
let onlyErrNames = removeItem Nothing errNames
|
||||||
if
|
if
|
||||||
L.null onlyErrNames
|
L.null onlyErrNames
|
||||||
|
@ -131,88 +121,6 @@ postDirectUploadR albumId = do
|
||||||
setMessage "This Album does not exist"
|
setMessage "This Album does not exist"
|
||||||
redirect $ AlbumR albumId
|
redirect $ AlbumR albumId
|
||||||
|
|
||||||
-- | Type to pass metadata about imgaes around.
|
|
||||||
data ThumbsMeta = ThumbsMeta
|
|
||||||
{ metaThumbPath :: FP.FilePath -- ^ Filepath of the new thumbnail image
|
|
||||||
, metaPreviewPath :: FP.FilePath -- ^ Filepath of the new preview image
|
|
||||||
}
|
|
||||||
|
|
||||||
-- | generate thumbnail and preview images from uploaded image
|
|
||||||
generateThumbs
|
|
||||||
:: FP.FilePath -- ^ Path to original image
|
|
||||||
-> UserId -- ^ Uploading user
|
|
||||||
-> AlbumId -- ^ Destination album
|
|
||||||
-> T.Text -- ^ MIME-Type (used for svg et al.)
|
|
||||||
-> Handler ThumbsMeta -- ^ Resulting metadata to store
|
|
||||||
generateThumbs path uId aId mime = do
|
|
||||||
orig <- case mime of
|
|
||||||
"image/svg+xml" -> do
|
|
||||||
svg <- liftIO $ loadSvgFile path
|
|
||||||
(img, _) <- liftIO $ renderSvgDocument emptyFontCache Nothing 100 $ fromJust svg
|
|
||||||
return img
|
|
||||||
_ -> do
|
|
||||||
eimg <- liftIO $ readImage path
|
|
||||||
case eimg of
|
|
||||||
Left err ->
|
|
||||||
error err
|
|
||||||
Right img -> do -- This branch contains "classical" image formats like bmp or png
|
|
||||||
liftIO $ traceIO "I am here!"
|
|
||||||
return $ convertRGBA8 img
|
|
||||||
let thumbName = FP.takeBaseName path ++ "_thumb.png"
|
|
||||||
prevName = FP.takeBaseName path ++ "_preview.png"
|
|
||||||
pathPrefix = "static" FP.</> "data" FP.</> T.unpack (extractKey uId) FP.</> T.unpack (extractKey aId)
|
|
||||||
tPath = pathPrefix FP.</> thumbName
|
|
||||||
pPath = pathPrefix FP.</> prevName
|
|
||||||
-- origPix = convertRGBA8 orig
|
|
||||||
oWidth = P.imageWidth orig :: Int
|
|
||||||
oHeight = P.imageHeight orig :: Int
|
|
||||||
tWidth = floor (fromIntegral oWidth / fromIntegral oHeight * fromIntegral tHeight :: Double)
|
|
||||||
tHeight = 230 :: Int
|
|
||||||
pHeight = 600 :: Int
|
|
||||||
pScale = (fromIntegral pHeight :: Double) / (fromIntegral oHeight :: Double)
|
|
||||||
pWidth = floor (fromIntegral oWidth * pScale)
|
|
||||||
tPix = scale (tWidth, tHeight) orig
|
|
||||||
pPix = scale (pWidth, pHeight) orig
|
|
||||||
liftIO $ savePngImage tPath $ ImageRGBA8 tPix
|
|
||||||
liftIO $ savePngImage pPath $ ImageRGBA8 pPix
|
|
||||||
return $ ThumbsMeta
|
|
||||||
{ metaThumbPath = tPath
|
|
||||||
, metaPreviewPath = pPath
|
|
||||||
}
|
|
||||||
|
|
||||||
checkCVE_2016_3714 :: FP.FilePath -> T.Text -> IO Bool
|
|
||||||
checkCVE_2016_3714 p m =
|
|
||||||
case m of
|
|
||||||
"image/jpeg" -> isJpeg p
|
|
||||||
"image/jpg" -> isJpeg p
|
|
||||||
"image/png" -> isPng p
|
|
||||||
"image/x-ms-bmp" -> isBmp p
|
|
||||||
"image/x-bmp" -> isBmp p
|
|
||||||
"image/bmp" -> isBmp p
|
|
||||||
"image/tiff" -> isTiff p
|
|
||||||
"image/tiff-fx" -> isTiff p
|
|
||||||
"image/svg+xml" -> return True -- TODO: have to check XML for that.
|
|
||||||
"image/gif" -> isGif p
|
|
||||||
_ -> return False
|
|
||||||
|
|
||||||
writeOnDrive :: FileInfo -> UserId -> AlbumId -> Handler FP.FilePath
|
|
||||||
writeOnDrive fil userId albumId = do
|
|
||||||
--filen <- return $ fileName fil
|
|
||||||
album <- runDB $ getJust albumId
|
|
||||||
let ac = albumContent album
|
|
||||||
[PersistInt64 int] = if L.null ac then [PersistInt64 1] else keyToValues $ maximum $ ac
|
|
||||||
filen = show $ fromIntegral int + 1
|
|
||||||
ext = FP.takeExtension $ T.unpack $ fileName fil
|
|
||||||
path = "static" FP.</> "data" FP.</> T.unpack (extractKey userId) FP.</> T.unpack (extractKey albumId) FP.</> filen ++ ext
|
|
||||||
dde <- liftIO $ doesDirectoryExist $ FP.dropFileName path
|
|
||||||
if not dde
|
|
||||||
then
|
|
||||||
liftIO $ createDirectoryIfMissing True $ FP.dropFileName path
|
|
||||||
else
|
|
||||||
return ()
|
|
||||||
liftIO $ fileMove fil path
|
|
||||||
return path
|
|
||||||
|
|
||||||
dUploadForm :: UserId -> User -> AlbumId -> AForm Handler FileBulk
|
dUploadForm :: UserId -> User -> AlbumId -> AForm Handler FileBulk
|
||||||
dUploadForm userId user albumId = FileBulk
|
dUploadForm userId user albumId = FileBulk
|
||||||
<$> areq textField (bfs ("Title" :: T.Text)) Nothing
|
<$> areq textField (bfs ("Title" :: T.Text)) Nothing
|
||||||
|
@ -299,41 +207,17 @@ postUploadR = do
|
||||||
let fils = fileBulkFiles temp
|
let fils = fileBulkFiles temp
|
||||||
let indFils = zip [1..] fils
|
let indFils = zip [1..] fils
|
||||||
errNames <- mapM
|
errNames <- mapM
|
||||||
(\(index, file) -> do
|
(handleUpload
|
||||||
let mime = fileContentType file
|
(length indFils)
|
||||||
if mime `elem` acceptedTypes
|
(fileBulkAlbum temp)
|
||||||
then do
|
(fileBulkPrefix temp)
|
||||||
let inAlbumId = fileBulkAlbum temp
|
(fileBulkTime temp)
|
||||||
albRef <- runDB $ getJust inAlbumId
|
(fileBulkOwner temp)
|
||||||
let ownerId = albumOwner albRef
|
(fileBulkDesc temp)
|
||||||
path <- writeOnDrive file ownerId inAlbumId
|
(fileBulkTags temp)
|
||||||
isOk <- liftIO $ checkCVE_2016_3714 path mime
|
(fileBulkLicence temp)
|
||||||
if isOk
|
NewFile
|
||||||
then do
|
)indFils
|
||||||
meta <- generateThumbs path ownerId inAlbumId mime
|
|
||||||
tempName <- if
|
|
||||||
length indFils == 1
|
|
||||||
then return $ fileBulkPrefix temp
|
|
||||||
else
|
|
||||||
return
|
|
||||||
(fileBulkPrefix temp `T.append`
|
|
||||||
" " `T.append`
|
|
||||||
T.pack (show (index :: Int)) `T.append`
|
|
||||||
" of " `T.append`
|
|
||||||
T.pack (show (length indFils)))
|
|
||||||
let medium = Medium tempName ('/' : path) ('/' : metaThumbPath meta) mime (fileBulkTime temp) (fileBulkOwner temp) (fileBulkDesc temp) (fileBulkTags temp) inAlbumId ('/' : metaPreviewPath meta) (fileBulkLicence temp)
|
|
||||||
-- mId <- runDB $ I.insert medium
|
|
||||||
-- inALbum <- runDB $ getJust inAlbumId
|
|
||||||
-- let newMediaList = mId : albumContent inALbum
|
|
||||||
-- runDB $ update inAlbumId [AlbumContent =. newMediaList]
|
|
||||||
insertMedium medium inAlbumId
|
|
||||||
return Nothing
|
|
||||||
else do
|
|
||||||
liftIO $ removeFile (FP.normalise path)
|
|
||||||
return $ Just $ fileName file
|
|
||||||
else
|
|
||||||
return $ Just $ fileName file
|
|
||||||
) indFils
|
|
||||||
let onlyErrNames = removeItem Nothing errNames
|
let onlyErrNames = removeItem Nothing errNames
|
||||||
if
|
if
|
||||||
L.null onlyErrNames
|
L.null onlyErrNames
|
||||||
|
|
Loading…
Reference in a new issue