packages feed

hercules-ci-cnix-expr (empty) → 0.1.0.0

raw patch · 7 files changed

+705/−0 lines, 7 filesdep +aesondep +basedep +bytestring

Dependencies added: aeson, base, bytestring, conduit, containers, exceptions, hercules-ci-cnix-store, inline-c, inline-c-cpp, protolude, text

Files

+ CHANGELOG.md view
@@ -0,0 +1,12 @@++# Changelog++All notable changes to this package will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/).++## 0.1.0.0 - 2021-03-07++### Added++ - First code based on Hercules CI Agent.
+ hercules-ci-cnix-expr.cabal view
@@ -0,0 +1,79 @@+cabal-version: 2.4++name:           hercules-ci-cnix-expr+version:        0.1.0.0+synopsis:       Bindings for the Nix evaluator+category:       Nix, CI, Testing, DevOps+homepage:       https://docs.hercules-ci.com+bug-reports:    https://github.com/hercules-ci/hercules-ci-agent/issues+author:         Hercules CI contributors+maintainer:     info@hercules-ci.com+copyright:      2018-2021 Hercules CI+license:        Apache-2.0+build-type:     Simple+extra-source-files:+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/hercules-ci/hercules-ci-agent++-- match the C++ language standard Nix is using+common cxx-opts+  cxx-options:+    -std=c++17+    -Wall+  extra-libraries: stdc++++  if os(darwin)+    -- avoid https://gitlab.haskell.org/ghc/ghc/issues/11829+    ld-options:  -Wl,-keep_dwarf_unwind++  if impl(ghc >= 8.10)+    ghc-options:+      -optcxx-std=c++17+      -optcxx-Wall+  else+    ghc-options:+      -optc-std=c++17+      -optc-Wall+    if os(darwin)+      ghc-options: -pgmc=clang+++++library+  import: cxx-opts+  exposed-modules:+      Hercules.CNix.Expr+      Hercules.CNix.Expr.Context+      Hercules.CNix.Expr.Raw+      Hercules.CNix.Expr.Typed++  hs-source-dirs:+      src+  default-extensions: DeriveGeneric DeriveTraversable DisambiguateRecordFields FlexibleContexts InstanceSigs LambdaCase MultiParamTypeClasses NoImplicitPrelude OverloadedStrings RankNTypes TupleSections TypeApplications TypeOperators+  ghc-options: -Wall -fwarn-tabs -fwarn-unused-imports -fwarn-missing-signatures -fwarn-name-shadowing -fwarn-incomplete-patterns+  build-depends:+      aeson+    , base >=4.7 && <5+    , bytestring+    , conduit+    , hercules-ci-cnix-store+    , containers+    , exceptions+    , inline-c+    , inline-c-cpp+    , protolude >= 0.3+    , text+  default-language: Haskell2010+  include-dirs:+      include+  install-includes:+      hercules-ci-cnix/expr.hxx+  extra-libraries:+      boost_context+  pkgconfig-depends:+      nix-store >= 2.0+    , nix-expr >= 2.0+    , nix-main >= 2.0+    , bdw-gc
+ include/hercules-ci-cnix/expr.hxx view
@@ -0,0 +1,9 @@+#pragma once++#include "derivations.hh"+#include <hercules-ci-cnix/store.hxx>++typedef nix::Strings::iterator StringsIterator;+typedef nix::DerivationOutputs::iterator DerivationOutputsIterator;+typedef nix::DerivationInputs::iterator DerivationInputsIterator;+typedef nix::StringPairs::iterator StringPairsIterator;
+ src/Hercules/CNix/Expr.hs view
@@ -0,0 +1,319 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}++module Hercules.CNix.Expr+  ( module Hercules.CNix.Expr,+    RawValue,+    rawValueType,+    module Hercules.CNix.Store,+    module Hercules.CNix.Expr.Typed,+    type EvalState,+  )+where++-- TODO: No more Ptr EvalState+-- TODO: No more NixStore when EvalState is already there+-- TODO: Map Nix-specific C++ exceptions to a CNix exception type++import Conduit+import qualified Data.Map as M+import Foreign (nullPtr)+import qualified Foreign.C.String+import Hercules.CNix.Expr.Context+import Hercules.CNix.Expr.Raw+import Hercules.CNix.Expr.Typed+import Hercules.CNix.Store+import Hercules.CNix.Store.Context+import qualified Language.C.Inline.Cpp as C+import qualified Language.C.Inline.Cpp.Exceptions as C+import Protolude hiding (evalState, throwIO)++C.context (Hercules.CNix.Store.Context.context <> Hercules.CNix.Expr.Context.evalContext)++C.include "<stdio.h>"++C.include "<cstring>"++C.include "<math.h>"++C.include "<nix/config.h>"++C.include "<nix/shared.hh>"++C.include "<nix/eval.hh>"++C.include "<nix/eval-inline.hh>"++C.include "<nix/store-api.hh>"++C.include "<nix/common-eval-args.hh>"++C.include "<nix/get-drvs.hh>"++C.include "<nix/derivations.hh>"++C.include "<nix/affinity.hh>"++C.include "<nix/globals.hh>"++C.include "hercules-ci-cnix/expr.hxx"++C.include "<gc/gc.h>"++C.include "<gc/gc_cpp.h>"++C.include "<gc/gc_allocator.h>"++C.using "namespace nix"++C.verbatim "\nGC_API void GC_CALL GC_throw_bad_alloc() { throw std::bad_alloc(); }\n"++init :: IO ()+init =+  void+    [C.throwBlock| void {+      nix::initNix();+      nix::initGC();+    } |]++setTalkative :: IO ()+setTalkative =+  [C.throwBlock| void {+    nix::verbosity = nix::lvlTalkative;+  } |]++setDebug :: IO ()+setDebug =+  [C.throwBlock| void {+    nix::verbosity = nix::lvlVomit;+  } |]++setGlobalOption :: Text -> Text -> IO ()+setGlobalOption opt value = do+  let optionStr = encodeUtf8 opt+      valueStr = encodeUtf8 value+  [C.throwBlock| void {+    globalConfig.set($bs-cstr:optionStr, $bs-cstr:valueStr);+  }|]++setOption :: Text -> Text -> IO ()+setOption opt value = do+  let optionStr = encodeUtf8 opt+      valueStr = encodeUtf8 value+  [C.throwBlock| void {+    settings.set($bs-cstr:optionStr, $bs-cstr:valueStr);+  }|]++logInfo :: Text -> IO ()+logInfo t = do+  let bstr = encodeUtf8 t+  [C.throwBlock| void {+    printInfo($bs-cstr:bstr);+  }|]++withEvalState ::+  Store ->+  (Ptr EvalState -> IO a) ->+  IO a+withEvalState (Store store) =+  bracket+    ( liftIO+        [C.throwBlock| EvalState* {+          Strings searchPaths;+          return new EvalState(searchPaths, *$(refStore* store));+        } |]+    )+    (\x -> liftIO [C.throwBlock| void { delete $(EvalState* x); } |])++withEvalStateConduit ::+  MonadResource m =>+  Store ->+  (Ptr EvalState -> ConduitT i o m r) ->+  ConduitT i o m r+withEvalStateConduit (Store store) =+  bracketP+    ( liftIO+        [C.throwBlock| EvalState* {+          Strings searchPaths;+          return new EvalState(searchPaths, *$(refStore* store));+        } |]+    )+    (\x -> liftIO [C.throwBlock| void { delete $(EvalState* x); } |])++evalFile :: Ptr EvalState -> FilePath -> IO RawValue+evalFile evalState filename = do+  filename' <- Foreign.C.String.newCString filename+  mkRawValue+    =<< [C.throwBlock| Value* {+      Value value;+      $(EvalState *evalState)->evalFile($(const char *filename'), value);+      return new (NoGC) Value(value);+    }|]++-- leaks+newStrings :: IO (Ptr Strings)+newStrings = [C.exp| Strings* { new (NoGC) Strings() }|]++appendString :: Ptr Strings -> ByteString -> IO ()+appendString ss s =+  [C.block| void {+    $(Strings *ss)->push_back(std::string($bs-ptr:s, $bs-len:s));+  }|]++evalArgs :: Ptr EvalState -> [ByteString] -> IO (Value NixAttrs)+evalArgs evalState args = do+  argsStrings <- newStrings+  forM_ args $ appendString argsStrings+  fmap unsafeAssertType . mkRawValue+    =<< [C.throwBlock| Value * {+      Strings *args = $(Strings *argsStrings);+      struct MixEvalArgs evalArgs;+      Bindings *autoArgs;+      EvalState &state = *$(EvalState *evalState);++      evalArgs.parseCmdline(*args);+      autoArgs = evalArgs.getAutoArgs(state);+      if (!autoArgs) {+        throw nix::Error("Could not evaluate automatic arguments");+      }+      Value *r = new (NoGC) Value ();+      r->type = tAttrs;+      r->attrs = autoArgs;+      return r;+    }|]++autoCallFunction :: Ptr EvalState -> RawValue -> Value NixAttrs -> IO RawValue+autoCallFunction evalState (RawValue fun) (Value (RawValue autoArgs)) =+  mkRawValue+    =<< [C.throwBlock| Value* {+          Value result;+          $(EvalState *evalState)->autoCallFunction(+                  *$(Value *autoArgs)->attrs,+                  *$(Value *fun),+                  result);+          return new (NoGC) Value (result);+        }|]++isDerivation :: Ptr EvalState -> RawValue -> IO Bool+isDerivation evalState (RawValue v) =+  (0 /=)+    <$> [C.throwBlock| int {+          if ($(Value *v) == NULL) { throw std::invalid_argument("forceValue value must be non-null"); }+          $(EvalState *evalState)->forceValue(*$(Value *v));+          return $(EvalState *evalState)->isDerivation(*$(Value *v));+        }|]++isFunctor :: Ptr EvalState -> RawValue -> IO Bool+isFunctor evalState (RawValue v) =+  (0 /=)+    <$> [C.throwBlock| int {+          if ($(Value *v) == NULL) { throw std::invalid_argument("forceValue value must be non-null"); }+          return $(EvalState *evalState)->isFunctor(*$(Value *v));+        }|]++getRecurseForDerivations :: Ptr EvalState -> Value NixAttrs -> IO Bool+getRecurseForDerivations evalState (Value (RawValue v)) =+  (0 /=)+    <$> [C.throwBlock| int {+          Value *v = $(Value *v);+          EvalState *evalState = $(EvalState *evalState);+          Symbol rfd = evalState->symbols.create("recurseForDerivations");+          Bindings::iterator iter = v->attrs->find(rfd);+          if (iter == v->attrs->end()) {+            return 0;+          } else {+            evalState->forceValue(*iter->value);+            if (iter->value->type == ValueType::tBool) {+              return iter->value->boolean ? 1 : 0;+            } else {+              // They can be empty attrsets???+              // Observed in nixpkgs master 67e2de195a4aa0a50ffb1e1ba0b4fb531dca67dc+              return 1;+            }+          }+        } |]++getAttr :: Ptr EvalState -> Value NixAttrs -> ByteString -> IO (Maybe RawValue)+getAttr evalState (Value (RawValue v)) k =+  mkNullableRawValue+    =<< [C.throwBlock| Value *{+      Value &v = *$(Value *v);+      EvalState &evalState = *$(EvalState *evalState);+      Symbol k = evalState.symbols.create($bs-cstr:k);+      Bindings::iterator iter = v.attrs->find(k);+      if (iter == v.attrs->end()) {+        return nullptr;+      } else {+        return iter->value;+      }+    }|]++-- | Converts 'nullPtr' to 'Nothing'; actual values to @Just (a :: 'RawValue')@+mkNullableRawValue :: Ptr Value' -> IO (Maybe RawValue)+mkNullableRawValue p | p == nullPtr = pure Nothing+mkNullableRawValue p = Just <$> mkRawValue p++getAttrs :: Value NixAttrs -> IO (Map ByteString RawValue)+getAttrs (Value (RawValue v)) = do+  begin <- [C.exp| Attr *{ $(Value *v)->attrs->begin() }|]+  end <- [C.exp| Attr *{ $(Value *v)->attrs->end() }|]+  let gather :: Map ByteString RawValue -> Ptr Attr' -> IO (Map ByteString RawValue)+      gather acc i | i == end = pure acc+      gather acc i = do+        name <- unsafeMallocBS [C.exp| const char *{ strdup(static_cast<std::string>($(Attr *i)->name).c_str()) } |]+        value <- mkRawValue =<< [C.exp| Value *{ new (NoGC) Value(*$(Attr *i)->value) } |]+        let acc' = M.insert name value acc+        seq acc' pass+        gather acc' =<< [C.exp| Attr *{ &$(Attr *i)[1] }|]+  gather mempty begin++getDrvFile :: MonadIO m => Ptr EvalState -> RawValue -> m ByteString+getDrvFile evalState (RawValue v) =+  unsafeMallocBS+    [C.throwBlock| const char *{+      EvalState &state = *$(EvalState *evalState);+      auto drvInfo = getDerivation(state, *$(Value *v), false);+      if (!drvInfo)+        throw EvalError("Not a valid derivation");++      std::string drvPath = drvInfo->queryDrvPath();++      // write it (?)+      auto drv = state.store->derivationFromPath(drvPath);++      return strdup(drvPath.c_str());+    }|]++getAttrBool :: Ptr EvalState -> Value NixAttrs -> ByteString -> IO (Either SomeException (Maybe Bool))+getAttrBool evalState attrset attrName = do+  attrMaybe <- getAttr evalState attrset attrName+  attrMaybe & maybe (pure (Right Nothing)) \attr -> do+    match evalState attr >>= \case+      Left e -> do+        pure $ Left e+      Right (IsBool r) -> do+        b <- getBool r+        pure $ Right (Just b)+      Right _ -> do+        pure $ Right Nothing++getList :: Value NixList -> IO [RawValue]+getList (Value (RawValue nixList)) = do+  len <- [C.exp| int { $(Value *nixList)->listSize() }|]+  let getElem i = mkRawValue =<< [C.exp| Value * { $(Value *nixList)->listElems()[$(int i)] }|]+  for [0 .. (len - 1)] \i -> do+    getElem i++getAttrList :: Ptr EvalState -> Value NixAttrs -> ByteString -> IO (Either SomeException (Maybe [RawValue]))+getAttrList evalState attrset attrName = do+  attrMaybe <- getAttr evalState attrset attrName+  attrMaybe & maybe (pure (Right Nothing)) \attr -> do+    match evalState attr >>= \case+      Left e -> do+        pure $ Left e+      Right (IsList r) -> do+        b <- getList r+        pure $ Right (Just b)+      Right _ -> do+        pure $ Right Nothing
+ src/Hercules/CNix/Expr/Context.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}++module Hercules.CNix.Expr.Context+  ( module Hercules.CNix.Expr.Context,+    module Hercules.CNix.Store.Context,+  )+where++import qualified Data.Map as M+import Hercules.CNix.Store.Context hiding (context)+import qualified Language.C.Inline.Context as C+import qualified Language.C.Inline.Cpp as C+import qualified Language.C.Types as C+import Protolude++data EvalState++data Value'++data Attr'++context :: C.Context+context =+  C.cppCtx <> C.fptrCtx+    <> C.bsCtx+    <> evalContext++(=:) :: k -> a -> Map k a+(=:) = M.singleton++evalContext :: C.Context+evalContext =+  mempty+    { C.ctxTypesTable =+        C.TypeName "EvalState" =: [t|EvalState|]+          <> C.TypeName "Value" =: [t|Value'|]+          <> C.TypeName "Attr" =: [t|Attr'|]+    }
+ src/Hercules/CNix/Expr/Raw.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}++module Hercules.CNix.Expr.Raw where++import Hercules.CNix.Expr.Context+import qualified Language.C.Inline.Cpp as C+import qualified Language.C.Inline.Cpp.Exceptions as C+import Protolude hiding (evalState)+import Prelude ()++C.context context++C.include "<nix/config.h>"++C.include "<nix/eval.hh>"++C.include "<nix/eval-inline.hh>"++C.include "<hercules-ci-cnix/expr.hxx>"++C.include "<gc/gc.h>"++C.include "<gc/gc_cpp.h>"++C.include "<gc/gc_allocator.h>"++C.using "namespace nix"++newtype RawValue = RawValue (Ptr Value')++-- | Takes ownership of the value.+mkRawValue :: Ptr Value' -> IO RawValue+mkRawValue p = pure $ RawValue p++-- | Similar to Nix's Value->type but conflates the List variations+data RawValueType+  = Int+  | Bool+  | String+  | Path+  | Null+  | Attrs+  | List+  | Thunk+  | App+  | Lambda+  | Blackhole+  | PrimOp+  | PrimOpApp+  | External+  | Float+  | Other+  deriving (Generic, Show, Eq, Ord)++-- | You may need to 'forceValue' first.+rawValueType :: RawValue -> IO RawValueType+rawValueType (RawValue v) =+  f+    <$> [C.block| int {+      switch ($(Value* v)->type) {+        case tInt:         return 1;+        case tBool:        return 2;+        case tString:      return 3;+        case tPath:        return 4;+        case tNull:        return 5;+        case tAttrs:       return 6;+        case tList1:       return 7;+        case tList2:       return 8;+        case tListN:       return 9;+        case tThunk:       return 10;+        case tApp:         return 11;+        case tLambda:      return 12;+        case tBlackhole:   return 13;+        case tPrimOp:      return 14;+        case tPrimOpApp:   return 15;+        case tExternal:    return 16;+        case tFloat:       return 17;+        default: return 0;+      }+    }|]+  where+    f 1 = Int+    f 2 = Bool+    f 3 = String+    f 4 = Path+    f 5 = Null+    f 6 = Attrs+    f 7 = List+    f 8 = List+    f 9 = List+    f 10 = Thunk+    f 11 = App+    f 12 = Lambda+    f 13 = Blackhole+    f 14 = PrimOp+    f 15 = PrimOpApp+    f 16 = External+    f 17 = Float+    f _ = Other++forceValue :: Exception a => Ptr EvalState -> RawValue -> IO (Either a ())+forceValue evalState (RawValue v) =+  try+    [C.catchBlock|  {+      Value *v = $(Value *v);+      if (v == NULL) throw std::invalid_argument("forceValue value must be non-null");+      $(EvalState *evalState)->forceValue(*v);+    }|]
+ src/Hercules/CNix/Expr/Typed.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}++module Hercules.CNix.Expr.Typed where++import Control.Exception (throwIO)+import Hercules.CNix.Expr.Context+import Hercules.CNix.Expr.Raw+import qualified Language.C.Inline.Cpp as C+import Protolude hiding+  ( evalState,+    throwIO,+  )+import Prelude (userError)++C.context context++C.include "<stdio.h>"++C.include "<cstring>"++C.include "<math.h>"++C.include "<nix/config.h>"++C.include "<nix/shared.hh>"++C.include "<nix/eval.hh>"++C.include "<nix/eval-inline.hh>"++C.include "<nix/store-api.hh>"++C.include "<nix/common-eval-args.hh>"++C.include "<nix/get-drvs.hh>"++C.include "<nix/derivations.hh>"++C.include "<nix/affinity.hh>"++C.include "<nix/globals.hh>"++C.include "hercules-ci-cnix/expr.hxx"++C.include "<gc/gc.h>"++C.include "<gc/gc_cpp.h>"++C.include "<gc/gc_allocator.h>"++C.using "namespace nix"++-- | Runtime-Typed Value. This implies that it has been forced,+-- because otherwise the type would not be known.+newtype Value a = Value {rtValue :: RawValue}++data NixInt++data NixFloat++data NixString++data NixPath++data NixAttrs++data NixFunction++data NixList++data NixPrimOp++data NixPrimOpApp++data NixExternal++-- TODO: actually encapsulate the constructor+unsafeAssertType :: RawValue -> Value a+unsafeAssertType = Value++-- This is useful because you regain exhaustiveness checking.+-- Otherwise a bunch of downcast functions might do.+data Match+  = IsInt (Value NixInt)+  | IsBool (Value Bool)+  | IsString (Value NixString)+  | IsPath (Value NixPath)+  | IsNull (Value ())+  | IsAttrs (Value NixAttrs)+  | IsList (Value NixList)+  | IsFunction (Value NixFunction)+  | IsExternal (Value NixExternal)+  | IsFloat (Value NixFloat)++-- FIXME: errors don't provide any clue here+match :: Ptr EvalState -> RawValue -> IO (Either SomeException Match)+match es v =+  forceValue es v >>= \case+    Left e -> pure (Left e)+    Right _ ->+      rawValueType v <&> \case+        Int -> pure $ IsInt $ unsafeAssertType v+        Bool -> pure $ IsBool $ unsafeAssertType v+        String -> pure $ IsString $ unsafeAssertType v+        Path -> pure $ IsPath $ unsafeAssertType v+        Null -> pure $ IsNull $ unsafeAssertType v+        Attrs -> pure $ IsAttrs $ unsafeAssertType v+        List -> pure $ IsList $ unsafeAssertType v+        Thunk -> Left $ SomeException $ userError "Could not force Nix thunk" -- FIXME: custom exception?+        App -> Left $ SomeException $ userError "Could not force Nix thunk (App)"+        Blackhole ->+          Left $ SomeException $ userError "Could not force Nix thunk (Blackhole)"+        Lambda -> pure $ IsFunction $ unsafeAssertType v+        PrimOp -> pure $ IsFunction $ unsafeAssertType v+        PrimOpApp -> pure $ IsFunction $ unsafeAssertType v+        External -> pure $ IsExternal $ unsafeAssertType v+        Float -> pure $ IsFloat $ unsafeAssertType v+        Other ->+          Left $ SomeException $ userError "Unknown runtime type in Nix value"++match' :: Ptr EvalState -> RawValue -> IO Match+match' es v = match es v >>= \case Left e -> throwIO e; Right a -> pure a++getBool :: Value Bool -> IO Bool+getBool (Value (RawValue v)) =+  (0 /=)+    <$> [C.exp| int { $(Value *v)->boolean ? 1 : 0 }|]++-- NOT coerceToString+getStringIgnoreContext :: Value NixString -> IO ByteString+getStringIgnoreContext (Value (RawValue v)) =+  unsafeMallocBS+    [C.exp| const char *{+    strdup($(Value *v)->string.s)+  }|]