{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

-- This implements an optimized routine to build from a remote derivation.
-- It is not in the "CNix" tree because it seems to be too specific for general use.
-- BuildStatus and BuildResult *can* be moved there, but I do not know of an
-- easy to maintain approach to do decouple it with inline-c-cpp. Perhaps it's
-- better to use an FFI generator instead?

module Hercules.Agent.Worker.Build.Prefetched where

import CNix
import CNix.Internal.Context
import qualified Data.ByteString.Char8 as C8
import Foreign (FinalizerPtr, ForeignPtr, alloca, newForeignPtr, nullPtr, peek)
import Foreign.C (peekCString)
import qualified Language.C.Inline.Cpp as C
import qualified Language.C.Inline.Cpp.Exceptions as C
import Protolude

C.context context

C.include "<cstring>"

C.include "<nix/config.h>"

C.include "<nix/shared.hh>"

C.include "<nix/store-api.hh>"

C.include "<nix/get-drvs.hh>"

C.include "<nix/derivations.hh>"

C.include "<nix/affinity.hh>"

C.include "<nix/globals.hh>"

C.include "<nix/fs-accessor.hh>"

C.include "aliases.h"

C.using "namespace nix"

data BuildStatus
  = Built
  | Substituted
  | AlreadyValid
  | PermanentFailure
  | InputRejected
  | OutputRejected
  | TransientFailure -- possibly transient
  | CachedFailure -- no longer used
  | TimedOut
  | MiscFailure
  | DependencyFailed
  | LogLimitExceeded
  | NotDeterministic
  | Successful -- Catch-all for unknown successful status
  | UnknownFailure -- Catch-all for unknown unsuccessful status
  deriving (Show)

-- Must match the FFI boilerplate
toBuildStatus :: C.CInt -> BuildStatus
toBuildStatus 0 = Built
toBuildStatus 1 = Substituted
toBuildStatus 2 = AlreadyValid
toBuildStatus 3 = PermanentFailure
toBuildStatus 4 = InputRejected
toBuildStatus 5 = OutputRejected
toBuildStatus 6 = TransientFailure
toBuildStatus 7 = CachedFailure
toBuildStatus 8 = TimedOut
toBuildStatus 9 = MiscFailure
toBuildStatus 10 = DependencyFailed
toBuildStatus 11 = LogLimitExceeded
toBuildStatus 12 = NotDeterministic
toBuildStatus (-1) = Successful
toBuildStatus _ = UnknownFailure

data BuildResult
  = BuildResult
      { isSuccess :: Bool,
        status :: BuildStatus,
        startTime :: C.CTime,
        stopTime :: C.CTime,
        errorMessage :: Text
      }
  deriving (Show)

nullableForeignPtr :: FinalizerPtr a -> Ptr a -> IO (Maybe (ForeignPtr a))
nullableForeignPtr _ rawPtr | rawPtr == nullPtr = pure Nothing
nullableForeignPtr finalize rawPtr = Just <$> newForeignPtr finalize rawPtr

getDerivation :: Ptr (Ref NixStore) -> ByteString -> IO (Maybe (ForeignPtr Derivation))
getDerivation store derivationPath =
  nullableForeignPtr finalizeDerivation
    =<< [C.throwBlock| Derivation *{
      Store &store = **$(refStore* store);
      std::string derivationPath($bs-ptr:derivationPath, $bs-len:derivationPath);
      std::list<nix::ref<nix::Store>> stores = getDefaultSubstituters();
      stores.push_front(*$(refStore* store));

      nix::Derivation *derivation = nullptr;

      for (nix::ref<nix::Store> & currentStore : stores) {
        try {
          auto accessor = currentStore->getFSAccessor();
          auto drvText = accessor->readFile(derivationPath);

          Path tmpDir = createTempDir();
          AutoDelete delTmpDir(tmpDir, true);
          Path drvTmpPath = tmpDir + "/drv";
          writeFile(drvTmpPath, drvText, 0600);
          derivation = new nix::Derivation(nix::readDerivation(drvTmpPath));
          break;
        } catch (nix::Interrupted &e) {
          throw e;
        } catch (nix::Error &e) {
          printTalkative("ignoring exception during drv lookup in %s: %s", currentStore->getUri(), e.what());
        } catch (std::exception &e) {
          printTalkative("ignoring exception during drv lookup in %s: %s", currentStore->getUri(), e.what());
        } catch (...) {
          // FIXME: remove this and make the "specific" catches above work on darwin
          printTalkative("ignoring unknown exception during drv lookup in %s: %s", currentStore->getUri());
        }
      }
      return derivation;
    }|]

-- | @buildDerivation derivationPath derivationText@
buildDerivation :: Ptr (Ref NixStore) -> ByteString -> ForeignPtr Derivation -> Maybe [ByteString] -> IO BuildResult
buildDerivation store derivationPath derivation extraInputs =
  let extraInputsMerged = C8.intercalate "\n" (fromMaybe [] extraInputs)
      materializeDerivation = if isNothing extraInputs then 1 else 0
   in alloca $ \successPtr ->
        alloca $ \statusPtr ->
          alloca $ \startTimePtr ->
            alloca $ \stopTimePtr ->
              alloca $ \errorMessagePtr -> do
                [C.throwBlock| void {
      Store &store = **$(refStore* store);
      bool &success = *$(bool *successPtr);
      int &status = *$(int *statusPtr);
      const char *&errorMessage = *$(const char **errorMessagePtr);
      time_t &startTime = *$(time_t *startTimePtr);
      time_t &stopTime = *$(time_t *stopTimePtr);
      std::string derivationPath($bs-ptr:derivationPath, $bs-len:derivationPath);

      if ($(bool materializeDerivation)) {
        store.ensurePath(derivationPath);
        nix::PathSet paths{derivationPath};
        try {
          store.buildPaths(paths);
          status = -1;
          success = true;
          errorMessage = strdup("");
          startTime = 0;
          stopTime = 0;
        }
        catch (nix::Error &e) {
          status = -2;
          success = false;
          errorMessage = strdup(e.msg().c_str());
          startTime = 0;
          stopTime = 0;
        }
      }
      else {
        nix::BasicDerivation *derivation = new BasicDerivation(*$fptr-ptr:(Derivation *derivation));
        std::string extraInputsMerged($bs-ptr:extraInputsMerged, $bs-len:extraInputsMerged);
        std::string extraInput;
        std::istringstream stream(extraInputsMerged);

        while (std::getline(stream, extraInput)) {
          derivation->inputSrcs.insert(extraInput);
        }

        nix::BuildResult result = store.buildDerivation(derivationPath, *derivation);

        switch (result.status) {
          case nix::BuildResult::Built:
            status = 0;
            break;
          case nix::BuildResult::Substituted:
            status = 1;
            break;
          case nix::BuildResult::AlreadyValid:
            status = 2;
            break;
          case nix::BuildResult::PermanentFailure:
            status = 3;
            break;
          case nix::BuildResult::InputRejected:
            status = 4;
            break;
          case nix::BuildResult::OutputRejected:
            status = 5;
            break;
          case nix::BuildResult::TransientFailure: // possibly transient
            status = 6;
            break;
          case nix::BuildResult::CachedFailure: // no longer used
            status = 7;
            break;
          case nix::BuildResult::TimedOut:
            status = 8;
            break;
          case nix::BuildResult::MiscFailure:
            status = 9;
            break;
          case nix::BuildResult::DependencyFailed:
            status = 10;
            break;
          case nix::BuildResult::LogLimitExceeded:
            status = 11;
            break;
          case nix::BuildResult::NotDeterministic:
            status = 12;
            break;
          default:
            status = result.success() ? -1 : -2;
            break;
        }
        success = result.success();
        errorMessage = strdup(result.errorMsg.c_str());
        startTime = result.startTime;
        stopTime = result.stopTime;
      }
    }
    |]
                successValue <- peek successPtr
                statusValue <- peek statusPtr
                startTimeValue <- peek startTimePtr
                stopTimeValue <- peek stopTimePtr
                errorMessageValue0 <- peek errorMessagePtr
                errorMessageValue <- peekCString errorMessageValue0
                pure $ BuildResult
                  { isSuccess = successValue /= 0,
                    status = toBuildStatus statusValue,
                    startTime = startTimeValue,
                    stopTime = stopTimeValue,
                    errorMessage = toS errorMessageValue
                  }