remote: add buildDerivation and test

sorki · sorki · commit ee58f66ba152 · 2020-06-12T09:39:47.000+02:00
Closes #20.
diff --git a/hnix-store-remote/hnix-store-remote.cabal b/hnix-store-remote/hnix-store-remote.cabal
@@ -33,6 +33,7 @@ library
                      , text
                      , unix
                      , network
+                     , nix-derivation >= 1.1.1 && <2
                      , mtl
                      , unordered-containers
                      , filepath
@@ -47,8 +48,8 @@ test-suite hnix-store-remote-tests
    ghc-options:       -rtsopts -fprof-auto
    type:              exitcode-stdio-1.0
    main-is:           Driver.hs
-   other-modules:
-       NixDaemon
+   other-modules:     Derivation
+                    , NixDaemon
    hs-source-dirs:    tests
    build-depends:
                        attoparsec
@@ -70,6 +71,7 @@ test-suite hnix-store-remote-tests
                      , tasty-quickcheck
                      , linux-namespaces
                      , mtl
+                     , nix-derivation
                      , temporary
                      , text
                      , time
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote.hs b/hnix-store-remote/src/System/Nix/Store/Remote.hs
@@ -16,6 +16,7 @@ module System.Nix.Store.Remote
   , addIndirectRoot
   , addTempRoot
   , buildPaths
+  , buildDerivation
   , ensurePath
   , findRoots
   , isValidPathUncached
@@ -41,6 +42,7 @@ import Data.ByteString.Lazy (ByteString)
 import Data.Map.Strict (Map)
 import Data.Text (Text)
 
+import Nix.Derivation (Derivation)
 import System.Nix.Build (BuildMode, BuildResult)
 import System.Nix.Hash (Digest, NamedAlgo, ValidAlgo, SomeNamedDigest(..))
 import System.Nix.Nar (Nar)
@@ -196,6 +198,23 @@ buildPaths ps bm = do
     putPaths ps
     putInt $ fromEnum bm
 
+buildDerivation :: StorePath
+                -> Derivation StorePath Text
+                -> BuildMode
+                -> MonadStore BuildResult
+buildDerivation p drv buildMode = do
+  runOpArgs BuildDerivation $ do
+    putPath p
+    putDerivation drv
+    putEnum buildMode
+    -- XXX: reason for this is unknown
+    -- but without it protocol just hangs waiting for
+    -- more data. Needs investigation
+    putInt 0
+
+  res <- getSocketIncremental $ getBuildResult
+  return res
+
 ensurePath :: StorePath -> MonadStore ()
 ensurePath pn = do
   void $ simpleOpArgs EnsurePath $ putPath pn
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Builders.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Builders.hs
@@ -15,7 +15,6 @@ import System.Nix.StorePath (ContentAddressableAddress(..), NarHashMode(..))
 import Data.Text.Lazy.Builder (Builder)
 import qualified Data.Text.Lazy.Builder
 
-import qualified Data.Text
 import qualified System.Nix.Hash
 
 -- | Marshall `ContentAddressableAddress` to `Text`
@@ -35,14 +34,9 @@ contentAddressableAddressBuilder (Text digest) =
 contentAddressableAddressBuilder (Fixed narHashMode (SomeDigest digest)) =
      "fixed:"
   <> (Data.Text.Lazy.Builder.fromText $ System.Nix.Hash.algoName @hashAlgo)
-  <> buildNarHashMode narHashMode
   <> digestBuilder digest
-  where
-    buildNarHashMode Recursive = "true"
-    buildNarHashMode RegularFile = "false"
 
 digestBuilder :: Digest a -> Builder
 digestBuilder =
     Data.Text.Lazy.Builder.fromText
   . System.Nix.Hash.encodeBase32
-
diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Util.hs
@@ -19,6 +19,8 @@ import qualified Data.ByteString.Lazy      as BSL
 
 import           Network.Socket.ByteString (recv, sendAll)
 
+import           Nix.Derivation
+
 import           System.Nix.Build
 import           System.Nix.StorePath
 import           System.Nix.Store.Remote.Binary
@@ -142,3 +144,20 @@ getBuildResult = BuildResult
   <*> getBool
   <*> getTime
   <*> getTime
+
+putDerivation :: Derivation StorePath Text -> Put
+putDerivation Derivation{..} = do
+  flip putMany (Data.Map.toList outputs)
+    $ \(outputName, DerivationOutput{..}) -> do
+      putText outputName
+      putPath path
+      putText hashAlgo
+      putText hash
+
+  putMany putPath inputSrcs
+  putText platform
+  putText builder
+  putMany putText args
+
+  flip putMany (Data.Map.toList env)
+    $ \(first, second) -> putText first >> putText second
diff --git a/hnix-store-remote/tests/Derivation.hs b/hnix-store-remote/tests/Derivation.hs
@@ -0,0 +1,69 @@
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE TypeApplications    #-}
+
+module Derivation where
+
+import           Control.Monad.IO.Class (liftIO)
+
+import           Data.Text (Text)
+import           Nix.Derivation (Derivation(..), DerivationOutput(..))
+import           System.Nix.StorePath (StorePath, storePathToText)
+
+import           System.Nix.Store.Remote (addToStore, addTextToStore)
+import           System.Nix.Hash (HashAlgorithm(Truncated, SHA256))
+
+import qualified Data.Map
+import qualified Data.Set
+import qualified Data.Text
+import qualified Data.Text.Lazy
+import qualified Data.Text.Lazy.Builder
+import qualified Data.Vector
+import qualified Nix.Derivation
+import qualified System.Process
+import qualified System.Nix.Derivation
+import qualified System.Nix.StorePath
+
+drvSample :: StorePath -> StorePath -> StorePath -> Derivation StorePath Text
+drvSample builder buildScript out = Derivation {
+    outputs   = Data.Map.fromList [ ("out", DerivationOutput out "sha256" "test") ]
+  , inputDrvs = Data.Map.fromList [ (builder, Data.Set.fromList [ "out" ]) ]
+  , inputSrcs = Data.Set.fromList [ buildScript ]
+  , platform  = "x86_64-linux"
+  , builder   = storePathToText builder
+  , args      = Data.Vector.fromList ["-e", storePathToText buildScript ]
+  , env       = Data.Map.fromList [("testEnv", "true")]
+  }
+
+withBash action = do
+  fp <- fmap init <$> liftIO $ System.Process.readProcess "which" ["bash"] ""
+  let Right n = System.Nix.StorePath.makeStorePathName "bash"
+  path <- addToStore @SHA256 n fp False (pure True) False
+  action path
+
+withBuildScript action = do
+  path <- addTextToStore
+    "buildScript"
+    (Data.Text.concat [ "declare -xp", "export > $out" ])
+    mempty
+    False
+
+  action path
+
+withDerivation action = withBuildScript $ \buildScript -> withBash $ \bash -> do
+  outputPath <- addTextToStore "wannabe-output" "" mempty False
+
+  let d = drvSample bash buildScript outputPath
+
+  path <- addTextToStore
+    "hnix-store-derivation"
+    (Data.Text.Lazy.toStrict
+      $ Data.Text.Lazy.Builder.toLazyText
+      $ System.Nix.Derivation.buildDerivation d
+    )
+    mempty
+    False
+    --(HS.fromList []) False
+  liftIO $ print d
+  action path d
+
diff --git a/hnix-store-remote/tests/NixDaemon.hs b/hnix-store-remote/tests/NixDaemon.hs
@@ -54,6 +54,7 @@ import           System.Nix.Store.Remote.Types
 import           System.Nix.Store.Remote.Protocol
 import           System.Nix.Store.Remote.Util
 
+import           Derivation
 
 createProcessEnv :: FilePath
                  -> String
@@ -294,3 +295,9 @@ spec_protocol = Hspec.around withNixDaemon $ do
         path <- dummy
         liftIO $ putStrLn $ show path
         (isValidPathUncached path) `shouldReturn` True
+
+    context "derivation" $ do
+      itRights "build derivation" $ do
+        withDerivation $ \path drv -> do
+          result <- buildDerivation path drv Normal
+          result `shouldSatisfy` ((==AlreadyValid) . status)
