module Jobs.Handler.Files
  ( dispatchJobPruneSessionFiles
  , dispatchJobPruneUnreferencedFiles
  , dispatchJobInjectFiles
  ) where

import Import hiding (matching)

import Database.Persist.Sql (deleteWhereCount)

import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Utils as E
import qualified Database.Esqueleto.Internal.Sql as E (unsafeSqlCastAs)

import qualified Data.Conduit.Combinators as C
import qualified Data.Conduit.List as C (mapMaybe)

import Handler.Utils.Minio
import qualified Network.Minio as Minio

import qualified Crypto.Hash as Crypto
import qualified Data.ByteString.Base64.URL as Base64

import Control.Monad.Memo (startEvalMemoT, memo)


dispatchJobPruneSessionFiles :: JobHandler UniWorX
dispatchJobPruneSessionFiles = JobHandlerAtomic  . hoist lift $ do
  now <- liftIO getCurrentTime
  expires <- getsYesod $ view _appSessionFilesExpire
  n <- deleteWhereCount [ SessionFileTouched <. addUTCTime (- expires) now ]
  $logInfoS "PruneSessionFiles" [st|Deleted #{n} expired session files|]



fileReferences :: E.SqlExpr (E.Value FileContentReference) -> [E.SqlQuery ()]
fileReferences (E.just -> fHash)
  = [ E.from $ \appFile   -> E.where_ $ appFile   E.^. CourseApplicationFileContent    E.==. fHash
    , E.from $ \matFile   -> E.where_ $ matFile   E.^. MaterialFileContent             E.==. fHash
    , E.from $ \newsFile  -> E.where_ $ newsFile  E.^. CourseNewsFileContent           E.==. fHash
    , E.from $ \sheetFile -> E.where_ $ sheetFile E.^. SheetFileContent                E.==. fHash
    , E.from $ \appInstr  -> E.where_ $ appInstr  E.^. CourseAppInstructionFileContent E.==. fHash
    , E.from $ \matching  -> E.where_ $ E.just (matching E.^. AllocationMatchingLog)   E.==. fHash
    , E.from $ \subFile   -> E.where_ $ subFile   E.^. SubmissionFileContent           E.==. fHash
    , E.from $ \sessFile  -> E.where_ $ sessFile  E.^. SessionFileContent              E.==. fHash
    , E.from $ \lock      -> E.where_ $ E.just (lock E.^. FileLockContent)             E.==. fHash
    ]



dispatchJobPruneUnreferencedFiles :: JobHandler UniWorX
dispatchJobPruneUnreferencedFiles = JobHandlerAtomic . hoist lift $ do
  now <- liftIO getCurrentTime
  interval <- fmap (fmap $ max 0) . getsYesod $ view _appPruneUnreferencedFiles
  keep <- fmap (max 0) . getsYesod $ view _appKeepUnreferencedFiles

  E.update $ \fileContent -> do
    let isReferenced = E.any E.exists . fileReferences $ fileContent E.^. FileContentHash
        now' = E.unsafeSqlCastAs "TIMESTAMP WITH TIME ZONE" $ E.val now
        shouldBe = E.bool (E.just . E.maybe now' (E.min now') $ fileContent E.^. FileContentUnreferencedSince) E.nothing isReferenced
    E.set fileContent [ FileContentUnreferencedSince E.=. shouldBe ]

  let
    getCandidates = E.selectSource . E.from $ \fileContent -> do
      E.where_ . E.maybe E.false (E.<. E.val (addUTCTime (-keep) now)) $ fileContent E.^. FileContentUnreferencedSince
      return ( fileContent E.^. FileContentHash
             , E.length_ $ fileContent E.^. FileContentContent
             )

  Sum deleted <- runConduit $
       getCandidates
    .| maybe (C.map id) (takeWhileTime . (/ 2)) interval
    .| persistentTokenBucketTakeC' TokenBucketPruneFiles (view $ _2 . _Value :: _ -> Word64)
    .| C.map (view $ _1 . _Value)
    .| C.mapM (\fRef -> Sum <$> deleteWhereCount [FileContentHash ==. fRef])
    .| C.fold
  when (deleted > 0) $
    $logInfoS "PruneUnreferencedFiles" [st|Deleted #{deleted} long-unreferenced files|]


dispatchJobInjectFiles :: JobHandler UniWorX
dispatchJobInjectFiles = JobHandlerException . maybeT (return ()) $ do
  uploadBucket <- getsYesod $ view _appUploadCacheBucket
  interval <- getsYesod $ view _appInjectFiles
  now <- liftIO getCurrentTime

  let
    extractReference (Minio.ListItemObject oi)
      | Right bs <- Base64.decodeUnpadded . encodeUtf8 $ Minio.oiObject oi
      , Just fRef <- Crypto.digestFromByteString bs
      = Just (oi, fRef)
    extractReference _ = Nothing

    injectOrDelete :: (Minio.Object, FileContentReference)
                   -> Handler (Sum Int64, Sum Int64) -- ^ Injected, Already existed
    injectOrDelete (obj, fRef) = maybeT (return mempty) $ do
      res <- hoist (startEvalMemoT . hoistStateCache (runDB . setSerializable)) $ do
        alreadyInjected <- lift . lift $ exists [ FileContentHash ==. fRef ]
        if | alreadyInjected -> return (mempty, Sum 1)
           | otherwise -> do
               content <- flip memo obj $ \obj' -> hoistMaybeM . runAppMinio . runMaybeT $ do
                 objRes <- catchIfMaybeT minioIsDoesNotExist $ Minio.getObject uploadBucket obj' Minio.defaultGetObjectOptions
                 lift . runConduit $ Minio.gorObjectStream objRes .| C.fold

               fmap ((, mempty) . Sum) . lift. lift . E.insertSelectCount $
                 let isReferenced = E.any E.exists $ fileReferences (E.val fRef)
                     now' = E.unsafeSqlCastAs "TIMESTAMP WITH TIME ZONE" $ E.val now
                  in return $ FileContent E.<# E.val fRef E.<&> E.val content E.<&> E.bool (E.just now') E.nothing isReferenced
      runAppMinio . maybeT (return ()) . catchIfMaybeT minioIsDoesNotExist $ Minio.removeObject uploadBucket obj
      return res

  (Sum inj, Sum exc) <-
    runConduit $ transPipe runAppMinio (Minio.listObjects uploadBucket Nothing True)
              .| C.mapMaybe extractReference
              .| maybe (C.map id) (takeWhileTime . (/ 2)) interval
              .| transPipe (lift . runDB . setSerializable) (persistentTokenBucketTakeC' TokenBucketInjectFiles $ views _1 Minio.oiSize)
              .| C.map (over _1 Minio.oiObject)
              .| transPipe lift (C.mapM injectOrDelete)
              .| C.fold

  when (exc > 0) $
    $logInfoS "InjectFiles" [st|Deleted #{exc} files from upload cache because they were already injected|]
  when (inj > 0) $
    $logInfoS "InjectFiles" [st|Injected #{inj} files from upload cache into database|]
