{-
  Copyright (c) Meta Platforms, Inc. and affiliates.
  All rights reserved.

  This source code is licensed under the BSD-style license found in the
  LICENSE file in the root directory of this source tree.
-}

module Glean.Database.Catalog.Local.Files
  ( Files
  , fileCatalog
  ) where

import Control.Monad
import qualified Data.ByteString as BS
import qualified Data.HashMap.Strict as HashMap
import Data.List
import Data.Maybe
import qualified Data.Text as Text
import System.Directory
import System.FilePath

import qualified Thrift.Protocol.JSON as Thrift
import Util.Control.Exception (catchAll)
import Util.IO
import Util.Log

import Glean.Database.Catalog.Store
import Glean.Database.Exception
import Glean.Database.Meta (Meta)
import Glean.Database.Repo (databasePath)
import Glean.Types (Repo(..))
import Glean.Util.IO (readFileContents)

newtype Files = Files { _filesRoot :: FilePath }

metaPath :: FilePath -> Repo -> FilePath
metaPath root repo = databasePath root repo </> "meta"

fileCatalog :: FilePath -> Files
fileCatalog = Files

instance Store Files where
  list (Files root) = do
    ex <- doesDirectoryExist root
    if not ex then return mempty else do
    dirs <- filter (not . isPrefixOf ".") <$> getDirectoryContents root
    fmap (HashMap.fromList . catMaybes . concat) $ forM dirs $ \subdir -> do
      let dir = root </> subdir
          repo_name = Text.pack subdir
      hashes <- filter (not . isPrefixOf ".") <$> getDirectoryContents dir
        `catchAll` \exc -> do
          logError $ concat ["couldn't read directory ", dir, ": ", show exc]
          return []
      forM hashes $ \hash ->
        let path = dir </> hash
            skip msg = do
              logError $ concat [path, ": ", msg]
              return Nothing
        in
        do
          s <- readFileContents $ path </> "meta"
          case Thrift.deserializeJSON s of
            Right meta -> do
              return $ Just (Repo repo_name (Text.pack hash), meta)
            Left err -> skip err
        `catchAll` (skip . show)

  create (Files root) repo meta = do
    -- TODO: make this atomic if necessary (cf. renameat2)
    new <- not <$> doesFileExist (metaPath root repo)
    when new $ do
      createDirectoryIfMissing True $ databasePath root repo
      writeMeta root repo meta
    return new

  delete (Files root) repo = do
    -- TODO: make this atomic if necessary
    exists <- doesFileExist (metaPath root repo)
    when exists $ safeRemovePathForcibly $ metaPath root repo
    return exists

  put (Files root) repo meta = do
    -- TODO: make this atomic if necessary
    exists <- doesFileExist (metaPath root repo)
    when exists $ writeMeta root repo meta
    return exists

  get (Files root) repo = do
    let path = metaPath root repo
    exists <- doesFileExist (metaPath root repo)
    if exists
      then do
        s <- readFileContents $ path </> "meta"
        case Thrift.deserializeJSON s of
          Right meta -> return $ Just meta
          Left err -> dbError repo $  "can't parse '" ++ path ++ "': " ++ err
      else
        return Nothing

writeMeta :: FilePath -> Repo -> Meta -> IO ()
writeMeta root = writeFileAtomically
  (\h -> BS.hPut h . Thrift.serializeJSON)
  . metaPath root