wip adapt to new Derivation

cabal.project

@@ -10,6 +10,11 @@ packages:
   ./hnix-store-remote/hnix-store-remote.cabal
   ./hnix-store-tests/hnix-store-tests.cabal
 
+source-repository-package
+  type: git
+  location: https://github.com/sorki/Haskell-Nix-Derivation-Library
+  tag: cbc257264ebdcb1a2170b7b83aa131356e00ecbf
+
 -- till https://github.com/obsidiansystems/dependent-sum/pull/80
 allow-newer:
   dependent-sum:some

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

@@ -1,8 +1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module System.Nix.ContentAddress (
-    ContentAddress
-  , ContentAddressMethod
+    ContentAddress(..)
+  , ContentAddressMethod(..)
   , FileIngestionMethod
   , contentAddressBuilder
   , contentAddressParser
@@ -92,7 +92,7 @@ parseContentAddressMethod :: Parser ContentAddressMethod
 parseContentAddressMethod =
       TextIngestionMethod <$ "text:"
   <|> FileIngestionMethod <$ "fixed:"
-  <*> (FileIngestionMethod_FileRecursive <$ "r:" 
+  <*> (FileIngestionMethod_FileRecursive <$ "r:"
        <|> pure FileIngestionMethod_Flat)
 
 parseTypedDigest :: Parser (Either String (DSum HashAlgo Digest))

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

@@ -1,32 +1,72 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
 module System.Nix.Derivation
   ( parseDerivation
   , buildDerivation
+  , DerivationInputs(..)
   -- Re-exports
   , Derivation(..)
   , DerivationOutput(..)
   ) where
 
 import Data.Attoparsec.Text.Lazy (Parser)
+import Data.Set (Set)
+import Data.Some (Some(Some))
 import Data.Text (Text)
 import Data.Text.Lazy.Builder (Builder)
+import GHC.Generics (Generic)
 
-import Nix.Derivation (Derivation(..), DerivationOutput(..))
+import Nix.Derivation (Derivation(..))
+import System.Nix.ContentAddress (ContentAddress(..), ContentAddressMethod(..))
+import System.Nix.DerivedPath (DerivedPath(..), OutputsSpec(..))
+import System.Nix.Hash (HashAlgo)
 import System.Nix.StorePath (StoreDir, StorePath)
+import System.Nix.OutputName (OutputName)
 
 import qualified Data.Attoparsec.Text.Lazy
+import qualified Data.Set
 import qualified Data.Text
 import qualified Data.Text.Lazy
 import qualified Data.Text.Lazy.Builder
 
 import qualified Nix.Derivation
+import qualified System.Nix.OutputName
+import qualified System.Nix.Hash
 import qualified System.Nix.StorePath
 
-parseDerivation :: StoreDir -> Parser (Derivation StorePath Text)
+newtype DerivationInputs _fp _outputName = DerivationInputs
+  { unDerivationInputs :: Set DerivedPath }
+  deriving (Show, Eq, Ord, Generic)
+
+data DerivationOutput _fp
+  = DerivationOutput_InputAddressed StorePath
+  | DerivationOutput_CAFixed StorePath ContentAddress
+  | DerivationOutput_CAFloating (Some HashAlgo)
+  | DerivationOutput_Deferred
+  deriving (Show, Eq, Ord, Generic)
+
+parseDerivation
+  :: StoreDir
+  -> Parser (Derivation
+              StorePath
+              Text
+              OutputName
+              DerivationOutput
+              DerivationInputs
+            )
 parseDerivation expectedRoot =
   Nix.Derivation.parseDerivationWith
-    pathParser
     Nix.Derivation.textParser
+    outputName
+    fixedOutputParser
+    inputsParser
   where
+    outputName = do
+      text <- Nix.Derivation.textParser
+        -- System.Nix.OutputName.outputNameParser ?
+      case System.Nix.OutputName.mkOutputName text of
+        Left e -> fail (show e)
+        Right o -> pure o
     pathParser = do
       text <- Nix.Derivation.textParser
       case Data.Attoparsec.Text.Lazy.parseOnly
@@ -36,10 +76,152 @@ parseDerivation expectedRoot =
           Right p -> pure p
           Left e -> fail e
 
-buildDerivation :: StoreDir -> Derivation StorePath Text -> Builder
+    fixedOutputParser :: Parser (DerivationOutput StorePath)
+    fixedOutputParser = do
+      --path <- pathParser
+      tpath <- Nix.Derivation.textParser
+      ","
+      hashName <- Nix.Derivation.textParser
+      ","
+      digest <- Nix.Derivation.textParser
+      -- oof
+      -- * rename derivationOutput to RealisationDerivationOutput
+      -- or just RealisationOutput or something fitting
+      -- * drop its param and fix OutputName to it
+      -- * use separate DerivationOutput type for Derivations
+      -- if hashName == mempty || digest == mempty
+      if
+          | tpath /= mempty && hashName == mempty && digest == mempty ->
+              case Data.Attoparsec.Text.Lazy.parseOnly
+                    (System.Nix.StorePath.pathParser expectedRoot)
+                    (Data.Text.Lazy.fromStrict tpath)
+                of
+                  Left e -> fail e
+                  Right path -> pure $ DerivationOutput_InputAddressed path
+
+          | tpath /= mempty && hashName /= mempty && digest /= mempty ->
+              case System.Nix.Hash.mkNamedDigest hashName digest of
+                Left e -> error (show e) -- fail (show e)
+                Right namedDigest ->
+                  case Data.Attoparsec.Text.Lazy.parseOnly
+                        (System.Nix.StorePath.pathParser expectedRoot)
+                        (Data.Text.Lazy.fromStrict tpath)
+                    of
+                      Left e -> fail e
+                      Right path ->
+                        pure
+                        $ DerivationOutput_CAFixed
+                            path
+                            (ContentAddress TextIngestionMethod namedDigest)
+                            -- TODO: ^ parse CAMethod from prefix
+                            -- ContentAddressMethod is determited
+                            -- by parsing a prefix 'r:' for FileIngestionMethod::Recursive
+          | tpath == mempty && hashName /= mempty && digest == mempty ->
+              pure undefined -- CAFloating (Some HashAlgo)
+          | otherwise ->
+              fail "bad output in derivation"
+
+    inputsParser :: Parser (DerivationInputs StorePath OutputName)
+    inputsParser = do
+      drvs <- listOf $ do
+        "("
+        path <- pathParser
+        ","
+        outputNames <- listOf outputName
+        ")"
+        pure
+          $ DerivedPath_Built
+              path
+              (OutputsSpec_Names
+                (Data.Set.fromList outputNames)
+              )
+
+      ","
+      srcs <- fmap DerivedPath_Opaque <$> listOf pathParser
+      pure
+        $ DerivationInputs
+        $ Data.Set.fromList (drvs ++ srcs)
+
+    -- stolen from nix-derivation (BSD3)
+    listOf :: Parser a -> Parser [a]
+    listOf element = do
+      "["
+      es <- Data.Attoparsec.Text.Lazy.sepBy element ","
+      "]"
+      pure es
+
+
+buildDerivation
+  :: StoreDir
+  -> Derivation
+       StorePath
+       Text
+       OutputName
+       DerivationOutput
+       DerivationInputs
+  -> Builder
 buildDerivation storeDir =
   Nix.Derivation.buildDerivationWith
-    (string . System.Nix.StorePath.storePathToText storeDir)
     string
+    (string . System.Nix.OutputName.unOutputName)
+    fixedOutputBuilder
+    inputsBuilder
   where
     string = Data.Text.Lazy.Builder.fromText . Data.Text.pack . show
+
+    storePath = string . System.Nix.StorePath.storePathToText storeDir
+
+    fixedOutputBuilder :: DerivationOutput StorePath -> Builder
+    fixedOutputBuilder (DerivationOutput_InputAddressed path) =
+         storePath path
+      <> ","
+      <> string mempty
+      <> ","
+      <> string mempty
+    fixedOutputBuilder (DerivationOutput_CAFixed path (ContentAddress _method digest)) =
+         storePath path
+      <> ","
+      <> System.Nix.Hash.algoDigestBuilderSep
+          ','
+          digest
+
+    inputsBuilder :: DerivationInputs fp outputName -> Builder
+    inputsBuilder DerivationInputs{..} =
+      let
+        isBuilt (DerivedPath_Built _ _) = True
+        isBuilt _ = False
+
+        (drvs, srcs) = Data.Set.partition isBuilt unDerivationInputs
+
+        buildOutputsSpec (OutputsSpec_All) = error "..."
+        buildOutputsSpec (OutputsSpec_Names nameSet) =
+           listOf (string . System.Nix.OutputName.unOutputName) (Data.Set.toList nameSet)
+
+        buildDrv (DerivedPath_Built path outputsSpec) =
+             "("
+          <> storePath path
+          <> ","
+          <> buildOutputsSpec outputsSpec
+          <> ")"
+        buildDrv _ = mempty
+
+        buildSrc (DerivedPath_Opaque path) = storePath path
+        buildSrc _ = mempty
+      in
+           setOf buildDrv drvs
+        <> ","
+        <> setOf buildSrc srcs
+
+    -- stolen from nix-derivation (BSD3)
+    listOf :: (a -> Builder) -> [a] -> Builder
+    listOf _          []  = "[]"
+    listOf element (x:xs) =
+            "["
+        <>  element x
+        <>  foldMap rest xs
+        <>  "]"
+      where
+        rest y = "," <> element y
+
+    setOf :: (a -> Builder) -> Set a -> Builder
+    setOf element xs = listOf element (Data.Set.toList xs)

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

@@ -22,6 +22,7 @@ module System.Nix.Hash
   , decodeDigestWith
 
   , algoDigestBuilder
+  , algoDigestBuilderSep
   , digestBuilder
   ) where
 
@@ -183,9 +184,16 @@ digestBuilder digest =
   <> Data.Text.Lazy.Builder.fromText
       (System.Nix.Hash.encodeDigestWith NixBase32 digest)
 
--- | Builder for @DSum HashAlgo Digest@s
+-- | Builder for @DSum HashAlgo Digest@s using ':' as a separator
 algoDigestBuilder :: DSum HashAlgo Digest -> Builder
-algoDigestBuilder (a :=> d) =
+algoDigestBuilder = algoDigestBuilderSep ':'
+
+-- | Builder for @DSum HashAlgo Digest@s using specific separator
+algoDigestBuilderSep
+  :: Char
+  -> DSum HashAlgo Digest
+  -> Builder
+algoDigestBuilderSep separator (a :=> d) =
   Data.Text.Lazy.Builder.fromText (System.Nix.Hash.algoToText a)
-  <> ":"
+  <> Data.Text.Lazy.Builder.singleton separator
   <> Data.Text.Lazy.Builder.fromText (encodeDigestWith NixBase32 d)

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

@@ -6,16 +6,20 @@ Description : Derived path output names
 module System.Nix.OutputName
   ( OutputName(..)
   , mkOutputName
+  , outputNameParser
   -- * Re-exports
   , System.Nix.StorePath.InvalidNameError(..)
   , System.Nix.StorePath.parseNameText
   ) where
 
+import Data.Attoparsec.Text.Lazy (Parser, (<?>))
 import Data.Hashable (Hashable)
 import Data.Text (Text)
 import GHC.Generics (Generic)
 import System.Nix.StorePath (InvalidNameError)
 
+import qualified Data.Attoparsec.Text.Lazy
+import qualified Data.Text
 import qualified System.Nix.StorePath
 
 -- | Name of the derived path output
@@ -27,3 +31,19 @@ newtype OutputName = OutputName
 
 mkOutputName :: Text -> Either InvalidNameError OutputName
 mkOutputName = fmap OutputName . System.Nix.StorePath.parseNameText
+
+outputNameParser :: Parser OutputName
+outputNameParser = do
+  c0 <-
+    Data.Attoparsec.Text.Lazy.satisfy
+      (\c -> c /= '.' && System.Nix.StorePath.validStorePathNameChar c)
+      <?> "Leading path name character is a dot or invalid character"
+
+  rest <-
+    Data.Attoparsec.Text.Lazy.takeWhile
+    System.Nix.StorePath.validStorePathNameChar
+      <?> "Path name contains invalid character"
+
+  pure
+    $ OutputName
+    $ Data.Text.cons c0 rest

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

@@ -33,7 +33,7 @@ data DerivationOutput a = DerivationOutput
   { derivationOutputHash :: DSum HashAlgo Digest
   -- ^ Hash modulo of the derivation
   , derivationOutputOutput :: a
-  -- ^ Output (either a OutputName or StorePatH)
+  -- ^ Output (either a OutputName or StorePath)
   } deriving (Eq, Generic, Ord, Show)
 
 data DerivationOutputError

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

@@ -36,6 +36,8 @@ module System.Nix.StorePath
     -- * Utilities for tests
   , unsafeMakeStorePath
   , unsafeMakeStorePathHashPart
+    -- * Required by System.Nix.OutputName
+  , validStorePathNameChar
   ) where
 
 import Crypto.Hash (HashAlgorithm)

hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreRequest.hs

@@ -16,9 +16,10 @@ import Data.Text (Text)
 import Data.Some (Some(Some))
 
 import System.Nix.Build (BuildMode, BuildResult)
-import System.Nix.Derivation (Derivation)
+import System.Nix.Derivation (Derivation, DerivationInputs, DerivationOutput)
 import System.Nix.DerivedPath (DerivedPath)
 import System.Nix.Hash (HashAlgo)
+import System.Nix.OutputName (OutputName)
 import System.Nix.Signature (Signature)
 import System.Nix.Store.Types (FileIngestionMethod, RepairMode)
 import System.Nix.StorePath (StorePath, StorePathName, StorePathHashPart)
@@ -84,7 +85,7 @@ data StoreRequest :: Type -> Type where
 
   BuildDerivation
     :: StorePath
-    -> Derivation StorePath Text
+    -> Derivation StorePath Text OutputName DerivationOutput DerivationInputs
     -> BuildMode
     -> StoreRequest BuildResult
 

hnix-store-tests/src/System/Nix/Arbitrary/Derivation.hs

@@ -7,13 +7,22 @@ import Data.Text (Text)
 import Data.Text.Arbitrary ()
 import Data.Vector.Arbitrary ()
 import System.Nix.Derivation
+import System.Nix.OutputName (OutputName)
 import System.Nix.StorePath (StorePath)
 
 import Test.QuickCheck (Arbitrary(..))
 import Test.QuickCheck.Arbitrary.Generic (GenericArbitrary(..))
+import System.Nix.Arbitrary.ContentAddress ()
+import System.Nix.Arbitrary.DerivedPath ()
+import System.Nix.Arbitrary.Hash ()
+import System.Nix.Arbitrary.OutputName ()
 import System.Nix.Arbitrary.StorePath ()
 
-deriving via GenericArbitrary (Derivation StorePath Text)
-  instance Arbitrary (Derivation StorePath Text)
-deriving via GenericArbitrary (DerivationOutput StorePath Text)
-  instance Arbitrary (DerivationOutput StorePath Text)
+deriving via GenericArbitrary (Derivation StorePath Text OutputName DerivationOutput DerivationInputs)
+  instance Arbitrary (Derivation StorePath Text OutputName DerivationOutput DerivationInputs)
+
+deriving via GenericArbitrary (DerivationInputs StorePath OutputName)
+  instance Arbitrary (DerivationInputs StorePath OutputName)
+
+deriving via GenericArbitrary (DerivationOutput StorePath)
+  instance Arbitrary (DerivationOutput StorePath)