content: {-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts, AllowAmbiguousTypes, FlexibleInstances, IncoherentInstances, UndecidableInstances, PolyKinds, BlockArguments, DataKinds #-}
  
  {-|
  Module: IHP.Controller.FileUpload
  Description: Easy access to uploaded files
  Copyright: (c) digitally induced GmbH, 2020
  
  This modules provides high-level file and image upload functionality.
  
  All uploaded files are saved to the `uploads` directory. Given e.g. an User entity with @id = 550e8400-e29b-11d4-a716-446655440000@, the file is saved to @\/uploads\/users\/550e8400-e29b-11d4-a716-446655440000\/picture.jpg@. If the directory does not exists, it will be created.
  
  -}
  module IHP.Controller.FileUpload where
  
  import IHP.Prelude
  
  import Network.Wai.Parse (FileInfo, fileContent)
  import qualified IHP.ModelSupport as ModelSupport
  import qualified Data.ByteString.Lazy as LBS
  import IHP.Controller.RequestContext
  import IHP.Controller.Context
  import qualified System.Process as Process
  
  -- | Returns a file upload from the request as a ByteString.
  --
  -- Returns `Nothing` when the file is not found in the request body.
  --
  -- __Example:__
  --
  -- Given a form like this:
  --
  -- > <form method="POST" action={SubmitMarkdownAction}>
  -- >     <input
  -- >         type="file"
  -- >         name="markdown"
  -- >         accept="text/markdown, text/plain"
  -- >     >
  -- > </form>
  --
  -- The file can be accessed within the action like this:
  --
  -- > action SubmitMarkdownAction = do
  -- >     let content :: Text =
  -- >             fileOrNothing "markdown"
  -- >             |> fromMaybe (error "no file given")
  -- >             |> (.fileContent)
  -- >             |> cs -- content is a LazyByteString, so we use `cs` to convert it to Text
  -- >
  --
  -- See 'filesByName' if multiple files can be uploaded by the user in a single form submission.
  --
  -- See 'IHP.FileStorage.ControllerFunctions.storeFile' to upload the file to S3 or similar cloud storages.
  --
  fileOrNothing :: (?context :: ControllerContext) => ByteString -> Maybe (FileInfo LBS.ByteString)
  fileOrNothing !name =
          case ?context.requestContext.requestBody of
              FormBody { files } ->
                  -- Search for the file, and confirm it's not an empty one.
                  case lookup name files of
                      Just fileInfo | not (LBS.null (fileInfo.fileContent)) -> Just fileInfo
                      _ -> Nothing
              _ -> Nothing
  
  -- | Like 'fileOrNothing' but allows uploading multiple files in the same request
  --
  -- __Example:__
  --
  -- For uploading multiple files we need to set the multiple attribute on the file input:
  --
  -- > <form method="POST" action={SubmitMarkdownAction}>
  -- >     <input
  -- >         type="file"
  -- >         name="markdown"
  -- >         accept="text/markdown, text/plain"
  -- >         multiple
  -- >     >
  -- > </form>
  --
  -- When the user selects multiple files, we can access them like this:
  --
  -- > action SubmitMarkdownAction = do
  -- >     let contents :: [Text] =
  -- >             filesByName "markdown"
  -- >             |> map (.fileContent)
  -- >             |> map cs -- content is a LazyByteString, so we use `cs` to convert it to Text
  -- >
  --
  -- Use 'IHP.HaskellSupport.forEach' to store multiple files inside the cloud storage:
  --
  -- > action SubmitMarkdownAction = do
  -- >     let markdownFiles = filesByName "markdown"
  -- >
  -- >     forEach markdownFiles \file -> do
  -- >         storeFile file "notes"
  -- >
  -- >         pure ()
  -- >
  --
  filesByName :: (?context :: ControllerContext) => ByteString -> [FileInfo LBS.ByteString]
  filesByName !name =
          case ?context.requestContext.requestBody of
              FormBody { files } -> files
                      |> filter (\(filename, _) -> filename == name)
                      |> map snd
              _ -> []
  
  -- | Options to be used together with 'uploadImageWithOptions'
  --
  -- __Example:__
  --
  -- > ImageUploadOptions { convertTo = "jpg", imageMagickOptions = "-resize '1024x1024^' -gravity north -extent 1024x1024 -quality 85% -strip" }
  data ImageUploadOptions = ImageUploadOptions {
      -- | The file extension to be used when saving the file, e.g. @"jpg"@ or @"png"@.
        convertTo :: Text
      -- | Command line options passed to imagemagick. Can used for e.g. resizing, rotating, file size reduction.
      , imageMagickOptions :: Text
      }
  
  -- | Saves an uploaded image file to the @uploads@ directory and writes the relative path to the given record attribute.
  --
  -- Given e.g. an User entity with @id = 550e8400-e29b-11d4-a716-446655440000@, the file is saved to @\/uploads\/users\/550e8400-e29b-11d4-a716-446655440000\/picture.jpg@.
  --
  -- Before saving, the image is converted using imagemagick. You can supply custom image magick options using the options attribute.
  --
  -- If the upload directory does not exists, it will be created.
  --
  -- __Example:__ Uploading a user profile picture
  --
  -- > let profilePictureOptions = ImageUploadOptions
  -- >         { convertTo = "jpg"
  -- >         , imageMagickOptions = "-resize '1024x1024^' -gravity north -extent 1024x1024 -quality 85% -strip"
  -- >         }
  -- >
  -- > user
  -- >     |> fill @["firstname", "lastname", "pictureUrl"]
  -- >     |> uploadImageWithOptions profilePictureOptions #pictureUrl
  -- >     >>= ifValid \case
  -- >         Left user -> render EditView { .. }
  -- >         Right user -> do
  -- >             user <- user |> updateRecord
  -- >             redirectTo EditUserAction { .. }
  --
  -- The uploaded image path is now stored in #pictureUrl.
  uploadImageWithOptions :: forall (fieldName :: Symbol) record (tableName :: Symbol). (
          ?context :: ControllerContext
          , SetField fieldName record (Maybe Text)
          , KnownSymbol fieldName
          , HasField "id" record (ModelSupport.Id (ModelSupport.NormalizeModel record))
          , Show (ModelSupport.PrimaryKey (ModelSupport.GetTableName (ModelSupport.NormalizeModel record)))
          , tableName ~ ModelSupport.GetTableName record
          , KnownSymbol tableName
      ) => ImageUploadOptions -> Proxy fieldName -> record -> IO record
  uploadImageWithOptions options _ user =
      let
          fieldName :: ByteString = cs (symbolVal (Proxy @fieldName))
          tableName :: Text = cs (symbolVal (Proxy @tableName))
          uploadDir :: Text = "static"
          baseImagePath :: Text = "/uploads/" <> tableName <> "/" <> tshow user.id <> "/picture."
          imagePath :: Text = baseImagePath <> "jpg"
          uploadFilePath = baseImagePath <> "upload"
      in case fileOrNothing fieldName of
          Just file -> liftIO do
              _ <- Process.system ("mkdir -p `dirname " <> cs (uploadDir <> uploadFilePath) <> "`")
              let fullImagePath = uploadDir <> imagePath
              fileContent file |> LBS.writeFile (cs (uploadDir <> uploadFilePath))
              Process.runCommand (cs ("convert " <> cs uploadDir <> uploadFilePath <> " " <> (getField @"imageMagickOptions" options) <> " " <> cs fullImagePath))
              user
                  |> setField @fieldName (Just (cs imagePath :: Text))
                  |> return
          _ -> pure user
  
  -- | Saves an uploaded image file to the `uploads` directory.
  --
  -- Given e.g. an User entity with @id = 550e8400-e29b-11d4-a716-446655440000@, the file is saved to @\/uploads\/users\/550e8400-e29b-11d4-a716-446655440000\/picture.jpg@.
  --
  -- No transformation or validation is applied to the given uploaded file. If you need this, take a look at 'uploadImageWithOptions'.
  --
  -- __Example:__ Uploading a user profile picture
  --
  -- > let profilePictureOptions = ImageUploadOptions
  -- >         { convertTo = "jpg"
  -- >         , imageMagickOptions = "-resize '1024x1024^' -gravity north -extent 1024x1024 -quality 85% -strip"
  -- >         }
  -- >
  -- > user
  -- >     |> fill @["firstname", "lastname", "pictureUrl"]
  -- >     |> uploadImageFile "png" #pictureUrl
  -- >     >>= ifValid \case
  -- >         Left user -> render EditView { .. }
  -- >         Right user -> do
  -- >             user <- user |> updateRecord
  -- >             redirectTo EditUserAction { .. }
  --
  uploadImageFile :: forall (fieldName :: Symbol) record (tableName :: Symbol). (
          ?context :: ControllerContext
          , SetField fieldName record (Maybe Text)
          , KnownSymbol fieldName
          , HasField "id" record (ModelSupport.Id (ModelSupport.NormalizeModel record))
          , Show (ModelSupport.PrimaryKey (ModelSupport.GetTableName (ModelSupport.NormalizeModel record)))
          , tableName ~ ModelSupport.GetTableName record
          , KnownSymbol tableName
      ) => Text -> Proxy fieldName -> record -> IO record
  uploadImageFile ext _ user =
      let
          fieldName :: ByteString = cs (symbolVal (Proxy @fieldName))
          tableName :: Text = cs (symbolVal (Proxy @tableName))
          uploadDir :: Text = "static"
          imagePath :: Text = "/uploads/" <> tableName <> "/" <> tshow user.id <> "/picture." <> ext
      in case fileOrNothing fieldName of
          Just file -> liftIO do
              _ <- Process.system ("mkdir -p `dirname " <> cs (uploadDir <> imagePath) <> "`")
              fileContent file |> LBS.writeFile (cs $ uploadDir <> imagePath)
              user
                  |> setField @fieldName (Just (cs imagePath :: Text))
                  |> pure
          _ -> pure user
  
  -- | Saves an uploaded png file. No validation or transformation applied.
  -- See 'uploadImageFile' for details.
  uploadPng ::
      ( ?context :: ControllerContext
      , SetField fieldName record (Maybe Text)
      , HasField "id" record (ModelSupport.Id' (GetTableName (ModelSupport.GetModelByTableName (GetTableName record))))
      , Show (ModelSupport.PrimaryKey (GetTableName (ModelSupport.GetModelByTableName (GetTableName record))))
      , KnownSymbol fieldName
      , KnownSymbol (GetTableName record)
      ) => Proxy fieldName -> record -> IO record
  uploadPng field record = uploadImageFile "png" field record
  
  -- | Saves an uploaded svg file. No validation or transformation applied.
  -- See 'uploadImageFile' for details.
  uploadSVG ::
      ( ?context :: ControllerContext
      , SetField fieldName record (Maybe Text)
      , HasField "id" record (ModelSupport.Id' (GetTableName (ModelSupport.GetModelByTableName (GetTableName record))))
      , Show (ModelSupport.PrimaryKey (GetTableName (ModelSupport.GetModelByTableName (GetTableName record))))
      , KnownSymbol fieldName
      , KnownSymbol (GetTableName record)
      ) => Proxy fieldName -> record -> IO record
  uploadSVG = uploadImageFile "svg"
  