module Utils.Files
  ( sinkFile, sinkFiles
  , sinkFile', sinkFiles'
  , FileUploads
  , replaceFileReferences, replaceFileReferences'
  ) where

import Import.NoFoundation
import Foundation.Type
import Handler.Utils.Minio
import qualified Network.Minio as Minio

import qualified Crypto.Hash as Crypto (hash)

import qualified Data.Conduit.Combinators as C

import qualified Data.ByteString.Base64.URL as Base64
import qualified Data.ByteArray as ByteArray

import qualified Data.Map.Lazy as Map
import qualified Data.Set as Set
import Control.Monad.State.Class (modify)

import Database.Persist.Sql (deleteWhereCount)

import Control.Monad.Trans.Resource (allocate)


sinkFiles :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, MonadUnliftIO m, BackendCompatible SqlBackend (YesodPersistBackend UniWorX), YesodPersist UniWorX) => ConduitT File FileReference (SqlPersistT m) ()
sinkFiles = C.mapM sinkFile

sinkFile :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, MonadUnliftIO m, BackendCompatible SqlBackend (YesodPersistBackend UniWorX), YesodPersist UniWorX) => File -> SqlPersistT m FileReference
sinkFile File{ fileContent = Nothing, .. } = return FileReference
  { fileReferenceContent  = Nothing
  , fileReferenceTitle    = fileTitle
  , fileReferenceModified = fileModified
  }
sinkFile File{ fileContent = Just fileContentContent, .. } = do
  void . withUnliftIO $ \UnliftIO{..} ->
    let takeLock = do
          fileLockTime <- liftIO getCurrentTime
          fileLockInstance <- getsYesod appInstanceID
          insert FileLock{ fileLockContent = fileContentHash, .. }
        releaseLock lId = liftHandler . runDB $ (withReaderT projectBackend $ setSerializable (delete lId :: SqlPersistT (HandlerFor UniWorX) ()) :: YesodDB UniWorX ())
     in unliftIO $ allocate (unliftIO takeLock) (unliftIO . releaseLock)

  inDB <- exists [ FileContentHash ==. fileContentHash ]

  let sinkFileDB = unless inDB $ repsert (FileContentKey fileContentHash) FileContent{ fileContentUnreferencedSince = Nothing, .. }
  maybeT sinkFileDB $ do
    let uploadName = decodeUtf8 . Base64.encodeUnpadded $ ByteArray.convert fileContentHash
    uploadBucket <- getsYesod $ views appSettings appUploadCacheBucket
    unless inDB . runAppMinio $ do
      uploadExists <- handleIf minioIsDoesNotExist (const $ return False) $ True <$ Minio.statObject uploadBucket uploadName Minio.defaultGetObjectOptions
      unless uploadExists $ do
        let
          pooOptions = Minio.defaultPutObjectOptions
            { Minio.pooCacheControl = Just "immutable"
            }
        Minio.putObject uploadBucket uploadName (C.sourceLazy $ fromStrict fileContentContent) (Just . fromIntegral $ olength fileContentContent) pooOptions
        -- Note that MinIO does not accept length zero uploads without an explicit length specification (not `Nothing` in the line above for the api we use)

  return FileReference
    { fileReferenceContent  = Just fileContentHash
    , fileReferenceTitle    = fileTitle
    , fileReferenceModified = fileModified
    }
  where
    fileContentHash = Crypto.hash fileContentContent


sinkFiles' :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, MonadUnliftIO m, BackendCompatible SqlBackend (YesodPersistBackend UniWorX), YesodPersist UniWorX, HasFileReference record) => ConduitT (File, FileReferenceResidual record) record (SqlPersistT m) ()
sinkFiles' = C.mapM $ uncurry sinkFile'

sinkFile' :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, MonadUnliftIO m, BackendCompatible SqlBackend (YesodPersistBackend UniWorX), YesodPersist UniWorX, HasFileReference record) => File -> FileReferenceResidual record -> SqlPersistT m record
sinkFile' file residual = do
  reference <- sinkFile file
  return $ _FileReference # (reference, residual)


type FileUploads = ConduitT () FileReference (HandlerFor UniWorX) ()

replaceFileReferences' :: ( MonadIO m, MonadThrow m
                          , IsFileReference record
                          , PersistEntityBackend record ~ SqlBackend
                          )
                       => (FileReferenceResidual record -> [Filter record])
                       -> FileReferenceResidual record
                       -> ConduitT FileReference Void (SqlPersistT m) (Set (Key record), Set (Key record)) -- ^ @(oldFiles, changes)@
replaceFileReferences' mkFilter residual = do
  let resFilter = mkFilter residual

  oldFiles <- lift $ Map.fromListWith Set.union . map (\(Entity k v) -> (v ^. _FileReference . _1, Set.singleton k)) <$> selectList resFilter []
  let oldFiles' = setOf (folded . folded) oldFiles

  let
    finsert fRef
      | Just sfIds <- fRef `Map.lookup` oldFiles
      = modify $ Map.mapMaybe (assertM' (not . Set.null) . (\\ sfIds))
      | otherwise = do
          let fRef' = _FileReference # (fRef, residual)
          forM_ (persistUniqueKeys fRef') $ \u -> maybeT (return ()) $ do
            Entity cKey cVal <- MaybeT . lift $ getBy u
            deleted <- lift . lift . deleteWhereCount $ resFilter <> [ persistIdField ==. cKey ]
            unless (deleted == 1) $
              throwM . userError $ "replaceFileReferences tried to delete outside of filter/database inconsistency: deleted=" <> show deleted
            lift . modify $ Map.alter (Just . maybe (Set.singleton cKey) (Set.insert cKey)) (cVal ^. _FileReference . _1)
          fId <- lift $ insert fRef'
          modify $ Map.alter (Just . maybe (Set.singleton fId) (Set.insert fId)) fRef

  changes <- fmap (setOf $ folded . folded) . execStateC oldFiles $ C.mapM_ finsert

  lift . deleteWhere $ resFilter <> [ persistIdField <-. Set.toList (oldFiles' `Set.intersection` changes) ]

  return (oldFiles', changes)

replaceFileReferences :: ( MonadHandler m, MonadThrow m
                         , HandlerSite m ~ UniWorX
                         , IsFileReference record
                         , PersistEntityBackend record ~ SqlBackend
                         )
                      => (FileReferenceResidual record -> [Filter record])
                      -> FileReferenceResidual record
                      -> FileUploads
                      -> SqlPersistT m (Set (Key record), Set (Key record)) -- ^ @(oldFiles, changes)@
replaceFileReferences mkFilter residual fs = runConduit $ transPipe liftHandler fs .| replaceFileReferences' mkFilter residual