Merge pull request #276 from haskell-nix/srk/daemon

Some more server

Author: sorki

docs/01-Contributors.org

@@ -31,3 +31,4 @@ in order of appearance:
 + Ryan Trinkle @ryantrinkle
 + Travis Whitaker @TravisWhitaker
 + Andrea Bedini @andreabedini
++ Dan Bornside @danbornside

hnix-store-core/src/System/Nix/DerivedPath.hs

@@ -25,12 +25,17 @@ import qualified System.Nix.StorePath
 
 data OutputsSpec =
     OutputsSpec_All
+  -- ^ Wildcard spec (^*) meaning all outputs
   | OutputsSpec_Names (Set OutputName)
+  -- ^ Set of specific outputs
   deriving (Eq, Generic, Ord, Show)
 
 data DerivedPath =
     DerivedPath_Opaque StorePath
+  -- ^ Fully evaluated store path that can't be built
+  -- but can be fetched
   | DerivedPath_Built StorePath OutputsSpec
+  -- ^ Derivation path and the outputs built from it
   deriving (Eq, Generic, Ord, Show)
 
 data ParseOutputsError =

hnix-store-core/src/System/Nix/Realisation.hs

@@ -8,6 +8,7 @@ module System.Nix.Realisation (
   , derivationOutputBuilder
   , derivationOutputParser
   , Realisation(..)
+  , RealisationWithId(..)
   ) where
 
 import Crypto.Hash (Digest)
@@ -80,8 +81,7 @@ derivationOutputBuilder outputName DerivationOutput{..} =
 --
 -- realisationId is ommited since it is a key
 -- of type @DerivationOutput OutputName@ so
--- we will use a tuple like @(DerivationOutput OutputName, Realisation)@
--- instead.
+-- we will use @RealisationWithId@ newtype
 data Realisation = Realisation
   { realisationOutPath :: StorePath
   -- ^ Output path
@@ -90,3 +90,14 @@ data Realisation = Realisation
   , realisationDependencies :: Map (DerivationOutput OutputName) StorePath
   -- ^ Dependent realisations required for this one to be valid
   } deriving (Eq, Generic, Ord, Show)
+
+-- | For wire protocol
+--
+-- We store this normalized in @Build.buildResultBuiltOutputs@
+-- as @Map (DerivationOutput OutputName) Realisation@
+-- but wire protocol needs it de-normalized so we
+-- need a special (From|To)JSON instances for it
+newtype RealisationWithId = RealisationWithId
+  { unRealisationWithId :: (DerivationOutput OutputName, Realisation)
+  }
+  deriving (Eq, Generic, Ord, Show)

hnix-store-json/src/System/Nix/JSON.hs

@@ -13,7 +13,7 @@ import Data.Aeson
 import Deriving.Aeson
 import System.Nix.Base (BaseEncoding(NixBase32))
 import System.Nix.OutputName (OutputName)
-import System.Nix.Realisation (DerivationOutput, Realisation)
+import System.Nix.Realisation (DerivationOutput, Realisation, RealisationWithId(..))
 import System.Nix.Signature (Signature)
 import System.Nix.StorePath (StoreDir(..), StorePath, StorePathName, StorePathHashPart)
 
@@ -159,18 +159,18 @@ deriving
   instance FromJSON Realisation
 
 -- For a keyed version of Realisation
--- we use (DerivationOutput OutputName, Realisation)
+-- we use RealisationWithId (DerivationOutput OutputName, Realisation)
 -- instead of Realisation.id :: (DerivationOutput OutputName)
 -- field.
-instance {-# OVERLAPPING #-} ToJSON (DerivationOutput OutputName, Realisation) where
-  toJSON (drvOut, r) =
+instance ToJSON RealisationWithId where
+  toJSON (RealisationWithId (drvOut, r)) =
     case toJSON r of
       Object o -> Object $ Data.Aeson.KeyMap.insert "id" (toJSON drvOut) o
       _ -> error "absurd"
 
-instance {-# OVERLAPPING #-} FromJSON (DerivationOutput OutputName, Realisation) where
+instance FromJSON RealisationWithId where
   parseJSON v@(Object o) = do
     r <- parseJSON @Realisation v
     drvOut <- o .: "id"
-    pure (drvOut, r)
+    pure (RealisationWithId (drvOut, r))
   parseJSON x = fail $ "Expected Object but got " ++ show x

hnix-store-remote/README.md

@@ -14,17 +14,14 @@ via `nix-daemon`.
 ```haskell
 {-# LANGUAGE OverloadedStrings #-}
 
-import Control.Monad (void)
-import Control.Monad.IO.Class (liftIO)
 import System.Nix.StorePath (mkStorePathName)
 import System.Nix.Store.Remote
 
 main :: IO ()
 main = do
-  void $ runStore $ do
+  runStore $ do
     syncWithGC
     roots <- findRoots
-    liftIO $ print roots
 
     res <- case mkStorePathName "hnix-store" of
       Left e -> error (show e)
@@ -33,5 +30,7 @@ main = do
          (StoreText name "Hello World!")
          mempty
          RepairMode_DontRepair
-    liftIO $ print res
+
+    pure (roots, res)
+  >>= print
 ```

hnix-store-remote/app/BuildDerivation.hs

@@ -2,39 +2,23 @@
 module Main where
 
 import Data.Default.Class (Default(def))
-import Data.Text (Text)
-import System.Nix.Derivation (Derivation)
-import System.Nix.StorePath (StorePath)
 
 import qualified Data.Text
-import qualified Data.Text.IO
-import qualified Data.Attoparsec.Text
 import qualified System.Environment
 import qualified System.Nix.Build
-import qualified System.Nix.Derivation
 import qualified System.Nix.StorePath
 import qualified System.Nix.Store.Remote
 
-parseDerivation :: FilePath -> IO (Derivation StorePath Text)
-parseDerivation source = do
-  contents <- Data.Text.IO.readFile source
-  case Data.Attoparsec.Text.parseOnly
-    (System.Nix.Derivation.parseDerivation def) contents of
-      Left e -> error e
-      Right drv -> pure drv
-
 main :: IO ()
 main = System.Environment.getArgs >>= \case
   [filename] -> do
     case System.Nix.StorePath.parsePathFromText def (Data.Text.pack filename) of
       Left e -> error $ show e
       Right p -> do
-        d <- parseDerivation filename
         out <-
             System.Nix.Store.Remote.runStore
           $ System.Nix.Store.Remote.buildDerivation
               p
-              d
               System.Nix.Build.BuildMode_Normal
         print out
   _ -> error "No input derivation file"

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

@@ -46,11 +46,6 @@ common commons
     , ViewPatterns
   default-language: Haskell2010
 
-common tests
-  import: commons
-  build-tool-depends:
-      tasty-discover:tasty-discover
-
 flag io-testsuite
   default:
     False
@@ -119,7 +114,9 @@ library
     , data-default-class
     , dependent-sum > 0.7
     , dependent-sum-template >= 0.2.0.1 && < 0.3
+--    , directory
     , dlist >= 1.0
+    , exceptions
     , generic-arbitrary < 1.1
     , hashable
     , text
@@ -139,7 +136,6 @@ executable build-derivation
     buildable: False
   build-depends:
       base >=4.12 && <5
-    , attoparsec
     , hnix-store-core
     , hnix-store-remote
     , data-default-class
@@ -163,7 +159,7 @@ executable remote-readme
   ghc-options: -pgmL markdown-unlit -Wall
 
 test-suite remote
-  import: tests
+  import: commons
   type:              exitcode-stdio-1.0
   main-is:           Driver.hs
   hs-source-dirs:    tests
@@ -187,7 +183,7 @@ test-suite remote
     , QuickCheck
 
 test-suite remote-io
-  import: tests
+  import: commons
 
   if !flag(io-testsuite) || os(darwin)
     buildable: False
@@ -206,9 +202,11 @@ test-suite remote-io
     , hnix-store-remote
     , hnix-store-tests
     , bytestring
+    , concurrency
     , containers
     , crypton
     , directory
+    , exceptions
     , filepath
     , hspec
     , hspec-expectations-lifted