module Utils.Files
  ( sinkFile, sinkFiles
  , sinkFile', sinkFiles'
  , FileUploads
  , 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.Trans.State.Lazy (execStateT)
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{..}
  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 :: ( MonadHandler m, MonadThrow m
                         , HandlerSite m ~ UniWorX
                         , HasFileReference 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 = do
  let resFilter = mkFilter residual

  oldFiles <- 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) . flip execStateT oldFiles . runConduit $ transPipe liftHandler fs .| C.mapM_ finsert

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

  return (oldFiles', changes)