<commit_before>{-# LANGUAGE TupleSections, OverloadedStrings, ExistentialQuantification #-}
module Utils.File where

import           Import
import           Prelude                         as P
import           Data.Digest.OpenSSL.MD5         (md5sum)
import           Data.Conduit                    (($$))
import qualified Data.ByteString                 as BS
import qualified Data.Conduit.List               as CL
import           Control.Monad                   (mplus)
import           Data.Ratio
import           Data.Text                       (isPrefixOf)
import           Text.Printf
import           System.Directory                (copyFile, doesFileExist, doesDirectoryExist, createDirectory, getDirectoryContents, getCurrentDirectory)
import           Filesystem.Path.CurrentOS       (fromText)
import           Graphics.ImageMagick.MagickWand hiding (resizeImage, getImageResolution)
import qualified Graphics.ImageMagick.MagickWand as IM
import           System.FilePath                 ((</>))
import           System.Process                  (readProcess)
import           System.Posix                    (FileOffset())
import           System.Posix.Files              (createSymbolicLink, getFileStatus, fileSize)
-------------------------------------------------------------------------------------------------------------------
-------------------------------------------------------------------------------------------------------------------
insertFiles :: [FormResult (Maybe FileInfo)] -> -- ^ Files
               Int      -> -- ^ Thumbnail height and width
               Key Post -> -- ^ Post key
               HandlerT App IO ()
insertFiles []    _           _    = return ()
insertFiles files thumbSize postId = forM_ files (\formfile ->
  case formfile of
    FormSuccess (Just f) -> do
      hashsum    <- md5sum <$> BS.concat <$> (fileSource f $$ CL.consume) 
      uploadPath <- saveFile f hashsum
      filesize   <- liftIO $ formatFileSize <$> getFileSize uploadPath
      let filetype = detectFileType f
          filename = sanitizeFileName $ unpack $ fileName f
          fileext  = fileExt f
          newFile  = Attachedfile { attachedfileParentId    = postId
                                  , attachedfileHashsum     = hashsum
                                  , attachedfileName        = filename
                                  , attachedfileExtension   = fileext
                                  , attachedfileType        = filetype
                                  , attachedfilePath        = uploadPath
                                  , attachedfileSize        = filesize
                                  , attachedfileThumbSize   = thumbSize
                                  , attachedfileThumbWidth  = 0
                                  , attachedfileThumbHeight = 0
                                  , attachedfileInfo        = ""
                                  }
      case filetype of
        FileImage -> do
          (imgW  , imgH  ) <- liftIO $ getImageResolution uploadPath
          (thumbW, thumbH) <- liftIO $ makeThumbImg thumbSize uploadPath fileext hashsum (imgW, imgH)
          void $ runDB $ insert $ newFile { attachedfileInfo        = (show imgW)++"x"++(show imgH)
                                          , attachedfileThumbWidth  = thumbW
                                          , attachedfileThumbHeight = thumbH
                                          }
        FileVideo -> do
          liftIO $ unlessM (doesDirectoryExist thumbDirectory) $ createDirectory thumbDirectory
          -- make thumbnail
          let thumbpath = thumbDirectory </> (show thumbSize ++ "thumb-" ++ hashsum ++ ".png")
          void $ liftIO $ readProcess "/usr/bin/ffmpeg" ["-y","-i", uploadPath, "-vframes", "1", thumbpath] []
          (thumbW, thumbH) <- liftIO $ resizeImage thumbpath thumbpath (thumbSize,thumbSize)
          -- get video info
          info' <- liftIO $ readProcess "/usr/bin/exiftool" ["-t",uploadPath] []
          let info   = parseExifInfo info'
              width  = fromMaybe "0" $ lookup "Image Width" info
              height = fromMaybe "0" $ lookup "Image Height" info
              duration = fromMaybe "N/A" $ lookup "Duration" info
          void $ runDB $ insert $ newFile { attachedfileInfo        = width++"x"++height++", "++duration
                                          , attachedfileThumbWidth  = thumbW
                                          , attachedfileThumbHeight = thumbH
                                          }
        FileAudio -> do
          info' <- liftIO $ readProcess "/usr/bin/exiftool" ["-t",uploadPath] []
          let info      = parseExifInfo info'
              bitrate1  = lookup "Audio Bitrate" info
              bitrate2  = lookup "Nominal Bitrate" info
              bitrate   = fromMaybe "0 kbps" $ mplus bitrate1 bitrate2
              duration  = takeWhile (/=' ') $ fromMaybe "0" $ lookup "Duration" info
          void $ runDB $ insert $ newFile { attachedfileInfo        = bitrate++", "++duration
                                          }
        _         -> void $ runDB $ insert newFile
    _                    -> return ())

saveFile :: FileInfo -> String -> Handler FilePath
saveFile file hashsum = do
  let fn = sanitizeFileName $ unpack $ fileName file
  n <- storageUploadDir . entityVal . fromJust <$> runDB (selectFirst ([]::[Filter Storage]) [])
  dirExists  <- liftIO $ doesDirectoryExist (uploadDirectory </> show n)
  unless dirExists $ liftIO $ createDirectory (uploadDirectory </> show n)
  files <- liftIO $ getDirectoryContents (uploadDirectory </> show n)
  let sameName = (>0) $ length $ filter ((==) $ unpack $ fileName file) files
  if sameName
    then do
      runDB $ updateWhere ([]::[Filter Storage]) [StorageUploadDir +=. 1]
      dirExists <- liftIO $ doesDirectoryExist (uploadDirectory </> show (n+1))
      liftIO $ createDirectory (uploadDirectory </> show (n+1))
      let path = uploadDirectory </> show (n+1) </> (unpack $ fileName file)
      liftIO $ fileMove file path
      return path
    else do
      fileExists <- runDB $ selectFirst [AttachedfileHashsum ==. hashsum] []
      if isJust fileExists
        then do<commit_msg>Fix non existent upload directory<commit_after>{-# LANGUAGE TupleSections, OverloadedStrings, ExistentialQuantification #-}
module Utils.File where

import           Import
import           Prelude                         as P
import           Data.Digest.OpenSSL.MD5         (md5sum)
import           Data.Conduit                    (($$))
import qualified Data.ByteString                 as BS
import qualified Data.Conduit.List               as CL
import           Control.Monad                   (mplus)
import           Data.Ratio
import           Data.Text                       (isPrefixOf)
import           Text.Printf
import           System.Directory                (copyFile, doesFileExist, doesDirectoryExist, createDirectory, getDirectoryContents, getCurrentDirectory)
import           Filesystem.Path.CurrentOS       (fromText)
import           Graphics.ImageMagick.MagickWand hiding (resizeImage, getImageResolution)
import qualified Graphics.ImageMagick.MagickWand as IM
import           System.FilePath                 ((</>))
import           System.Process                  (readProcess)
import           System.Posix                    (FileOffset())
import           System.Posix.Files              (createSymbolicLink, getFileStatus, fileSize)
-------------------------------------------------------------------------------------------------------------------
-------------------------------------------------------------------------------------------------------------------
insertFiles :: [FormResult (Maybe FileInfo)] -> -- ^ Files
               Int      -> -- ^ Thumbnail height and width
               Key Post -> -- ^ Post key
               HandlerT App IO ()
insertFiles []    _           _    = return ()
insertFiles files thumbSize postId = forM_ files (\formfile ->
  case formfile of
    FormSuccess (Just f) -> do
      hashsum    <- md5sum <$> BS.concat <$> (fileSource f $$ CL.consume) 
      uploadPath <- saveFile f hashsum
      filesize   <- liftIO $ formatFileSize <$> getFileSize uploadPath
      let filetype = detectFileType f
          filename = sanitizeFileName $ unpack $ fileName f
          fileext  = fileExt f
          newFile  = Attachedfile { attachedfileParentId    = postId
                                  , attachedfileHashsum     = hashsum
                                  , attachedfileName        = filename
                                  , attachedfileExtension   = fileext
                                  , attachedfileType        = filetype
                                  , attachedfilePath        = uploadPath
                                  , attachedfileSize        = filesize
                                  , attachedfileThumbSize   = thumbSize
                                  , attachedfileThumbWidth  = 0
                                  , attachedfileThumbHeight = 0
                                  , attachedfileInfo        = ""
                                  }
      case filetype of
        FileImage -> do
          (imgW  , imgH  ) <- liftIO $ getImageResolution uploadPath
          (thumbW, thumbH) <- liftIO $ makeThumbImg thumbSize uploadPath fileext hashsum (imgW, imgH)
          void $ runDB $ insert $ newFile { attachedfileInfo        = (show imgW)++"x"++(show imgH)
                                          , attachedfileThumbWidth  = thumbW
                                          , attachedfileThumbHeight = thumbH
                                          }
        FileVideo -> do
          liftIO $ unlessM (doesDirectoryExist thumbDirectory) $ createDirectory thumbDirectory
          -- make thumbnail
          let thumbpath = thumbDirectory </> (show thumbSize ++ "thumb-" ++ hashsum ++ ".png")
          void $ liftIO $ readProcess "/usr/bin/ffmpeg" ["-y","-i", uploadPath, "-vframes", "1", thumbpath] []
          (thumbW, thumbH) <- liftIO $ resizeImage thumbpath thumbpath (thumbSize,thumbSize)
          -- get video info
          info' <- liftIO $ readProcess "/usr/bin/exiftool" ["-t",uploadPath] []
          let info   = parseExifInfo info'
              width  = fromMaybe "0" $ lookup "Image Width" info
              height = fromMaybe "0" $ lookup "Image Height" info
              duration = fromMaybe "N/A" $ lookup "Duration" info
          void $ runDB $ insert $ newFile { attachedfileInfo        = width++"x"++height++", "++duration
                                          , attachedfileThumbWidth  = thumbW
                                          , attachedfileThumbHeight = thumbH
                                          }
        FileAudio -> do
          info' <- liftIO $ readProcess "/usr/bin/exiftool" ["-t",uploadPath] []
          let info      = parseExifInfo info'
              bitrate1  = lookup "Audio Bitrate" info
              bitrate2  = lookup "Nominal Bitrate" info
              bitrate   = fromMaybe "0 kbps" $ mplus bitrate1 bitrate2
              duration  = takeWhile (/=' ') $ fromMaybe "0" $ lookup "Duration" info
          void $ runDB $ insert $ newFile { attachedfileInfo        = bitrate++", "++duration
                                          }
        _         -> void $ runDB $ insert newFile
    _                    -> return ())

saveFile :: FileInfo -> String -> Handler FilePath
saveFile file hashsum = do
  let fn = sanitizeFileName $ unpack $ fileName file
  n <- storageUploadDir . entityVal . fromJust <$> runDB (selectFirst ([]::[Filter Storage]) [])
  dirExists'  <- liftIO $ doesDirectoryExist uploadDirectory
  unless dirExists' $ liftIO $ createDirectory uploadDirectory
  dirExists  <- liftIO $ doesDirectoryExist (uploadDirectory </> show n)
  unless dirExists $ liftIO $ createDirectory (uploadDirectory </> show n)
  files <- liftIO $ getDirectoryContents (uploadDirectory </> show n)
  let sameName = (>0) $ length $ filter ((==) $ unpack $ fileName file) files
  if sameName
    then do
      runDB $ updateWhere ([]::[Filter Storage]) [StorageUploadDir +=. 1]
      dirExists <- liftIO $ doesDirectoryExist (uploadDirectory </> show (n+1))
      liftIO $ createDirectory (uploadDirectory </> show (n+1))
      let path = uploadDirectory </> show (n+1) </> (unpack $ fileName file)
      liftIO $ fileMove file path
      return path
    else do
      fileExists <- runDB $ selectFirst [AttachedfileHashsum ==. hashsum] []
      if isJust fileExists
        then do
{'fraction_non_alphanumeric': 0.11924785782291336, 'fraction_numerical': 0.0030149158997143763, 'mean_word_length': 1.4504276827371696, 'pattern_counts': {'":': 0, '<': 56, '<?xml version=': 0, '>': 55, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 42, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2701442', 'n_tokens_mistral': 3031, 'n_tokens_neox': 2937, 'n_words': 832}