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

Server side

Author: sorki

cabal.project

@@ -4,6 +4,7 @@ benchmarks: true
 packages:
   ./hnix-store-core/hnix-store-core.cabal
   ./hnix-store-db/hnix-store-db.cabal
+  ./hnix-store-json/hnix-store-json.cabal
   ./hnix-store-nar/hnix-store-nar.cabal
   ./hnix-store-readonly/hnix-store-readonly.cabal
   ./hnix-store-remote/hnix-store-remote.cabal

cabal.project.local.ci

@@ -4,6 +4,9 @@ package hnix-store-core
 package hnix-store-db
   ghc-options: -Wunused-packages -Wall -Werror
 
+package hnix-store-json
+  ghc-options: -Wunused-packages -Wall -Werror
+
 package hnix-store-nar
   ghc-options: -Wunused-packages -Wall -Werror
 

default.nix

@@ -22,6 +22,7 @@ in {
   inherit (haskellPackages)
     hnix-store-core
     hnix-store-db
+    hnix-store-json
     hnix-store-nar
     hnix-store-readonly
     hnix-store-remote

docs/01-Contributors.org

@@ -28,3 +28,6 @@ in order of appearance:
 + Luigy Leon @luigy
 + squalus @squalus
 + Vaibhav Sagar @vaibhavsagar
++ Ryan Trinkle @ryantrinkle
++ Travis Whitaker @TravisWhitaker
++ Andrea Bedini @andreabedini

hie.yaml

@@ -12,6 +12,12 @@ cradle:
     - path: "./hnix-store-db/tests"
       component: "hnix-store-db:test:db"
 
+    - path: "./hnix-store-json/src"
+      component: "lib:hnix-store-json"
+
+    - path: "./hnix-store-json/tests"
+      component: "hnix-store-json:test:json"
+
     - path: "./hnix-store-nar/src"
       component: "lib:hnix-store-nar"
 

hnix-store-core/CHANGELOG.md

@@ -1,6 +1,7 @@
 # Next
 
 * Changes:
+   * `System.Nix.StorePath.makeStorePathName` renamed to `System.Nix.StorePath.mkStorePathName`
    * `System.Nix.ReadOnlyStore` moved to `hnix-store-readonly` package
      and renamed to `System.Nix.Store.ReadOnly` [#247](https://github.com/haskell-nix/hnix-store/pull/247)
    * `System.Nix.Nar*` moved to `hnix-store-nar` package [#247](https://github.com/haskell-nix/hnix-store/pull/247)

hnix-store-core/hnix-store-core.cabal

@@ -65,6 +65,8 @@ library
     , System.Nix.Fingerprint
     , System.Nix.Hash
     , System.Nix.Hash.Truncation
+    , System.Nix.OutputName
+    , System.Nix.Realisation
     , System.Nix.Signature
     , System.Nix.Store.Types
     , System.Nix.StorePath
@@ -80,7 +82,7 @@ library
     , crypton
     , data-default-class
     , dependent-sum > 0.7
-    , dependent-sum-template > 0.1.1 && < 0.3
+    , dependent-sum-template >= 0.2.0.1 && < 0.3
     , filepath
     , hashable
     -- Required for crypton low-level type convertion
@@ -102,6 +104,7 @@ test-suite core
     Fingerprint
     Hash
     Signature
+    StorePath
   hs-source-dirs:
     tests
   build-tool-depends:

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

@@ -5,34 +5,40 @@ Maintainer  : srk <srk@48.io>
 module System.Nix.Build
   ( BuildMode(..)
   , BuildStatus(..)
-  , BuildResult(..)
   , buildSuccess
+  , BuildResult(..)
   ) where
 
+import Data.Map (Map)
 import Data.Time (UTCTime)
 import Data.Text (Text)
 import GHC.Generics (Generic)
 
--- keep the order of these Enums to match enums from reference implementations
+import System.Nix.OutputName (OutputName)
+import System.Nix.Realisation (DerivationOutput, Realisation)
+
+-- | Mode of the build operation
+-- Keep the order of these Enums to match enums from reference implementations
 -- src/libstore/store-api.hh
 data BuildMode
-  = BuildMode_Normal
-  | BuildMode_Repair
-  | BuildMode_Check
+  = BuildMode_Normal -- ^ Perform normal build
+  | BuildMode_Repair -- ^ Try to repair corrupted or missing paths by re-building or re-downloading them
+  | BuildMode_Check -- ^ Check if the build is reproducible (rebuild and compare to previous build)
   deriving (Eq, Generic, Ord, Enum, Show)
 
+-- | Build result status
 data BuildStatus =
-    BuildStatus_Built
-  | BuildStatus_Substituted
-  | BuildStatus_AlreadyValid
+    BuildStatus_Built -- ^ Build performed successfully
+  | BuildStatus_Substituted -- ^ Path substituted from cache
+  | BuildStatus_AlreadyValid -- ^ Path is already valid (available in local store)
   | BuildStatus_PermanentFailure
   | BuildStatus_InputRejected
   | BuildStatus_OutputRejected
-  | BuildStatus_TransientFailure -- possibly transient
-  | BuildStatus_CachedFailure    -- no longer used
-  | BuildStatus_TimedOut
+  | BuildStatus_TransientFailure -- ^ Possibly transient build failure
+  | BuildStatus_CachedFailure -- ^ Obsolete
+  | BuildStatus_TimedOut -- ^ Build timed out
   | BuildStatus_MiscFailure
-  | BuildStatus_DependencyFailed
+  | BuildStatus_DependencyFailed -- ^ Build dependency failed to build
   | BuildStatus_LogLimitExceeded
   | BuildStatus_NotDeterministic
   | BuildStatus_ResolvesToAlreadyValid
@@ -41,24 +47,27 @@ data BuildStatus =
 
 -- | Result of the build
 data BuildResult = BuildResult
-  { -- | build status, MiscFailure should be default
-    status             :: !BuildStatus
-  , -- | possible build error message
-    errorMessage       :: !(Maybe Text)
-  , -- | How many times this build was performed
-    timesBuilt         :: !Int
-  , -- | If timesBuilt > 1, whether some builds did not produce the same result
-    isNonDeterministic :: !Bool
-  ,  -- Start time of this build
-    startTime          :: !UTCTime
-  ,  -- Stop time of this build
-    stopTime           :: !UTCTime
+  { buildResultStatus             :: BuildStatus
+  -- ^ Build status, MiscFailure should be the default
+  , buildResultErrorMessage       :: Maybe Text
+  -- ^ Possible build error message
+  , buildResultTimesBuilt         :: Maybe Int
+  -- ^ How many times this build was performed (since 1.29)
+  , buildResultIsNonDeterministic :: Maybe Bool
+  -- ^ If timesBuilt > 1, whether some builds did not produce the same result (since 1.29)
+  , buildResultStartTime          :: Maybe UTCTime
+  -- ^ Start time of this build (since 1.29)
+  , buildResultStopTime           :: Maybe UTCTime
+  -- ^ Stop time of this build (since 1.29)
+  , buildResultBuiltOutputs       :: Maybe (Map (DerivationOutput OutputName) Realisation)
+  -- ^ Mapping of the output names to @Realisation@s (since 1.28)
+  -- (paths with additional info and their dependencies)
   }
   deriving (Eq, Generic, Ord, Show)
 
-buildSuccess :: BuildResult -> Bool
-buildSuccess BuildResult {..} =
-  status `elem`
+buildSuccess :: BuildStatus -> Bool
+buildSuccess x =
+  x `elem`
     [ BuildStatus_Built
     , BuildStatus_Substituted
     , BuildStatus_AlreadyValid

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

@@ -10,19 +10,22 @@ module System.Nix.DerivedPath (
   , derivedPathToText
   ) where
 
-import Data.Bifunctor (first)
 import GHC.Generics (Generic)
 import Data.Set (Set)
 import Data.Text (Text)
-import System.Nix.StorePath (StoreDir, StorePath, StorePathName, InvalidPathError)
+import System.Nix.OutputName (OutputName, InvalidNameError)
+import System.Nix.StorePath (StoreDir(..), StorePath, InvalidPathError)
 
+import qualified Data.Bifunctor
+import qualified Data.ByteString.Char8
 import qualified Data.Set
 import qualified Data.Text
+import qualified System.Nix.OutputName
 import qualified System.Nix.StorePath
 
 data OutputsSpec =
     OutputsSpec_All
-  | OutputsSpec_Names (Set StorePathName)
+  | OutputsSpec_Names (Set OutputName)
   deriving (Eq, Generic, Ord, Show)
 
 data DerivedPath =
@@ -32,20 +35,20 @@ data DerivedPath =
 
 data ParseOutputsError =
     ParseOutputsError_InvalidPath InvalidPathError
+  | ParseOutputsError_InvalidName InvalidNameError
   | ParseOutputsError_NoNames
+  | ParseOutputsError_NoPrefix StoreDir Text
   deriving (Eq, Ord, Show)
 
-convertError
-  :: Either InvalidPathError a
-  -> Either ParseOutputsError a
-convertError = first ParseOutputsError_InvalidPath
-
 parseOutputsSpec :: Text -> Either ParseOutputsError OutputsSpec
 parseOutputsSpec t
   | t == "*" = Right OutputsSpec_All
   | otherwise = do
   names <- mapM
-             (convertError . System.Nix.StorePath.makeStorePathName)
+             ( Data.Bifunctor.first
+                 ParseOutputsError_InvalidName
+             . System.Nix.OutputName.mkOutputName
+             )
              (Data.Text.splitOn "," t)
   if null names
     then Left ParseOutputsError_NoNames
@@ -55,21 +58,47 @@ outputsSpecToText :: OutputsSpec -> Text
 outputsSpecToText = \case
   OutputsSpec_All -> "*"
   OutputsSpec_Names ns ->
-    Data.Text.intercalate "," (fmap System.Nix.StorePath.unStorePathName (Data.Set.toList ns))
+    Data.Text.intercalate
+      ","
+      (fmap System.Nix.OutputName.unOutputName
+        (Data.Set.toList ns)
+      )
 
 parseDerivedPath
   :: StoreDir
   -> Text
   -> Either ParseOutputsError DerivedPath
-parseDerivedPath root p =
-  case Data.Text.breakOn "!" p of
-    (s, r) ->
-      if Data.Text.null r
-      then DerivedPath_Opaque
-           <$> (convertError $ System.Nix.StorePath.parsePathFromText root s)
-      else DerivedPath_Built
-           <$> (convertError $ System.Nix.StorePath.parsePathFromText root s)
-           <*> parseOutputsSpec (Data.Text.drop (Data.Text.length "!") r)
+parseDerivedPath root@(StoreDir sd) path =
+  let -- We need to do a bit more legwork for case
+      -- when StoreDir contains '!'
+      -- which is generated by its Arbitrary instance
+    textRoot = Data.Text.pack
+               $ Data.ByteString.Char8.unpack sd
+
+  in case Data.Text.stripPrefix textRoot path of
+    Nothing -> Left $ ParseOutputsError_NoPrefix root path
+    Just woRoot ->
+      case Data.Text.breakOn "!" woRoot of
+        (pathNoPrefix, r) ->
+          if Data.Text.null r
+          then DerivedPath_Opaque
+               <$> (convertError
+                   $ System.Nix.StorePath.parsePathFromText
+                      root
+                      path
+                   )
+          else DerivedPath_Built
+               <$> (convertError
+                   $ System.Nix.StorePath.parsePathFromText
+                       root
+                       (textRoot <> pathNoPrefix)
+                   )
+               <*> parseOutputsSpec (Data.Text.drop (Data.Text.length "!") r)
+  where
+    convertError
+      :: Either InvalidPathError a
+      -> Either ParseOutputsError a
+    convertError = Data.Bifunctor.first ParseOutputsError_InvalidPath
 
 derivedPathToText :: StoreDir -> DerivedPath -> Text
 derivedPathToText root = \case

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

@@ -26,8 +26,13 @@ import qualified Data.Text as Text
 -- | Produce the message signed by a NAR signature
 metadataFingerprint :: StoreDir -> StorePath -> Metadata StorePath -> Text
 metadataFingerprint storeDir storePath Metadata{..} = let
-  narSize = fromMaybe 0 narBytes
-  in fingerprint storeDir storePath narHash narSize (HashSet.toList references)
+  narSize = fromMaybe 0 metadataNarBytes
+  in fingerprint
+       storeDir
+       storePath
+       metadataNarHash
+       narSize
+       (HashSet.toList metadataReferences)
 
 -- | Produce the message signed by a NAR signature
 fingerprint :: StoreDir

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

@@ -0,0 +1,29 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-|
+Description : Derived path output names
+-}
+
+module System.Nix.OutputName
+  ( OutputName(..)
+  , mkOutputName
+  -- * Re-exports
+  , System.Nix.StorePath.InvalidNameError(..)
+  , System.Nix.StorePath.parseNameText
+  ) where
+
+import Data.Hashable (Hashable)
+import Data.Text (Text)
+import GHC.Generics (Generic)
+import System.Nix.StorePath (InvalidNameError)
+
+import qualified System.Nix.StorePath
+
+-- | Name of the derived path output
+-- Typically used for "dev", "doc" sub-outputs
+newtype OutputName = OutputName
+  { -- | Extract the contents of the name.
+    unOutputName :: Text
+  } deriving (Eq, Generic, Hashable, Ord, Show)
+
+mkOutputName :: Text -> Either InvalidNameError OutputName
+mkOutputName = fmap OutputName . System.Nix.StorePath.parseNameText