module Handler.Utils.Files
  ( sourceFile, sourceFile'
  , sourceFiles, sourceFiles'
  , SourceFilesException(..)
  , sourceFileDB
  , 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)


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) -> 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))


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
      if
        | inDB -> sourceFileDB fileReference
        | otherwise -> 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 . Just)
                  atomically $ putTMVar chunkVar Nothing
            let go = do
                  mChunk <- atomically $ readTMVar chunkVar
                  case mChunk of
                    Nothing -> waitAsync minioAsync
                    Just chunk -> yield chunk >> go
             in go

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 = dropWhile isPathSeparator . dropTrailingPathSeparator . normalise . unpack $ fileName fInfo
      fileContent = Just $ fileSource fInfo
  fileModified <- liftIO getCurrentTime
  return File{..}