remote: add buildDerivation and test

Author: sorki

hnix-store-remote/hnix-store-remote.cabal

@@ -30,6 +30,7 @@ library
                      , text
                      , unix
                      , network
+                     , nix-derivation
                      , mtl
                      , unordered-containers
                      , filepath
@@ -44,8 +45,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
@@ -67,6 +68,7 @@ test-suite hnix-store-remote-tests
                      , tasty-quickcheck
                      , linux-namespaces
                      , mtl
+                     , nix-derivation
                      , temporary
                      , text
                      , time

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
@@ -47,6 +48,7 @@ import qualified Data.Set
 import           Data.Proxy                (Proxy)
 import           Data.Text                 (Text)
 
+import           Nix.Derivation            (Derivation)
 
 import           System.Nix.Build          (BuildMode, BuildResult)
 import           System.Nix.Hash           (Digest, ValidAlgo)
@@ -156,6 +158,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

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
@@ -141,3 +143,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

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
+

hnix-store-remote/tests/NixDaemon.hs

@@ -53,6 +53,7 @@ import           System.Nix.Store.Remote.Types
 import           System.Nix.Store.Remote.Protocol
 import           System.Nix.Store.Remote.Util
 
+import           Derivation
 
 createProcessEnv :: FilePath -> String -> [String] -> IO P.ProcessHandle
 createProcessEnv fp proc args =do
@@ -288,3 +289,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)