module Handler.Utils.Files
  ( sourceFile, sourceFile'
  , sourceFiles, sourceFiles'
  , SourceFilesException(..)
  , sourceFileDB, sourceFileMinio
  , acceptFile
  ) where

import Import

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

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

import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Utils as E

import System.FilePath (normalise, makeValid)
import Data.List (dropWhileEnd)


data SourceFilesException
  = SourceFilesMismatchedHashes
  | SourceFilesContentUnavailable
  deriving (Eq, Ord, Read, Show, Generic, Typeable)
  deriving anyclass (Exception)


sourceFileDB :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX)
             => FileContentReference -> ConduitT () ByteString (SqlPersistT m) ()
sourceFileDB fileReference = do
  dbChunksize <- getsYesod $ view _appFileUploadDBChunksize
  let retrieveChunk chunkHash = \case
        Nothing -> return Nothing
        Just start -> do
          chunk <- E.selectMaybe . E.from $ \fileContentChunk -> do
            E.where_ $ fileContentChunk E.^. FileContentChunkId E.==. E.val chunkHash
            return $ E.substring (fileContentChunk E.^. FileContentChunkContent) (E.val start) (E.val dbChunksize)
          case chunk of
            Nothing -> throwM SourceFilesContentUnavailable
            Just (E.Value c) -> do
              observeSourcedChunk StorageDB $ olength c
              return . Just . (c, ) $ if
                | olength c >= dbChunksize -> Just $ start + dbChunksize
                | otherwise                -> Nothing
      chunkHashes = E.selectSource . E.from $ \fileContentEntry -> do
        E.where_ $ fileContentEntry E.^. FileContentEntryHash E.==. E.val fileReference
        E.orderBy [ E.asc $ fileContentEntry E.^. FileContentEntryIx ]
        return $ fileContentEntry E.^. FileContentEntryChunkHash
  chunkHashes .| C.map E.unValue .| awaitForever (\chunkHash -> C.unfoldM (retrieveChunk chunkHash) $ Just (1 :: Int))


sourceFileMinio :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, MonadUnliftIO m)
                => FileContentReference -> ConduitT () ByteString m ()
sourceFileMinio fileReference = do
  chunkVar <- newEmptyTMVarIO
  minioAsync <- lift . allocateLinkedAsync $
    maybeT (throwM SourceFilesContentUnavailable) $ do
      let uploadName = minioFileReference # fileReference
      uploadBucket <- getsYesod $ views appSettings appUploadCacheBucket
      hoistMaybe <=< runAppMinio . runMaybeT $ do
        objRes <- catchIfMaybeT minioIsDoesNotExist $ Minio.getObject uploadBucket uploadName Minio.defaultGetObjectOptions
        lift . runConduit $ Minio.gorObjectStream objRes .| C.mapM_ (atomically . putTMVar chunkVar)
  let go = do
        mChunk <- atomically $ Right <$> takeTMVar chunkVar
                           <|> Left  <$> waitCatchSTM minioAsync
        case mChunk of
          Right chunk -> do
            observeSourcedChunk StorageMinio $ olength chunk
            yield chunk
            go
          Left (Right ()) -> return ()
          Left (Left exc) -> throwM exc
   in go


sourceFiles :: Monad m => ConduitT FileReference DBFile m ()
sourceFiles = C.map sourceFile

sourceFile :: FileReference -> DBFile
sourceFile FileReference{..} = File
  { fileTitle = fileReferenceTitle
  , fileModified = fileReferenceModified
  , fileContent = toFileContent <$> fileReferenceContent
  }
  where
    toFileContent fileReference
      | fileReference == $$(liftTyped $ FileContentReference $$(emptyHash))
      = return ()
    toFileContent fileReference = do
      inDB <- lift . E.selectExists . E.from $ \fileContentEntry -> E.where_ $ fileContentEntry E.^. FileContentEntryHash E.==. E.val fileReference
      bool sourceFileMinio sourceFileDB inDB fileReference

sourceFiles' :: forall file m. (HasFileReference file, Monad m) => ConduitT file DBFile m ()
sourceFiles' = C.map sourceFile'

sourceFile' :: forall file. HasFileReference file => file -> DBFile
sourceFile' = sourceFile . view (_FileReference . _1)

  
acceptFile :: (MonadResource m, MonadResource m') => FileInfo -> m (File m')
acceptFile fInfo = do
  let fileTitle = "." <//> unpack (fileName fInfo)
                & normalise
                & makeValid
                & dropWhile isPathSeparator
                & dropWhileEnd isPathSeparator
                & normalise
                & makeValid
      fileContent = Just $ fileSource fInfo
  fileModified <- liftIO getCurrentTime
  return File{..}