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

Server side

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

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

@@ -0,0 +1,92 @@
+{-|
+Description : Derivation realisations
+-}
+
+module System.Nix.Realisation (
+    DerivationOutput(..)
+  , DerivationOutputError(..)
+  , derivationOutputBuilder
+  , derivationOutputParser
+  , Realisation(..)
+  ) where
+
+import Crypto.Hash (Digest)
+import Data.Map (Map)
+import Data.Set (Set)
+import Data.Text (Text)
+import Data.Text.Lazy.Builder (Builder)
+import Data.Dependent.Sum (DSum)
+import GHC.Generics (Generic)
+import System.Nix.Hash (HashAlgo)
+import System.Nix.OutputName (OutputName, InvalidNameError)
+import System.Nix.Signature (Signature)
+import System.Nix.StorePath (StorePath)
+
+import qualified Data.Bifunctor
+import qualified Data.Text
+import qualified Data.Text.Lazy.Builder
+import qualified System.Nix.Hash
+
+-- | Output of the derivation
+data DerivationOutput a = DerivationOutput
+  { derivationOutputHash :: DSum HashAlgo Digest
+  -- ^ Hash modulo of the derivation
+  , derivationOutputOutput :: a
+  -- ^ Output (either a OutputName or StorePatH)
+  } deriving (Eq, Generic, Ord, Show)
+
+data DerivationOutputError
+  = DerivationOutputError_Digest String
+  | DerivationOutputError_Name InvalidNameError
+  | DerivationOutputError_NoExclamationMark
+  | DerivationOutputError_NoColon
+  | DerivationOutputError_TooManyParts [Text]
+  deriving (Eq, Ord, Show)
+
+derivationOutputParser
+  :: (Text -> Either InvalidNameError outputName)
+  -> Text
+  -> Either DerivationOutputError (DerivationOutput outputName)
+derivationOutputParser outputName dOut =
+  case Data.Text.splitOn (Data.Text.singleton '!') dOut of
+    [] -> Left DerivationOutputError_NoColon
+    [sriHash, oName] -> do
+      hash <-
+        case Data.Text.splitOn (Data.Text.singleton ':') sriHash of
+          [] -> Left DerivationOutputError_NoColon
+          [hashName, digest] ->
+            Data.Bifunctor.first
+              DerivationOutputError_Digest
+              $ System.Nix.Hash.mkNamedDigest hashName digest
+          x -> Left $ DerivationOutputError_TooManyParts x
+      name <-
+        Data.Bifunctor.first
+          DerivationOutputError_Name
+          $ outputName oName
+
+      pure $ DerivationOutput hash name
+    x -> Left $ DerivationOutputError_TooManyParts x
+
+derivationOutputBuilder
+  :: (outputName -> Text)
+  -> DerivationOutput outputName
+  -> Builder
+derivationOutputBuilder outputName DerivationOutput{..} =
+     System.Nix.Hash.algoDigestBuilder derivationOutputHash
+  <> Data.Text.Lazy.Builder.singleton '!'
+  <> Data.Text.Lazy.Builder.fromText (outputName derivationOutputOutput)
+
+-- | Build realisation context
+--
+-- realisationId is ommited since it is a key
+-- of type @DerivationOutput OutputName@ so
+-- we will use a tuple like @(DerivationOutput OutputName, Realisation)@
+-- instead.
+data Realisation = Realisation
+  { realisationOutPath :: StorePath
+  -- ^ Output path
+  , realisationSignatures :: Set Signature
+  -- ^ Signatures
+  , realisationDependencies :: Map (DerivationOutput OutputName) StorePath
+  -- ^ Dependent realisations required for this one to be valid
+  } deriving (Eq, Generic, Ord, Show)

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

@@ -6,13 +6,17 @@ Description : Nix-relevant interfaces to NaCl signatures.
 
 module System.Nix.Signature
   ( Signature(..)
-  , NarSignature(..)
   , signatureParser
   , parseSignature
   , signatureToText
+  , NarSignature(..)
+  , narSignatureParser
+  , parseNarSignature
+  , narSignatureToText
   ) where
 
 import Crypto.Error (CryptoFailable(..))
+import Data.Attoparsec.Text (Parser)
 import Data.ByteString (ByteString)
 import Data.Text (Text)
 import GHC.Generics (Generic)
@@ -28,6 +32,26 @@ import qualified Data.Text
 newtype Signature = Signature Ed25519.Signature
   deriving (Eq, Generic, Show)
 
+signatureParser :: Parser Signature
+signatureParser = do
+  encodedSig <-
+    Data.Attoparsec.Text.takeWhile1
+      (\c -> Data.Char.isAlphaNum c || c == '+' || c == '/' || c == '=')
+  decodedSig <- case decodeWith Base64 encodedSig of
+    Left e -> fail e
+    Right decodedSig -> pure decodedSig
+  sig <- case Ed25519.signature decodedSig of
+    CryptoFailed e -> (fail . show) e
+    CryptoPassed sig -> pure sig
+  pure $ Signature sig
+
+parseSignature :: Text -> Either String Signature
+parseSignature = Data.Attoparsec.Text.parseOnly signatureParser
+
+signatureToText :: Signature -> Text
+signatureToText (Signature sig) =
+  encodeWith Base64 (Data.ByteArray.convert sig :: ByteString)
+
 -- | A detached signature attesting to a nix archive's validity.
 data NarSignature = NarSignature
   { -- | The name of the public key used to sign the archive.
@@ -43,26 +67,19 @@ instance Ord Signature where
     yBS = Data.ByteArray.convert y :: ByteString
     in compare xBS yBS
 
-signatureParser :: Data.Attoparsec.Text.Parser NarSignature
-signatureParser = do
+narSignatureParser :: Parser NarSignature
+narSignatureParser = do
   publicKey <- Data.Attoparsec.Text.takeWhile1 (/= ':')
   _ <- Data.Attoparsec.Text.string ":"
-  encodedSig <- Data.Attoparsec.Text.takeWhile1 (\c -> Data.Char.isAlphaNum c || c == '+' || c == '/' || c == '=')
-  decodedSig <- case decodeWith Base64 encodedSig of
-    Left e -> fail e
-    Right decodedSig -> pure decodedSig
-  sig <- case Ed25519.signature decodedSig of
-    CryptoFailed e -> (fail . show) e
-    CryptoPassed sig -> pure sig
-  pure $ NarSignature publicKey (Signature sig)
+  sig <- signatureParser
+  pure $ NarSignature {..}
 
-parseSignature :: Text -> Either String NarSignature
-parseSignature = Data.Attoparsec.Text.parseOnly signatureParser
+parseNarSignature :: Text -> Either String NarSignature
+parseNarSignature = Data.Attoparsec.Text.parseOnly narSignatureParser
 
-signatureToText :: NarSignature -> Text
-signatureToText NarSignature {publicKey, sig=Signature sig'} = let
-  b64Encoded = encodeWith Base64 (Data.ByteArray.convert sig' :: ByteString)
-  in mconcat [ publicKey, ":", b64Encoded ]
+narSignatureToText :: NarSignature -> Text
+narSignatureToText NarSignature {..} =
+  mconcat [ publicKey, ":", signatureToText sig ]
 
 instance Show NarSignature where
-  show narSig = Data.Text.unpack (signatureToText narSig)
+  show narSig = Data.Text.unpack (narSignatureToText narSig)

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

@@ -17,9 +17,10 @@ module System.Nix.StorePath
   , StorePathHashPart
   , mkStorePathHashPart
   , unStorePathHashPart
-  , -- * Manipulating 'StorePathName'
-    makeStorePathName
-  , validStorePathName
+    -- * Manipulating 'StorePathName'
+  , InvalidNameError(..)
+  , mkStorePathName
+  , parseNameText
     -- * Reason why a path is not valid
   , InvalidPathError(..)
   , -- * Rendering out 'StorePath's
@@ -115,12 +116,17 @@ mkStorePathHashPart =
   StorePathHashPart
   . System.Nix.Hash.mkStorePathHash @hashAlgo
 
--- | Reason why a path is not valid
-data InvalidPathError =
-    EmptyName
-  | PathTooLong
+-- | Reason why a path name or output name is not valid
+data InvalidNameError
+  = EmptyName
+  | NameTooLong Int
   | LeadingDot
-  | InvalidCharacter
+  | InvalidCharacters Text
+  deriving (Eq, Generic, Hashable, Ord, Show)
+
+-- | Reason why a path is not valid
+data InvalidPathError
+  = PathNameInvalid InvalidNameError
   | HashDecodingFailure String
   | RootDirMismatch
       { rdMismatchExpected :: StoreDir
@@ -129,26 +135,28 @@ data InvalidPathError =
   deriving (Eq, Generic, Hashable, Ord, Show)
 
 -- | Make @StorePathName@ from @Text@ (name part of the @StorePath@)
--- or fail with @InvalidPathError@ if it isn't valid
-makeStorePathName :: Text -> Either InvalidPathError StorePathName
-makeStorePathName n =
-  if validStorePathName n
-    then pure $ StorePathName n
-    else Left $ reasonInvalid n
+-- or fail with @InvalidNameError@ if it isn't valid
+mkStorePathName :: Text -> Either InvalidNameError StorePathName
+mkStorePathName = fmap StorePathName . parseNameText
 
-reasonInvalid :: Text -> InvalidPathError
-reasonInvalid n
-  | n == ""                  = EmptyName
-  | Data.Text.length n > 211 = PathTooLong
-  | Data.Text.head n == '.'  = LeadingDot
-  | otherwise                = InvalidCharacter
-
-validStorePathName :: Text -> Bool
-validStorePathName n =
-  n /= ""
-  && Data.Text.length n <= 211
-  && Data.Text.head n /= '.'
-  && Data.Text.all validStorePathNameChar n
+-- | Parse name (either @StorePathName@ or @OutputName@)
+parseNameText :: Text -> Either InvalidNameError Text
+parseNameText n
+  | n == ""
+    = Left EmptyName
+  | Data.Text.length n > 211
+    = Left $ NameTooLong (Data.Text.length n)
+  | Data.Text.head n == '.'
+    = Left $ LeadingDot
+  | not
+    $ Data.Text.null
+    $ Data.Text.filter
+        (not . validStorePathNameChar)
+        n
+    = Left
+      $ InvalidCharacters
+      $ Data.Text.filter (not . validStorePathNameChar) n
+  | otherwise = pure n
 
 validStorePathNameChar :: Char -> Bool
 validStorePathNameChar c =
@@ -220,11 +228,15 @@ parsePath' expectedRoot stringyPath =
   let
     (rootDir, fname) = System.FilePath.splitFileName stringyPath
     (storeBasedHashPart, namePart) = Data.Text.breakOn "-" $ Data.Text.pack fname
-    hashPart = Data.Bifunctor.bimap
-      HashDecodingFailure
-      StorePathHashPart
-      $ System.Nix.Base.decodeWith NixBase32 storeBasedHashPart
-    name = makeStorePathName . Data.Text.drop 1 $ namePart
+    hashPart =
+      Data.Bifunctor.bimap
+        HashDecodingFailure
+        StorePathHashPart
+        $ System.Nix.Base.decodeWith NixBase32 storeBasedHashPart
+    name =
+      Data.Bifunctor.first
+        PathNameInvalid
+        $ mkStorePathName . Data.Text.drop 1 $ namePart
     --rootDir' = dropTrailingPathSeparator rootDir
     -- cannot use ^^ as it drops multiple slashes /a/b/// -> /a/b
     rootDir' = init rootDir
@@ -288,11 +300,15 @@ pathParser expectedRoot = do
     validStorePathNameChar
       <?> "Path name contains invalid character"
 
-  let name = makeStorePathName $ Data.Text.cons c0 rest
-      hashPart = Data.Bifunctor.bimap
-        HashDecodingFailure
-        StorePathHashPart
-        digest
+  let name =
+        Data.Bifunctor.first
+          PathNameInvalid
+          $ mkStorePathName $ Data.Text.cons c0 rest
+      hashPart =
+        Data.Bifunctor.bimap
+          HashDecodingFailure
+          StorePathHashPart
+          digest
 
   either
     (fail . show)

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

@@ -35,25 +35,25 @@ data StorePathTrust
 data Metadata a = Metadata
   { -- | The path to the derivation file that built this path, if any
     -- and known.
-    deriverPath :: !(Maybe a)
+    metadataDeriverPath :: !(Maybe a)
   , -- | The hash of the nar serialization of the path.
-    narHash :: !(DSum HashAlgo Digest)
+    metadataNarHash :: !(DSum HashAlgo Digest)
   , -- | The paths that this path directly references
-    references :: !(HashSet a)
+    metadataReferences :: !(HashSet a)
   , -- | When was this path registered valid in the store?
-    registrationTime :: !UTCTime
+    metadataRegistrationTime :: !UTCTime
   , -- | The size of the nar serialization of the path, in bytes.
-    narBytes :: !(Maybe Word64)
+    metadataNarBytes :: !(Maybe Word64)
   , -- | How much we trust this path. Nix-es ultimate
-    trust :: !StorePathTrust
+    metadataTrust :: !StorePathTrust
   , -- | A set of cryptographic attestations of this path's validity.
     --
     -- There is no guarantee from this type alone that these
     -- signatures are valid.
-    sigs :: !(Set NarSignature)
+    metadataSigs :: !(Set NarSignature)
   , -- | Whether and how this store path is content-addressable.
     --
     -- There is no guarantee from this type alone that this address
     -- is actually correct for this store path.
-    contentAddress :: !(Maybe ContentAddress)
+    metadataContentAddress :: !(Maybe ContentAddress)
   } deriving (Eq, Generic, Ord, Show)

hnix-store-core/tests/Fingerprint.hs

@@ -31,7 +31,11 @@ spec_fingerprint = do
 
     it "allows a successful signature verification" $ do
       let msg = Text.encodeUtf8 $ metadataFingerprint def exampleStorePath exampleMetadata
-          Signature sig' = head $ sig <$> filter (\(NarSignature publicKey _) -> publicKey == "cache.nixos.org-1") (Set.toList (sigs exampleMetadata))
+          Signature sig' =
+            head
+            $ sig
+            <$> filter (\(NarSignature publicKey _) -> publicKey == "cache.nixos.org-1")
+            (Set.toList (metadataSigs exampleMetadata))
       sig' `shouldSatisfy` Ed25519.verify pubkey msg
 
 exampleFingerprint :: Text
@@ -42,28 +46,28 @@ exampleStorePath = forceRight $ parsePath def "/nix/store/syd87l2rxw8cbsxmxl853h
 
 exampleMetadata :: Metadata StorePath
 exampleMetadata = Metadata
-  { deriverPath = Just $ forceRight $ parsePath def "/nix/store/5rwxzi7pal3qhpsyfc16gzkh939q1np6-curl-7.82.0.drv"
-  , narHash = forceRight $ mkNamedDigest "sha256" "1b4sb93wp679q4zx9k1ignby1yna3z7c4c2ri3wphylbc2dwsys0"
-  , references = HashSet.fromList $ forceRight . parsePath def <$> ["/nix/store/0jqd0rlxzra1rs38rdxl43yh6rxchgc6-curl-7.82.0","/nix/store/6w8g7njm4mck5dmjxws0z1xnrxvl81xa-glibc-2.34-115","/nix/store/j5jxw3iy7bbz4a57fh9g2xm2gxmyal8h-zlib-1.2.12","/nix/store/yxvjs9drzsphm9pcf42a4byzj1kb9m7k-openssl-1.1.1n"]
-  , registrationTime = UTCTime (fromOrdinalDate 0 0) 0
-  , narBytes = Just 196040
-  , trust = BuiltElsewhere
-  , sigs = Set.fromList $ forceRight . parseSignature <$> ["cache.nixos.org-1:TsTTb3WGTZKphvYdBHXwo6weVILmTytUjLB+vcX89fOjjRicCHmKA4RCPMVLkj6TMJ4GMX3HPVWRdD1hkeKZBQ==", "test1:519iiVLx/c4Rdt5DNt6Y2Jm6hcWE9+XY69ygiWSZCNGVcmOcyL64uVAJ3cV8vaTusIZdbTnYo9Y7vDNeTmmMBQ=="]
-  , contentAddress = Nothing
+  { metadataDeriverPath = Just $ forceRight $ parsePath def "/nix/store/5rwxzi7pal3qhpsyfc16gzkh939q1np6-curl-7.82.0.drv"
+  , metadataNarHash = forceRight $ mkNamedDigest "sha256" "1b4sb93wp679q4zx9k1ignby1yna3z7c4c2ri3wphylbc2dwsys0"
+  , metadataReferences = HashSet.fromList $ forceRight . parsePath def <$> ["/nix/store/0jqd0rlxzra1rs38rdxl43yh6rxchgc6-curl-7.82.0","/nix/store/6w8g7njm4mck5dmjxws0z1xnrxvl81xa-glibc-2.34-115","/nix/store/j5jxw3iy7bbz4a57fh9g2xm2gxmyal8h-zlib-1.2.12","/nix/store/yxvjs9drzsphm9pcf42a4byzj1kb9m7k-openssl-1.1.1n"]
+  , metadataRegistrationTime = UTCTime (fromOrdinalDate 0 0) 0
+  , metadataNarBytes = Just 196040
+  , metadataTrust = BuiltElsewhere
+  , metadataSigs = Set.fromList $ forceRight . parseNarSignature <$> ["cache.nixos.org-1:TsTTb3WGTZKphvYdBHXwo6weVILmTytUjLB+vcX89fOjjRicCHmKA4RCPMVLkj6TMJ4GMX3HPVWRdD1hkeKZBQ==", "test1:519iiVLx/c4Rdt5DNt6Y2Jm6hcWE9+XY69ygiWSZCNGVcmOcyL64uVAJ3cV8vaTusIZdbTnYo9Y7vDNeTmmMBQ=="]
+  , metadataContentAddress = Nothing
   }
 
 pubkey :: Ed25519.PublicKey
 pubkey = forceDecodeB64Pubkey "6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY="
-                                                                                                 
+
 forceDecodeB64Pubkey :: Text -> Ed25519.PublicKey
 forceDecodeB64Pubkey b64EncodedPubkey = let
   decoded = forceRight $ decodeWith Base64 b64EncodedPubkey
-  in case Ed25519.publicKey decoded of                                
+  in case Ed25519.publicKey decoded of
     CryptoFailed err -> (error . show) err
-    CryptoPassed x -> x        
+    CryptoPassed x -> x
 
 forceRight :: Either a b -> b
 forceRight = \case
   Right x -> x
-  _ -> error "fromRight failed"
+  _ -> error "forceRight failed"
 

hnix-store-core/tests/Signature.hs

@@ -54,24 +54,24 @@ pubkeyNixosOrg :: Crypto.PubKey.Ed25519.PublicKey
 pubkeyNixosOrg = forceDecodeB64Pubkey "6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY="
 
 shouldNotParse :: Text -> Expectation
-shouldNotParse encoded = case parseSignature encoded of
+shouldNotParse encoded = case parseNarSignature encoded of
   Left _ -> pure ()
   Right _ -> expectationFailure "should not have parsed"
 
 shouldParseName :: Text -> Text -> Expectation
-shouldParseName encoded name = case parseSignature encoded of
+shouldParseName encoded name = case parseNarSignature encoded of
   Left err -> expectationFailure err
   Right narSig -> shouldBe name (publicKey narSig)
 
 shouldVerify :: Text -> Crypto.PubKey.Ed25519.PublicKey -> BS.ByteString -> Expectation
-shouldVerify encoded pubkey msg = case parseSignature encoded of
+shouldVerify encoded pubkey msg = case parseNarSignature encoded of
   Left err -> expectationFailure err
   Right narSig -> let
     (Signature sig') = sig narSig
     in sig' `shouldSatisfy` Crypto.PubKey.Ed25519.verify pubkey msg
 
 shouldNotVerify :: Text -> Crypto.PubKey.Ed25519.PublicKey -> BS.ByteString -> Expectation
-shouldNotVerify encoded pubkey msg = case parseSignature encoded of
+shouldNotVerify encoded pubkey msg = case parseNarSignature encoded of
   Left err -> expectationFailure err
   Right narSig -> let
     (Signature sig') = sig narSig

hnix-store-core/tests/StorePath.hs

@@ -0,0 +1,37 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module StorePath where
+
+import Test.Hspec (Spec, describe, it, shouldBe)
+import qualified Data.Text
+
+import System.Nix.StorePath (parseNameText, InvalidNameError(..))
+
+spec_storePath :: Spec
+spec_storePath = do
+  describe "parseNameText" $ do
+    it "parses valid name" $
+      parseNameText "name-dev.dotok"
+      `shouldBe`
+      pure "name-dev.dotok"
+
+    it "fails on empty" $
+      parseNameText mempty
+      `shouldBe`
+      Left EmptyName
+
+    it "fails on too long" $
+      parseNameText (Data.Text.replicate 256 "n")
+      `shouldBe`
+      Left (NameTooLong 256)
+
+    it "fails on leading dot" $
+      parseNameText ".ab"
+      `shouldBe`
+      Left LeadingDot
+
+    it "fails on invalid characters" $
+      parseNameText "ab!cd#@"
+      `shouldBe`
+      Left (InvalidCharacters "!#@")

hnix-store-json/CHANGELOG.md

@@ -0,0 +1,10 @@
+# Version [0.1.0.0](https://github.com/haskell-nix/hnix-store/compare/json-0.1.0.0...json-0.1.1.0) (2023-11-27)
+
+* Initial release
+
+---
+
+`hnix-store-json` uses [PVP Versioning][1].
+
+[1]: https://pvp.haskell.org
+

hnix-store-json/LICENSE

@@ -0,0 +1,201 @@
+                                 Apache License
+                           Version 2.0, January 2004
+                        http://www.apache.org/licenses/
+
+   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
+
+   1. Definitions.
+
+      "License" shall mean the terms and conditions for use, reproduction,
+      and distribution as defined by Sections 1 through 9 of this document.
+
+      "Licensor" shall mean the copyright owner or entity authorized by
+      the copyright owner that is granting the License.
+
+      "Legal Entity" shall mean the union of the acting entity and all
+      other entities that control, are controlled by, or are under common
+      control with that entity. For the purposes of this definition,
+      "control" means (i) the power, direct or indirect, to cause the
+      direction or management of such entity, whether by contract or
+      otherwise, or (ii) ownership of fifty percent (50%) or more of the
+      outstanding shares, or (iii) beneficial ownership of such entity.
+
+      "You" (or "Your") shall mean an individual or Legal Entity
+      exercising permissions granted by this License.
+
+      "Source" form shall mean the preferred form for making modifications,
+      including but not limited to software source code, documentation
+      source, and configuration files.
+
+      "Object" form shall mean any form resulting from mechanical
+      transformation or translation of a Source form, including but
+      not limited to compiled object code, generated documentation,
+      and conversions to other media types.
+
+      "Work" shall mean the work of authorship, whether in Source or
+      Object form, made available under the License, as indicated by a
+      copyright notice that is included in or attached to the work
+      (an example is provided in the Appendix below).
+
+      "Derivative Works" shall mean any work, whether in Source or Object
+      form, that is based on (or derived from) the Work and for which the
+      editorial revisions, annotations, elaborations, or other modifications
+      represent, as a whole, an original work of authorship. For the purposes
+      of this License, Derivative Works shall not include works that remain
+      separable from, or merely link (or bind by name) to the interfaces of,
+      the Work and Derivative Works thereof.
+
+      "Contribution" shall mean any work of authorship, including
+      the original version of the Work and any modifications or additions
+      to that Work or Derivative Works thereof, that is intentionally
+      submitted to Licensor for inclusion in the Work by the copyright owner
+      or by an individual or Legal Entity authorized to submit on behalf of
+      the copyright owner. For the purposes of this definition, "submitted"
+      means any form of electronic, verbal, or written communication sent
+      to the Licensor or its representatives, including but not limited to
+      communication on electronic mailing lists, source code control systems,
+      and issue tracking systems that are managed by, or on behalf of, the
+      Licensor for the purpose of discussing and improving the Work, but
+      excluding communication that is conspicuously marked or otherwise
+      designated in writing by the copyright owner as "Not a Contribution."
+
+      "Contributor" shall mean Licensor and any individual or Legal Entity
+      on behalf of whom a Contribution has been received by Licensor and
+      subsequently incorporated within the Work.
+
+   2. Grant of Copyright License. Subject to the terms and conditions of
+      this License, each Contributor hereby grants to You a perpetual,
+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+      copyright license to reproduce, prepare Derivative Works of,
+      publicly display, publicly perform, sublicense, and distribute the
+      Work and such Derivative Works in Source or Object form.
+
+   3. Grant of Patent License. Subject to the terms and conditions of
+      this License, each Contributor hereby grants to You a perpetual,
+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+      (except as stated in this section) patent license to make, have made,
+      use, offer to sell, sell, import, and otherwise transfer the Work,
+      where such license applies only to those patent claims licensable
+      by such Contributor that are necessarily infringed by their
+      Contribution(s) alone or by combination of their Contribution(s)
+      with the Work to which such Contribution(s) was submitted. If You
+      institute patent litigation against any entity (including a
+      cross-claim or counterclaim in a lawsuit) alleging that the Work
+      or a Contribution incorporated within the Work constitutes direct
+      or contributory patent infringement, then any patent licenses
+      granted to You under this License for that Work shall terminate
+      as of the date such litigation is filed.
+
+   4. Redistribution. You may reproduce and distribute copies of the
+      Work or Derivative Works thereof in any medium, with or without
+      modifications, and in Source or Object form, provided that You
+      meet the following conditions:
+
+      (a) You must give any other recipients of the Work or
+          Derivative Works a copy of this License; and
+
+      (b) You must cause any modified files to carry prominent notices
+          stating that You changed the files; and
+
+      (c) You must retain, in the Source form of any Derivative Works
+          that You distribute, all copyright, patent, trademark, and
+          attribution notices from the Source form of the Work,
+          excluding those notices that do not pertain to any part of
+          the Derivative Works; and
+
+      (d) If the Work includes a "NOTICE" text file as part of its
+          distribution, then any Derivative Works that You distribute must
+          include a readable copy of the attribution notices contained
+          within such NOTICE file, excluding those notices that do not
+          pertain to any part of the Derivative Works, in at least one
+          of the following places: within a NOTICE text file distributed
+          as part of the Derivative Works; within the Source form or
+          documentation, if provided along with the Derivative Works; or,
+          within a display generated by the Derivative Works, if and
+          wherever such third-party notices normally appear. The contents
+          of the NOTICE file are for informational purposes only and
+          do not modify the License. You may add Your own attribution
+          notices within Derivative Works that You distribute, alongside
+          or as an addendum to the NOTICE text from the Work, provided
+          that such additional attribution notices cannot be construed
+          as modifying the License.
+
+      You may add Your own copyright statement to Your modifications and
+      may provide additional or different license terms and conditions
+      for use, reproduction, or distribution of Your modifications, or
+      for any such Derivative Works as a whole, provided Your use,
+      reproduction, and distribution of the Work otherwise complies with
+      the conditions stated in this License.
+
+   5. Submission of Contributions. Unless You explicitly state otherwise,
+      any Contribution intentionally submitted for inclusion in the Work
+      by You to the Licensor shall be under the terms and conditions of
+      this License, without any additional terms or conditions.
+      Notwithstanding the above, nothing herein shall supersede or modify
+      the terms of any separate license agreement you may have executed
+      with Licensor regarding such Contributions.
+
+   6. Trademarks. This License does not grant permission to use the trade
+      names, trademarks, service marks, or product names of the Licensor,
+      except as required for reasonable and customary use in describing the
+      origin of the Work and reproducing the content of the NOTICE file.
+
+   7. Disclaimer of Warranty. Unless required by applicable law or
+      agreed to in writing, Licensor provides the Work (and each
+      Contributor provides its Contributions) on an "AS IS" BASIS,
+      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+      implied, including, without limitation, any warranties or conditions
+      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
+      PARTICULAR PURPOSE. You are solely responsible for determining the
+      appropriateness of using or redistributing the Work and assume any
+      risks associated with Your exercise of permissions under this License.
+
+   8. Limitation of Liability. In no event and under no legal theory,
+      whether in tort (including negligence), contract, or otherwise,
+      unless required by applicable law (such as deliberate and grossly
+      negligent acts) or agreed to in writing, shall any Contributor be
+      liable to You for damages, including any direct, indirect, special,
+      incidental, or consequential damages of any character arising as a
+      result of this License or out of the use or inability to use the
+      Work (including but not limited to damages for loss of goodwill,
+      work stoppage, computer failure or malfunction, or any and all
+      other commercial damages or losses), even if such Contributor
+      has been advised of the possibility of such damages.
+
+   9. Accepting Warranty or Additional Liability. While redistributing
+      the Work or Derivative Works thereof, You may choose to offer,
+      and charge a fee for, acceptance of support, warranty, indemnity,
+      or other liability obligations and/or rights consistent with this
+      License. However, in accepting such obligations, You may act only
+      on Your own behalf and on Your sole responsibility, not on behalf
+      of any other Contributor, and only if You agree to indemnify,
+      defend, and hold each Contributor harmless for any liability
+      incurred by, or claims asserted against, such Contributor by reason
+      of your accepting any such warranty or additional liability.
+
+   END OF TERMS AND CONDITIONS
+
+   APPENDIX: How to apply the Apache License to your work.
+
+      To apply the Apache License to your work, attach the following
+      boilerplate notice, with the fields enclosed by brackets "[]"
+      replaced with your own identifying information. (Don't include
+      the brackets!)  The text should be enclosed in the appropriate
+      comment syntax for the file format. We also recommend that a
+      file or class name and description of purpose be included on the
+      same "printed page" as the copyright notice for easier
+      identification within third-party archives.
+
+   Copyright 2018 Shea Levy.
+
+   Licensed under the Apache License, Version 2.0 (the "License");
+   you may not use this file except in compliance with the License.
+   You may obtain a copy of the License at
+
+       http://www.apache.org/licenses/LICENSE-2.0
+
+   Unless required by applicable law or agreed to in writing, software
+   distributed under the License is distributed on an "AS IS" BASIS,
+   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+   See the License for the specific language governing permissions and
+   limitations under the License.

hnix-store-json/README.md

@@ -0,0 +1,3 @@
+# hnix-store-json
+
+Aeson instances for core types.

hnix-store-json/hnix-store-json.cabal

@@ -0,0 +1,64 @@
+cabal-version:       2.2
+name:                hnix-store-json
+version:             0.1.0.0
+synopsis:            JSON serialization for core types
+description:
+  Aeson instances for core types
+homepage:            https://github.com/haskell-nix/hnix-store
+license:             Apache-2.0
+license-file:        LICENSE
+author:              Richard Marko
+maintainer:          srk@48.io
+copyright:           2023 Richard Marko
+category:            Nix
+build-type:          Simple
+extra-source-files:
+    CHANGELOG.md
+  , README.md
+
+common commons
+  ghc-options:  -Wall
+  default-extensions:
+      DataKinds
+    , DeriveAnyClass
+    , DeriveGeneric
+    , DerivingVia
+    , FlexibleInstances
+    , LambdaCase
+    , RecordWildCards
+    , StandaloneDeriving
+    , TypeApplications
+  default-language: Haskell2010
+
+library
+  import: commons
+  exposed-modules:
+      System.Nix.JSON
+  build-depends:
+      base >=4.12 && <5
+    , hnix-store-core >= 0.8
+    , aeson >= 2.0 && < 3.0
+    , attoparsec
+    , deriving-aeson >= 0.2
+    , text
+  hs-source-dirs:      src
+
+test-suite json
+  import: commons
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+    JSONSpec
+  hs-source-dirs:
+    tests
+  build-tool-depends:
+    hspec-discover:hspec-discover
+  build-depends:
+      base
+    , hnix-store-core
+    , hnix-store-json
+    , hnix-store-tests
+    , aeson
+    , containers
+    , data-default-class
+    , hspec

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

@@ -0,0 +1,176 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-|
+Description : JSON serialization
+
+This module is mostly a stub for now
+providing (From|To)JSON for Realisation type
+which is required for `-remote`.
+-}
+module System.Nix.JSON where
+
+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.Signature (Signature)
+import System.Nix.StorePath (StoreDir(..), StorePath, StorePathName, StorePathHashPart)
+
+import qualified Data.Aeson.KeyMap
+import qualified Data.Aeson.Types
+import qualified Data.Attoparsec.Text
+import qualified Data.Char
+import qualified Data.Text
+import qualified Data.Text.Lazy
+import qualified Data.Text.Lazy.Builder
+import qualified System.Nix.Base
+import qualified System.Nix.OutputName
+import qualified System.Nix.Realisation
+import qualified System.Nix.Signature
+import qualified System.Nix.StorePath
+
+instance ToJSON StorePathName where
+  toJSON = toJSON . System.Nix.StorePath.unStorePathName
+  toEncoding = toEncoding . System.Nix.StorePath.unStorePathName
+
+instance FromJSON StorePathName where
+  parseJSON =
+    withText "StorePathName"
+    ( either (fail . show) pure
+    . System.Nix.StorePath.mkStorePathName)
+
+instance ToJSON StorePathHashPart where
+  toJSON = toJSON . System.Nix.StorePath.storePathHashPartToText
+  toEncoding = toEncoding . System.Nix.StorePath.storePathHashPartToText
+
+instance FromJSON StorePathHashPart where
+  parseJSON =
+    withText "StorePathHashPart"
+    ( either
+        (fail . show)
+        (pure . System.Nix.StorePath.unsafeMakeStorePathHashPart)
+    . System.Nix.Base.decodeWith NixBase32
+    )
+
+instance ToJSON StorePath where
+  toJSON =
+    toJSON
+    -- TODO: hacky, we need to stop requiring StoreDir for
+    -- StorePath rendering and have a distinct
+    -- types for rooted|unrooted paths
+    . Data.Text.drop 1
+    . System.Nix.StorePath.storePathToText (StoreDir mempty)
+
+  toEncoding =
+    toEncoding
+    . Data.Text.drop 1
+    . System.Nix.StorePath.storePathToText (StoreDir mempty)
+
+instance FromJSON StorePath where
+  parseJSON =
+    withText "StorePath"
+    ( either
+        (fail . show)
+        pure
+    . System.Nix.StorePath.parsePathFromText (StoreDir mempty)
+    . Data.Text.cons '/'
+    )
+
+instance ToJSON (DerivationOutput OutputName) where
+  toJSON =
+    toJSON
+    . Data.Text.Lazy.toStrict
+    . Data.Text.Lazy.Builder.toLazyText
+    . System.Nix.Realisation.derivationOutputBuilder
+        System.Nix.OutputName.unOutputName
+
+  toEncoding =
+    toEncoding
+    . Data.Text.Lazy.toStrict
+    . Data.Text.Lazy.Builder.toLazyText
+    . System.Nix.Realisation.derivationOutputBuilder
+        System.Nix.OutputName.unOutputName
+
+instance ToJSONKey (DerivationOutput OutputName) where
+  toJSONKey =
+    Data.Aeson.Types.toJSONKeyText
+    $ Data.Text.Lazy.toStrict
+    . Data.Text.Lazy.Builder.toLazyText
+    . System.Nix.Realisation.derivationOutputBuilder
+        System.Nix.OutputName.unOutputName
+
+instance FromJSON (DerivationOutput OutputName) where
+  parseJSON =
+    withText "DerivationOutput OutputName"
+    ( either
+        (fail . show)
+        pure
+    . System.Nix.Realisation.derivationOutputParser
+        System.Nix.OutputName.mkOutputName
+    )
+
+instance FromJSONKey (DerivationOutput OutputName) where
+  fromJSONKey =
+    FromJSONKeyTextParser
+    ( either
+        (fail . show)
+        pure
+    . System.Nix.Realisation.derivationOutputParser
+        System.Nix.OutputName.mkOutputName
+    )
+
+instance ToJSON Signature where
+  toJSON = toJSON . System.Nix.Signature.signatureToText
+  toEncoding = toEncoding . System.Nix.Signature.signatureToText
+
+instance FromJSON Signature where
+  parseJSON =
+    withText "Signature"
+    ( either
+        (fail . show)
+        pure
+    . Data.Attoparsec.Text.parseOnly
+        System.Nix.Signature.signatureParser
+    )
+
+data LowerLeading
+instance StringModifier LowerLeading where
+  getStringModifier "" = ""
+  getStringModifier (c:xs) = Data.Char.toLower c : xs
+
+deriving
+  via CustomJSON
+    '[FieldLabelModifier
+       '[ StripPrefix "realisation"
+        , LowerLeading
+        , Rename "dependencies" "dependentRealisations"
+        ]
+     ] Realisation
+  instance ToJSON Realisation
+deriving
+  via CustomJSON
+    '[FieldLabelModifier
+       '[ StripPrefix "realisation"
+        , LowerLeading
+        , Rename "dependencies" "dependentRealisations"
+        ]
+     ] Realisation
+  instance FromJSON Realisation
+
+-- For a keyed version of Realisation
+-- we use (DerivationOutput OutputName, Realisation)
+-- instead of Realisation.id :: (DerivationOutput OutputName)
+-- field.
+instance {-# OVERLAPPING #-} ToJSON (DerivationOutput OutputName, Realisation) where
+  toJSON (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
+  parseJSON v@(Object o) = do
+    r <- parseJSON @Realisation v
+    drvOut <- o .: "id"
+    pure (drvOut, r)
+  parseJSON x = fail $ "Expected Object but got " ++ show x

hnix-store-json/tests/JSONSpec.hs

@@ -0,0 +1,101 @@
+{-# LANGUAGE OverloadedStrings #-}
+module JSONSpec where
+
+import Data.Aeson (ToJSON, FromJSON, decode, encode)
+import Data.Default.Class (Default(def))
+import Test.Hspec (Expectation, Spec, describe, it, shouldBe)
+import Test.Hspec.QuickCheck (prop)
+import Test.Hspec.Nix (forceRight, roundtrips)
+
+import System.Nix.Arbitrary ()
+import System.Nix.JSON ()
+import System.Nix.OutputName (OutputName)
+import System.Nix.Realisation (DerivationOutput(..), Realisation(..))
+import System.Nix.Signature (Signature)
+import System.Nix.StorePath (StorePath, StorePathName, StorePathHashPart)
+
+import qualified Data.Map
+import qualified Data.Set
+import qualified System.Nix.Hash
+import qualified System.Nix.OutputName
+import qualified System.Nix.Signature
+import qualified System.Nix.StorePath
+
+roundtripsJSON
+  :: ( Eq a
+     , Show a
+     , ToJSON a
+     , FromJSON a
+     )
+  => a
+  -> Expectation
+roundtripsJSON = roundtrips encode decode
+
+sampleDerivationOutput :: DerivationOutput OutputName
+sampleDerivationOutput = DerivationOutput
+  { derivationOutputHash =
+      forceRight
+      $ System.Nix.Hash.mkNamedDigest
+          "sha256"
+          "1b4sb93wp679q4zx9k1ignby1yna3z7c4c2ri3wphylbc2dwsys0"
+  , derivationOutputOutput =
+      forceRight
+      $ System.Nix.OutputName.mkOutputName "foo"
+  }
+
+sampleRealisation0 :: Realisation
+sampleRealisation0 = Realisation
+  { realisationOutPath =
+      forceRight
+      $ System.Nix.StorePath.parsePath
+          def
+          "/nix/store/cdips4lakfk1qbf1x68fq18wnn3r5r14-builder.sh"
+  , realisationSignatures = mempty
+  , realisationDependencies = mempty
+  }
+
+sampleRealisation1 :: Realisation
+sampleRealisation1 = Realisation
+  { realisationOutPath =
+      forceRight
+      $ System.Nix.StorePath.parsePath
+          def
+          "/nix/store/5rwxzi7pal3qhpsyfc16gzkh939q1np6-curl-7.82.0.drv"
+  , realisationSignatures =
+      Data.Set.fromList
+      $ forceRight
+      . System.Nix.Signature.parseSignature
+      <$> [ "fW3iEMfyx6IZzGNswD54BjclfkXiYzh0xRXddrXfJ1rp1l8p1xTi9/0g2EibbwLFb6p83cwIJv5KtTGksC54CQ=="
+          , "SMjnB3mPgXYjXacU+xN24BdzXlAgGAuFnYwPddU3bhjfHBeQus/OimdIPMgR/JMKFPHXORrk7pbjv68vecTEBA=="
+          ]
+  , realisationDependencies =
+      Data.Map.fromList
+      [ ( sampleDerivationOutput
+        , forceRight
+          $ System.Nix.StorePath.parsePathFromText
+              def
+              "/nix/store/9472ijanf79nlkb5n1yh57s7867p1930-testFixed"
+        )
+      ]
+  }
+
+spec :: Spec
+spec = do
+  describe "JSON" $ do
+    describe "roundtrips" $ do
+      prop "StorePathName" $ roundtripsJSON @StorePathName
+      prop "StorePathHashPart" $ roundtripsJSON @StorePathHashPart
+      prop "StorePath" $ roundtripsJSON @StorePath
+      prop "DerivationOutput OutputName" $ roundtripsJSON @(DerivationOutput OutputName)
+      prop "Signature" $ roundtripsJSON @Signature
+      prop "Realisation" $ roundtripsJSON @Realisation
+
+    describe "ground truth" $ do
+      it "sampleDerivationOutput matches preimage" $
+        encode sampleDerivationOutput `shouldBe` "\"sha256:1b4sb93wp679q4zx9k1ignby1yna3z7c4c2ri3wphylbc2dwsys0!foo\""
+
+      it "sampleRealisation0 matches preimage" $
+        encode sampleRealisation0 `shouldBe` "{\"outPath\":\"cdips4lakfk1qbf1x68fq18wnn3r5r14-builder.sh\",\"signatures\":[],\"dependentRealisations\":{}}"
+
+      it "sampleRealisation1 matches preimage" $
+        encode sampleRealisation1 `shouldBe` "{\"outPath\":\"5rwxzi7pal3qhpsyfc16gzkh939q1np6-curl-7.82.0.drv\",\"signatures\":[\"SMjnB3mPgXYjXacU+xN24BdzXlAgGAuFnYwPddU3bhjfHBeQus/OimdIPMgR/JMKFPHXORrk7pbjv68vecTEBA==\",\"fW3iEMfyx6IZzGNswD54BjclfkXiYzh0xRXddrXfJ1rp1l8p1xTi9/0g2EibbwLFb6p83cwIJv5KtTGksC54CQ==\"],\"dependentRealisations\":{\"sha256:1b4sb93wp679q4zx9k1ignby1yna3z7c4c2ri3wphylbc2dwsys0!foo\":\"9472ijanf79nlkb5n1yh57s7867p1930-testFixed\"}}"

hnix-store-json/tests/Spec.hs

@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

hnix-store-readonly/tests/ReadOnlySpec.hs

@@ -21,7 +21,7 @@ testDigest = Crypto.Hash.hash @ByteString "testDigest"
 testName :: StorePathName
 testName =
     either undefined id
-  $ System.Nix.StorePath.makeStorePathName "testFixed"
+  $ System.Nix.StorePath.mkStorePathName "testFixed"
 
 testPath :: StorePath
 testPath =

hnix-store-remote/README.md

@@ -16,6 +16,7 @@ via `nix-daemon`.
 
 import Control.Monad (void)
 import Control.Monad.IO.Class (liftIO)
+import System.Nix.StorePath (mkStorePathName)
 import System.Nix.Store.Remote
 
 main :: IO ()
@@ -25,6 +26,12 @@ main = do
     roots <- findRoots
     liftIO $ print roots
 
-    res <- addTextToStore "hnix-store" "test" mempty RepairMode_DontRepair
+    res <- case mkStorePathName "hnix-store" of
+      Left e -> error (show e)
+      Right name ->
+        addTextToStore
+         (StoreText name "Hello World!")
+         mempty
+         RepairMode_DontRepair
     liftIO $ print res
 ```

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

@@ -20,6 +20,7 @@ common commons
   ghc-options:  -Wall
   default-extensions:
       DataKinds
+    , DefaultSignatures
     , DeriveGeneric
     , DeriveDataTypeable
     , DeriveFunctor
@@ -34,6 +35,7 @@ common commons
     , ScopedTypeVariables
     , StandaloneDeriving
     , TypeApplications
+    , TypeOperators
     , TypeSynonymInstances
     , InstanceSigs
     , KindSignatures
@@ -75,35 +77,49 @@ library
     , Data.Serializer.Example
     , System.Nix.Store.Remote
     , System.Nix.Store.Remote.Arbitrary
+    , System.Nix.Store.Remote.Client
+    , System.Nix.Store.Remote.Client.Core
     , System.Nix.Store.Remote.Logger
     , System.Nix.Store.Remote.MonadStore
-    , System.Nix.Store.Remote.Protocol
-    , System.Nix.Store.Remote.Serialize
-    , System.Nix.Store.Remote.Serialize.Prim
     , System.Nix.Store.Remote.Serializer
+    , System.Nix.Store.Remote.Server
     , System.Nix.Store.Remote.Socket
     , System.Nix.Store.Remote.Types
     , System.Nix.Store.Remote.Types.Activity
     , System.Nix.Store.Remote.Types.CheckMode
     , System.Nix.Store.Remote.Types.GC
+    , System.Nix.Store.Remote.Types.Handshake
     , System.Nix.Store.Remote.Types.Logger
     , System.Nix.Store.Remote.Types.ProtoVersion
+    , System.Nix.Store.Remote.Types.Query
+    , System.Nix.Store.Remote.Types.Query.Missing
     , System.Nix.Store.Remote.Types.StoreConfig
+    , System.Nix.Store.Remote.Types.StoreRequest
+    , System.Nix.Store.Remote.Types.StoreReply
+    , System.Nix.Store.Remote.Types.StoreText
     , System.Nix.Store.Remote.Types.SubstituteMode
+    , System.Nix.Store.Remote.Types.TrustedFlag
     , System.Nix.Store.Remote.Types.Verbosity
+    , System.Nix.Store.Remote.Types.WorkerMagic
     , System.Nix.Store.Remote.Types.WorkerOp
 
   build-depends:
       base >=4.12 && <5
     , hnix-store-core >= 0.8 && <0.9
+    , hnix-store-json >= 0.1
     , hnix-store-nar >= 0.1
+    , hnix-store-tests >= 0.1
+    , aeson
     , attoparsec
     , bytestring
     , cereal
     , containers
+    , concurrency
     , crypton
     , data-default-class
-    , dependent-sum > 0.7 && < 1
+    , dependent-sum > 0.7
+    , dependent-sum-template >= 0.2.0.1 && < 0.3
+    , dlist >= 1.0
     , generic-arbitrary < 1.1
     , hashable
     , text
@@ -112,8 +128,8 @@ library
     , network
     , mtl
     , QuickCheck
-    , quickcheck-instances
     , unordered-containers
+    , unix >= 2.7
     , vector
   hs-source-dirs:      src
   ghc-options:         -Wall
@@ -138,6 +154,7 @@ executable remote-readme
     buildable: False
   build-depends:
       base >=4.12 && <5
+    , hnix-store-core
     , hnix-store-remote
   build-tool-depends:
       markdown-unlit:markdown-unlit
@@ -153,8 +170,8 @@ test-suite remote
   ghc-options:       -Wall -threaded -rtsopts "-with-rtsopts -N"
   other-modules:
       Data.SerializerSpec
+      EnumSpec
       NixSerializerSpec
-      SerializeSpec
   build-tool-depends:
     hspec-discover:hspec-discover
   build-depends:
@@ -162,16 +179,12 @@ test-suite remote
     , hnix-store-core
     , hnix-store-remote
     , hnix-store-tests
-    , cereal
+    , bytestring
     , crypton
-    , dependent-sum > 0.7 && < 1
     , some > 1.0.5 && < 2
-    , text
     , time
     , hspec
     , QuickCheck
-    , quickcheck-instances
-    , unordered-containers
 
 test-suite remote-io
   import: tests
@@ -180,20 +193,18 @@ test-suite remote-io
     buildable: False
 
   type:              exitcode-stdio-1.0
-  main-is:           Driver.hs
+  main-is:           Main.hs
   hs-source-dirs:    tests-io
   -- See https://github.com/redneb/hs-linux-namespaces/issues/3
   ghc-options:       -rtsopts -fprof-auto "-with-rtsopts -V0"
   other-modules:
-      NixDaemon
-    , Spec
-  build-tool-depends:
-    tasty-discover:tasty-discover
+      NixDaemonSpec
   build-depends:
       base >=4.12 && <5
     , hnix-store-core
     , hnix-store-nar
     , hnix-store-remote
+    , hnix-store-tests
     , bytestring
     , containers
     , crypton
@@ -203,8 +214,7 @@ test-suite remote-io
     , hspec-expectations-lifted
     , linux-namespaces
     , process
-    , tasty
-    , tasty-hspec
+    , some
     , temporary
     , text
     , unix

hnix-store-remote/src/Data/Serializer.hs

@@ -151,7 +151,8 @@ mapIsoSerializer
   :: Functor (t Get)
   => (a -> b) -- ^ Map over @getS@
   -> (b -> a) -- ^ Map over @putS@
-  -> (Serializer t a -> Serializer t b)
+  -> Serializer t a
+  -> Serializer t b
 mapIsoSerializer f g s = Serializer
   { getS = f <$> getS s
   , putS = putS s . g
@@ -163,7 +164,8 @@ mapPrismSerializer
   :: MonadError eGet (t Get)
   => (a -> Either eGet b) -- ^ Map over @getS@
   -> (b -> a)             -- ^ Map over @putS@
-  -> (Serializer t a -> Serializer t b)
+  -> Serializer t a
+  -> Serializer t b
 mapPrismSerializer f g s = Serializer
   { getS = either throwError pure . f =<< getS s
   , putS = putS s . g
@@ -193,7 +195,7 @@ tup a b = Serializer
 data GetSerializerError customGetError
   = SerializerError_GetFail String
   | SerializerError_Get customGetError
-  deriving (Eq, Show)
+  deriving (Eq, Ord, Show)
 
 -- | Helper for transforming nested Eithers
 -- into @GetSerializerError@ wrapper

hnix-store-remote/src/Data/Serializer/Example.hs

@@ -39,13 +39,19 @@ import Data.ByteString (ByteString)
 import Data.Int (Int8)
 import Data.GADT.Show (GShow(..), defaultGshowsPrec)
 import Data.Kind (Type)
-import Data.Type.Equality
-import Data.Serialize.Get (getInt8)
-import Data.Serialize.Put (putInt8)
+import Data.Type.Equality (TestEquality(..), (:~:)(Refl))
+import Data.Serialize.Get (Get, getInt8)
+import Data.Serialize.Put (Putter, PutM, putInt8)
 import Data.Serializer
+  ( Serializer(..)
+  , GetSerializerError
+  , runGetS
+  , runPutS
+  , transformGetError
+  , transformPutError
+  )
 import Data.Some (Some(..))
-import GHC.Generics
-import System.Nix.Store.Remote.Serialize.Prim (getBool, putBool, getEnum, putEnum)
+import GHC.Generics (Generic)
 
 import Test.QuickCheck (Arbitrary(..), oneof)
 
@@ -274,3 +280,40 @@ cmdSRest = Serializer
         else lift (putInt8 i)
       Some (Cmd_Bool b) -> putS opcode OpCode_Bool >> lift (putBool b)
   }
+
+-- Primitives helpers
+
+getInt :: Integral a => Get a
+getInt = fromIntegral <$> getInt8
+
+putInt :: Integral a => Putter a
+putInt = putInt8 . fromIntegral
+
+-- | Deserialize @Bool@ from integer
+getBool :: Get Bool
+getBool = (getInt :: Get Int8) >>= \case
+  0 -> pure False
+  1 -> pure True
+  x -> fail $ "illegal bool value " ++ show x
+
+-- | Serialize @Bool@ into integer
+putBool :: Putter Bool
+putBool True  = putInt (1 :: Int8)
+putBool False = putInt (0 :: Int8)
+
+-- | Utility toEnum version checking bounds using Bounded class
+toEnumCheckBounds :: Enum a => Int -> Either String a
+toEnumCheckBounds = \case
+  x | x < minBound -> Left $ "enum out of min bound " ++ show x
+  x | x > maxBound -> Left $ "enum out of max bound " ++ show x
+  x | otherwise -> Right $ toEnum x
+
+-- | Deserialize @Enum@ to integer
+getEnum :: Enum a => Get a
+getEnum =
+  toEnumCheckBounds <$> getInt
+  >>= either fail pure
+
+-- | Serialize @Enum@ to integer
+putEnum :: Enum a => Putter a
+putEnum = putInt . fromEnum

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

@@ -1,355 +1,86 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE LiberalTypeSynonyms #-}
-{-# LANGUAGE OverloadedStrings   #-}
-
 module System.Nix.Store.Remote
-  ( addToStore
-  , addTextToStore
-  , addSignatures
-  , addIndirectRoot
-  , addTempRoot
-  , buildPaths
-  , buildDerivation
-  , deleteSpecific
-  , ensurePath
-  , findRoots
-  , isValidPathUncached
-  , queryValidPaths
-  , queryAllValidPaths
-  , querySubstitutablePaths
-  , queryPathInfoUncached
-  , queryReferrers
-  , queryValidDerivers
-  , queryDerivationOutputs
-  , queryDerivationOutputNames
-  , queryPathFromHashPart
-  , queryMissing
-  , optimiseStore
-  , runStore
-  , syncWithGC
-  , verifyStore
-  , module System.Nix.Store.Types
+  (
+    module System.Nix.Store.Types
+  , module System.Nix.Store.Remote.Client
   , module System.Nix.Store.Remote.MonadStore
   , module System.Nix.Store.Remote.Types
+  -- * Compat
+  , MonadStore
+  -- * Runners
+  , runStore
+  , runStoreOpts
+  , runStoreOptsTCP
   ) where
 
-import Crypto.Hash (SHA256)
-import Data.ByteString (ByteString)
-import Data.Dependent.Sum (DSum((:=>)))
-import Data.HashSet (HashSet)
-import Data.Map (Map)
-import Data.Text (Text)
-import Data.Word (Word64)
-import System.Nix.Nar (NarSource)
-import System.Nix.Derivation (Derivation)
+import Data.Default.Class (Default(def))
+import Network.Socket (Family, SockAddr(SockAddrUnix))
 import System.Nix.Store.Types (FileIngestionMethod(..), RepairMode(..))
-import System.Nix.Build (BuildMode, BuildResult)
-import System.Nix.Hash (NamedAlgo(..), BaseEncoding(Base16), decodeDigestWith)
-import System.Nix.StorePath (StorePath, StorePathName, StorePathHashPart, InvalidPathError)
-import System.Nix.StorePath.Metadata  (Metadata(..), StorePathTrust(..))
-
-import qualified Data.Text
-import qualified Control.Monad
-import qualified Data.Attoparsec.Text
-import qualified Data.Text.Encoding
-import qualified Data.Map.Strict
-import qualified Data.Serialize.Put
-import qualified Data.Set
-
-import qualified System.Nix.ContentAddress
-import qualified System.Nix.Hash
-import qualified System.Nix.Signature
-import qualified System.Nix.StorePath
-
-import System.Nix.Store.Remote.MonadStore
-import System.Nix.Store.Remote.Protocol
-import System.Nix.Store.Remote.Socket
+import System.Nix.StorePath (StoreDir)
+import System.Nix.Store.Remote.MonadStore (RemoteStoreT, getStoreDir, RemoteStoreError(RemoteStoreError_GetAddrInfoFailed))
+import System.Nix.Store.Remote.Client
 import System.Nix.Store.Remote.Types
 
-import Data.Serialize (get)
-import System.Nix.Store.Remote.Serialize
-import System.Nix.Store.Remote.Serialize.Prim
+import qualified Control.Exception
+import qualified Network.Socket
 
--- | Pack `Nar` and add it to the store.
-addToStore
-  :: forall a
-   . (NamedAlgo a)
-  => StorePathName        -- ^ Name part of the newly created `StorePath`
-  -> NarSource MonadStore -- ^ provide nar stream
-  -> FileIngestionMethod  -- ^ Add target directory recursively
-  -> RepairMode           -- ^ Only used by local store backend
-  -> MonadStore StorePath
-addToStore name source recursive repair = do
-  Control.Monad.when (repair == RepairMode_DoRepair)
-    $ error "repairing is not supported when building through the Nix daemon"
+-- * Compat
 
-  runOpArgsIO AddToStore $ \yield -> do
-    yield $ Data.Serialize.Put.runPut $ do
-      putText $ System.Nix.StorePath.unStorePathName name
-      putBool
-        $ not
-        $ System.Nix.Hash.algoName @a == "sha256"
-          && recursive == FileIngestionMethod_FileRecursive
-      putBool (recursive == FileIngestionMethod_FileRecursive)
-      putText $ System.Nix.Hash.algoName @a
-    source yield
-  sockGetPath
+type MonadStore = RemoteStoreT StoreConfig IO
 
--- | Add text to store.
---
--- Reference accepts repair but only uses it
--- to throw error in case of remote talking to nix-daemon.
-addTextToStore
-  :: Text              -- ^ Name of the text
-  -> Text              -- ^ Actual text to add
-  -> HashSet StorePath -- ^ Set of `StorePath`s that the added text references
-  -> RepairMode        -- ^ Repair mode, must be `RepairMode_DontRepair` for remote backend
-                       --   (only valid for local store)
-  -> MonadStore StorePath
-addTextToStore name text references' repair = do
-  Control.Monad.when (repair == RepairMode_DoRepair)
-    $ error "repairing is not supported when building through the Nix daemon"
+-- * Runners
 
-  storeDir <- getStoreDir
-  runOpArgs AddTextToStore $ do
-    putText name
-    putText text
-    putPaths storeDir references'
-  sockGetPath
+runStore :: MonadStore a -> Run IO a
+runStore = runStoreOpts defaultSockPath def
+  where
+    defaultSockPath :: String
+    defaultSockPath = "/nix/var/nix/daemon-socket/socket"
 
-addSignatures :: StorePath -> [ByteString] -> MonadStore ()
-addSignatures p signatures = do
-  storeDir <- getStoreDir
-  Control.Monad.void $ simpleOpArgs AddSignatures $ do
-    putPath storeDir p
-    putByteStrings signatures
+runStoreOpts
+  :: FilePath
+  -> StoreDir
+  -> MonadStore a
+  -> Run IO a
+runStoreOpts socketPath =
+  runStoreOpts'
+    Network.Socket.AF_UNIX
+    (SockAddrUnix socketPath)
 
-addIndirectRoot :: StorePath -> MonadStore ()
-addIndirectRoot pn = do
-  storeDir <- getStoreDir
-  Control.Monad.void $ simpleOpArgs AddIndirectRoot $ putPath storeDir pn
+runStoreOptsTCP
+  :: String
+  -> Int
+  -> StoreDir
+  -> MonadStore a
+  -> Run IO a
+runStoreOptsTCP host port sd code = do
+  Network.Socket.getAddrInfo
+    (Just Network.Socket.defaultHints)
+    (Just host)
+    (Just $ show port)
+    >>= \case
+      (sockAddr:_) ->
+        runStoreOpts'
+          (Network.Socket.addrFamily sockAddr)
+          (Network.Socket.addrAddress sockAddr)
+          sd
+          code
+      _ -> pure (Left RemoteStoreError_GetAddrInfoFailed, mempty)
 
--- | Add temporary garbage collector root.
---
--- This root is removed as soon as the client exits.
-addTempRoot :: StorePath -> MonadStore ()
-addTempRoot pn = do
-  storeDir <- getStoreDir
-  Control.Monad.void $ simpleOpArgs AddTempRoot $ putPath storeDir pn
-
--- | Build paths if they are an actual derivations.
---
--- If derivation output paths are already valid, do nothing.
-buildPaths :: HashSet StorePath -> BuildMode -> MonadStore ()
-buildPaths ps bm = do
-  storeDir <- getStoreDir
-  Control.Monad.void $ simpleOpArgs BuildPaths $ do
-    putPaths storeDir ps
-    putInt $ fromEnum bm
-
-buildDerivation
-  :: StorePath
-  -> Derivation StorePath Text
-  -> BuildMode
-  -> MonadStore BuildResult
-buildDerivation p drv buildMode = do
-  storeDir <- getStoreDir
-  runOpArgs BuildDerivation $ do
-    putPath storeDir p
-    putDerivation storeDir drv
-    putEnum buildMode
-    -- XXX: reason for this is unknown
-    -- but without it protocol just hangs waiting for
-    -- more data. Needs investigation.
-    -- Intentionally the only warning that should pop-up.
-    putInt (0 :: Int)
-
-  getSocketIncremental get
-
--- | Delete store paths
-deleteSpecific
- :: HashSet StorePath -- ^ Paths to delete
- -> MonadStore GCResult
-deleteSpecific paths = do
-  storeDir <- getStoreDir
-  runOpArgs CollectGarbage $ do
-    putEnum GCAction_DeleteSpecific
-    putPaths storeDir paths
-    putBool False -- ignoreLiveness
-    putInt (maxBound :: Word64) -- maxFreedBytes
-    putInt (0::Int)
-    putInt (0::Int)
-    putInt (0::Int)
-  getSocketIncremental $ do
-    gcResult_deletedPaths <- getPathsOrFail storeDir
-    gcResult_bytesFreed <- getInt
-    -- TODO: who knows
-    _ :: Int <- getInt
-    pure GCResult{..}
-
-ensurePath :: StorePath -> MonadStore ()
-ensurePath pn = do
-  storeDir <- getStoreDir
-  Control.Monad.void $ simpleOpArgs EnsurePath $ putPath storeDir pn
-
--- | Find garbage collector roots.
-findRoots :: MonadStore (Map ByteString StorePath)
-findRoots = do
-  runOp FindRoots
-  sd  <- getStoreDir
-  res <-
-    getSocketIncremental
-    $ getMany
-    $ (,)
-      <$> getByteString
-      <*> getPath sd
-
-  r <- catRights res
-  pure $ Data.Map.Strict.fromList r
- where
-  catRights :: [(a, Either InvalidPathError b)] -> MonadStore [(a, b)]
-  catRights = mapM ex
-
-  ex :: (a, Either InvalidPathError b) -> MonadStore (a, b)
-  ex (x , Right y) = pure (x, y)
-  ex (_x, Left e ) = error $ "Unable to decode root: " <> show e
-
-isValidPathUncached :: StorePath -> MonadStore Bool
-isValidPathUncached p = do
-  storeDir <- getStoreDir
-  simpleOpArgs IsValidPath $ putPath storeDir p
-
--- | Query valid paths from set, optionally try to use substitutes.
-queryValidPaths
-  :: HashSet StorePath   -- ^ Set of `StorePath`s to query
-  -> SubstituteMode      -- ^ Try substituting missing paths when `True`
-  -> MonadStore (HashSet StorePath)
-queryValidPaths ps substitute = do
-  storeDir <- getStoreDir
-  runOpArgs QueryValidPaths $ do
-    putPaths storeDir ps
-    putBool $ substitute == SubstituteMode_DoSubstitute
-  sockGetPaths
-
-queryAllValidPaths :: MonadStore (HashSet StorePath)
-queryAllValidPaths = do
-  runOp QueryAllValidPaths
-  sockGetPaths
-
-querySubstitutablePaths :: HashSet StorePath -> MonadStore (HashSet StorePath)
-querySubstitutablePaths ps = do
-  storeDir <- getStoreDir
-  runOpArgs QuerySubstitutablePaths $ putPaths storeDir ps
-  sockGetPaths
-
-queryPathInfoUncached :: StorePath -> MonadStore (Metadata StorePath)
-queryPathInfoUncached path = do
-  storeDir <- getStoreDir
-  runOpArgs QueryPathInfo $ do
-    putPath storeDir path
-
-  valid <- sockGetBool
-  Control.Monad.unless valid $ error "Path is not valid"
-
-  deriverPath <- sockGetPathMay
-
-  narHashText <- Data.Text.Encoding.decodeUtf8 <$> sockGetStr
-  let
-    narHash =
-      case
-        decodeDigestWith @SHA256 Base16 narHashText
-        of
-        Left  e -> error e
-        Right d -> System.Nix.Hash.HashAlgo_SHA256 :=> d
-
-  references       <- sockGetPaths
-  registrationTime <- sockGet getTime
-  narBytes         <- Just <$> sockGetInt
-  ultimate         <- sockGetBool
-
-  sigStrings       <- fmap Data.Text.Encoding.decodeUtf8 <$> sockGetStrings
-  caString         <- Data.Text.Encoding.decodeUtf8 <$> sockGetStr
-
-  let
-      sigs = case
-               Data.Set.fromList <$> mapM (Data.Attoparsec.Text.parseOnly System.Nix.Signature.signatureParser) sigStrings
-               of
-               Left e -> error e
-               Right x -> x
-
-      contentAddress =
-        if Data.Text.null caString then Nothing else
-        case
-          Data.Attoparsec.Text.parseOnly
-            System.Nix.ContentAddress.contentAddressParser
-            caString
-          of
-          Left  e -> error e
-          Right x -> Just x
-
-      trust = if ultimate then BuiltLocally else BuiltElsewhere
-
-  pure $ Metadata{..}
-
-queryReferrers :: StorePath -> MonadStore (HashSet StorePath)
-queryReferrers p = do
-  storeDir <- getStoreDir
-  runOpArgs QueryReferrers $ putPath storeDir p
-  sockGetPaths
-
-queryValidDerivers :: StorePath -> MonadStore (HashSet StorePath)
-queryValidDerivers p = do
-  storeDir <- getStoreDir
-  runOpArgs QueryValidDerivers $ putPath storeDir p
-  sockGetPaths
-
-queryDerivationOutputs :: StorePath -> MonadStore (HashSet StorePath)
-queryDerivationOutputs p = do
-  storeDir <- getStoreDir
-  runOpArgs QueryDerivationOutputs $ putPath storeDir p
-  sockGetPaths
-
-queryDerivationOutputNames :: StorePath -> MonadStore (HashSet StorePath)
-queryDerivationOutputNames p = do
-  storeDir <- getStoreDir
-  runOpArgs QueryDerivationOutputNames $ putPath storeDir p
-  sockGetPaths
-
-queryPathFromHashPart :: StorePathHashPart -> MonadStore StorePath
-queryPathFromHashPart storePathHash = do
-  runOpArgs QueryPathFromHashPart
-    $ putText
-    $ System.Nix.StorePath.storePathHashPartToText storePathHash
-  sockGetPath
-
-queryMissing
-  :: (HashSet StorePath)
-  -> MonadStore
-      ( HashSet StorePath -- Paths that will be built
-      , HashSet StorePath -- Paths that have substitutes
-      , HashSet StorePath -- Unknown paths
-      , Integer           -- Download size
-      , Integer           -- Nar size?
-      )
-queryMissing ps = do
-  storeDir <- getStoreDir
-  runOpArgs QueryMissing $ putPaths storeDir ps
-
-  willBuild      <- sockGetPaths
-  willSubstitute <- sockGetPaths
-  unknown        <- sockGetPaths
-  downloadSize'  <- sockGetInt
-  narSize'       <- sockGetInt
-  pure (willBuild, willSubstitute, unknown, downloadSize', narSize')
-
-optimiseStore :: MonadStore ()
-optimiseStore = Control.Monad.void $ simpleOp OptimiseStore
-
-syncWithGC :: MonadStore ()
-syncWithGC = Control.Monad.void $ simpleOp SyncWithGC
-
--- returns True on errors
-verifyStore :: CheckMode -> RepairMode -> MonadStore Bool
-verifyStore check repair = simpleOpArgs VerifyStore $ do
-  putBool $ check == CheckMode_DoCheck
-  putBool $ repair == RepairMode_DoRepair
+runStoreOpts'
+  :: Family
+  -> SockAddr
+  -> StoreDir
+  -> MonadStore a
+  -> Run IO a
+runStoreOpts' sockFamily sockAddr storeRootDir code =
+  Control.Exception.bracket
+    open
+    (Network.Socket.close . hasStoreSocket)
+    (flip runStoreSocket code)
+  where
+    open = do
+      soc <- Network.Socket.socket sockFamily Network.Socket.Stream 0
+      Network.Socket.connect soc sockAddr
+      pure PreStoreConfig
+          { preStoreConfig_socket = soc
+          , preStoreConfig_dir = storeRootDir
+          }

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

@@ -3,15 +3,29 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
 module System.Nix.Store.Remote.Arbitrary where
 
+import Data.Some (Some(Some))
+import System.Nix.Arbitrary ()
+import System.Nix.Store.Types (RepairMode(..))
 import System.Nix.Store.Remote.Types
 
-import Test.QuickCheck (Arbitrary(..))
+import Test.QuickCheck (Arbitrary(..), oneof, suchThat)
 import Test.QuickCheck.Arbitrary.Generic (GenericArbitrary(..))
-import Test.QuickCheck.Instances ()
+
+deriving via GenericArbitrary CheckMode
+  instance Arbitrary CheckMode
+
+deriving via GenericArbitrary SubstituteMode
+  instance Arbitrary SubstituteMode
+
+deriving via GenericArbitrary TestStoreConfig
+  instance Arbitrary TestStoreConfig
 
 deriving via GenericArbitrary ProtoVersion
   instance Arbitrary ProtoVersion
 
+deriving via GenericArbitrary StoreText
+  instance Arbitrary StoreText
+
 -- * Logger
 
 deriving via GenericArbitrary Activity
@@ -26,14 +40,26 @@ deriving via GenericArbitrary ActivityResult
 deriving via GenericArbitrary Field
   instance Arbitrary Field
 
-deriving via GenericArbitrary Trace
-  instance Arbitrary Trace
+instance Arbitrary Trace where
+  arbitrary = do
+    -- we encode 0 position as Nothing
+    tracePosition <- arbitrary `suchThat` (/= Just 0)
+    traceHint <- arbitrary
+
+    pure Trace{..}
 
 deriving via GenericArbitrary BasicError
   instance Arbitrary BasicError
 
-deriving via GenericArbitrary ErrorInfo
-  instance Arbitrary ErrorInfo
+instance Arbitrary ErrorInfo where
+  arbitrary = do
+    errorInfoLevel <- arbitrary
+    errorInfoMessage <- arbitrary
+    -- we encode 0 position as Nothing
+    errorInfoPosition <- arbitrary `suchThat` (/= Just 0)
+    errorInfoTraces <- arbitrary
+
+    pure ErrorInfo{..}
 
 deriving via GenericArbitrary LoggerOpCode
   instance Arbitrary LoggerOpCode
@@ -43,3 +69,65 @@ deriving via GenericArbitrary Logger
 
 deriving via GenericArbitrary Verbosity
   instance Arbitrary Verbosity
+
+-- * GC
+
+deriving via GenericArbitrary GCAction
+  instance Arbitrary GCAction
+
+deriving via GenericArbitrary GCOptions
+  instance Arbitrary GCOptions
+
+-- * Handshake
+
+deriving via GenericArbitrary WorkerMagic
+  instance Arbitrary WorkerMagic
+
+deriving via GenericArbitrary TrustedFlag
+  instance Arbitrary TrustedFlag
+
+-- * Worker protocol
+
+deriving via GenericArbitrary WorkerOp
+  instance Arbitrary WorkerOp
+
+-- ** Request
+
+instance Arbitrary (Some StoreRequest) where
+  arbitrary = oneof
+    [ Some <$> (AddToStore <$> arbitrary <*> arbitrary <*> arbitrary <*> pure RepairMode_DontRepair)
+    , Some <$> (AddTextToStore <$> arbitrary <*> arbitrary <*> pure RepairMode_DontRepair)
+    , Some <$> (AddSignatures <$> arbitrary <*> arbitrary)
+    , Some . AddIndirectRoot  <$> arbitrary
+    , Some . AddTempRoot <$> arbitrary
+    , Some <$> (BuildPaths <$> arbitrary <*> arbitrary)
+    , Some <$> (BuildDerivation <$> arbitrary <*> arbitrary <*> arbitrary)
+    , Some . CollectGarbage <$> arbitrary
+    , Some . EnsurePath <$> arbitrary
+    , pure $ Some FindRoots
+    , Some . IsValidPath <$> arbitrary
+    , Some <$> (QueryValidPaths <$> arbitrary <*> arbitrary)
+    , pure $ Some QueryAllValidPaths
+    , Some . QuerySubstitutablePaths <$> arbitrary
+    , Some . QueryPathInfo <$> arbitrary
+    , Some . QueryReferrers <$> arbitrary
+    , Some . QueryValidDerivers <$> arbitrary
+    , Some . QueryDerivationOutputs <$> arbitrary
+    , Some . QueryDerivationOutputNames <$> arbitrary
+    , Some . QueryPathFromHashPart <$> arbitrary
+    , Some . QueryMissing <$> arbitrary
+    , pure $ Some OptimiseStore
+    , pure $ Some SyncWithGC
+    , Some <$> (VerifyStore <$> arbitrary <*> arbitrary)
+    ]
+
+-- ** Reply
+
+deriving via GenericArbitrary GCResult
+  instance Arbitrary GCResult
+
+deriving via GenericArbitrary GCRoot
+  instance Arbitrary GCRoot
+
+deriving via GenericArbitrary Missing
+  instance Arbitrary Missing

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

@@ -0,0 +1,238 @@
+module System.Nix.Store.Remote.Client
+  ( addToStore
+  , addTextToStore
+  , addSignatures
+  , addTempRoot
+  , addIndirectRoot
+  , buildPaths
+  , buildDerivation
+  , collectGarbage
+  , ensurePath
+  , findRoots
+  , isValidPath
+  , queryValidPaths
+  , queryAllValidPaths
+  , querySubstitutablePaths
+  , queryPathInfo
+  , queryReferrers
+  , queryValidDerivers
+  , queryDerivationOutputs
+  , queryDerivationOutputNames
+  , queryPathFromHashPart
+  , queryMissing
+  , optimiseStore
+  , syncWithGC
+  , verifyStore
+  , module System.Nix.Store.Remote.Client.Core
+  ) where
+
+import Control.Monad (when)
+import Control.Monad.Except (throwError)
+import Data.HashSet (HashSet)
+import Data.Map (Map)
+import Data.Set (Set)
+import Data.Some (Some)
+import Data.Text (Text)
+
+import System.Nix.Build (BuildMode, BuildResult)
+import System.Nix.Derivation (Derivation)
+import System.Nix.DerivedPath (DerivedPath)
+import System.Nix.Hash (HashAlgo(..))
+import System.Nix.Nar (NarSource)
+import System.Nix.Signature (Signature)
+import System.Nix.StorePath (StorePath, StorePathHashPart, StorePathName)
+import System.Nix.StorePath.Metadata (Metadata)
+import System.Nix.Store.Remote.MonadStore
+import System.Nix.Store.Remote.Types.GC (GCOptions, GCResult, GCRoot)
+import System.Nix.Store.Remote.Types.CheckMode (CheckMode)
+import System.Nix.Store.Remote.Types.Query.Missing (Missing)
+import System.Nix.Store.Remote.Types.StoreRequest (StoreRequest(..))
+import System.Nix.Store.Remote.Types.StoreText (StoreText)
+import System.Nix.Store.Remote.Types.SubstituteMode (SubstituteMode)
+import System.Nix.Store.Remote.Client.Core
+import System.Nix.Store.Types (FileIngestionMethod(..), RepairMode(..))
+
+-- | Add `NarSource` to the store
+addToStore
+  :: MonadRemoteStore m
+  => StorePathName        -- ^ Name part of the newly created `StorePath`
+  -> NarSource IO         -- ^ Provide nar stream
+  -> FileIngestionMethod  -- ^ Add target directory recursively
+  -> Some HashAlgo        -- ^
+  -> RepairMode           -- ^ Only used by local store backend
+  -> m StorePath
+addToStore name source method hashAlgo repair = do
+  Control.Monad.when
+    (repair == RepairMode_DoRepair)
+    $ throwError RemoteStoreError_RapairNotSupportedByRemoteStore
+
+  setNarSource source
+  doReq (AddToStore name method hashAlgo repair)
+
+-- | Add @StoreText@ to the store
+-- Reference accepts repair but only uses it
+-- to throw error in case of remote talking to nix-daemon.
+addTextToStore
+  :: MonadRemoteStore m
+  => StoreText
+  -> HashSet StorePath -- ^ Set of `StorePath`s that the added text references
+  -> RepairMode        -- ^ Repair mode, must be `RepairMode_DontRepair` for remote backend
+                       --   (only valid for local store)
+  -> m StorePath
+addTextToStore stext references repair = do
+  Control.Monad.when
+    (repair == RepairMode_DoRepair)
+    $ throwError RemoteStoreError_RapairNotSupportedByRemoteStore
+
+  doReq (AddTextToStore stext references repair)
+
+-- | Add @Signature@s to a store path
+addSignatures
+  :: MonadRemoteStore m
+  => StorePath
+  -> Set Signature
+  -> m ()
+addSignatures p signatures = doReq (AddSignatures p signatures)
+
+-- | Add temporary garbage collector root.
+--
+-- This root is removed as soon as the client exits.
+addTempRoot
+  :: MonadRemoteStore m
+  => StorePath
+  -> m ()
+addTempRoot = doReq . AddTempRoot
+
+-- | Add indirect garbage collector root.
+addIndirectRoot
+  :: MonadRemoteStore m
+  => StorePath
+  -> m ()
+addIndirectRoot = doReq . AddIndirectRoot
+
+-- | Build a derivation available at @StorePath@
+buildDerivation
+  :: MonadRemoteStore m
+  => StorePath
+  -> Derivation StorePath Text
+  -> BuildMode
+  -> m BuildResult
+buildDerivation a b c = doReq (BuildDerivation a b c)
+
+-- | Build paths if they are an actual derivations.
+--
+-- If derivation output paths are already valid, do nothing.
+buildPaths
+  :: MonadRemoteStore m
+  => Set DerivedPath
+  -> BuildMode
+  -> m ()
+buildPaths a b = doReq (BuildPaths a b)
+
+collectGarbage
+  :: MonadRemoteStore m
+  => GCOptions
+  -> m GCResult
+collectGarbage = doReq . CollectGarbage
+
+ensurePath
+  :: MonadRemoteStore m
+  => StorePath
+  -> m ()
+ensurePath = doReq . EnsurePath
+
+-- | Find garbage collector roots.
+findRoots
+  :: MonadRemoteStore m
+  => m (Map GCRoot StorePath)
+findRoots = doReq FindRoots
+
+isValidPath
+  :: MonadRemoteStore m
+  => StorePath
+  -> m Bool
+isValidPath = doReq . IsValidPath
+
+-- | Query valid paths from a set,
+-- optionally try to use substitutes
+queryValidPaths
+  :: MonadRemoteStore m
+  => HashSet StorePath
+  -- ^ Set of @StorePath@s to query
+  -> SubstituteMode
+  -- ^ Try substituting missing paths when @SubstituteMode_DoSubstitute@
+  -> m (HashSet StorePath)
+queryValidPaths a b = doReq (QueryValidPaths a b)
+
+-- | Query all valid paths
+queryAllValidPaths
+  :: MonadRemoteStore m
+  => m (HashSet StorePath)
+queryAllValidPaths = doReq QueryAllValidPaths
+
+-- | Query a set of paths substituable from caches
+querySubstitutablePaths
+  :: MonadRemoteStore m
+  => HashSet StorePath
+  -> m (HashSet StorePath)
+querySubstitutablePaths = doReq . QuerySubstitutablePaths
+
+-- | Query path metadata
+queryPathInfo
+  :: MonadRemoteStore m
+  => StorePath
+  -> m (Maybe (Metadata StorePath))
+queryPathInfo = doReq . QueryPathInfo
+
+queryReferrers
+  :: MonadRemoteStore m
+  => StorePath
+  -> m (HashSet StorePath)
+queryReferrers = doReq . QueryReferrers
+
+queryValidDerivers
+  :: MonadRemoteStore m
+  => StorePath
+  -> m (HashSet StorePath)
+queryValidDerivers = doReq . QueryValidDerivers
+
+queryDerivationOutputs
+  :: MonadRemoteStore m
+  => StorePath
+  -> m (HashSet StorePath)
+queryDerivationOutputs = doReq . QueryDerivationOutputs
+
+queryDerivationOutputNames
+  :: MonadRemoteStore m
+  => StorePath
+  -> m (HashSet StorePathName)
+queryDerivationOutputNames = doReq . QueryDerivationOutputNames
+
+queryPathFromHashPart
+  :: MonadRemoteStore m
+  => StorePathHashPart
+  -> m StorePath
+queryPathFromHashPart = doReq . QueryPathFromHashPart
+
+queryMissing
+  :: MonadRemoteStore m
+  => Set DerivedPath
+  -> m Missing
+queryMissing = doReq . QueryMissing
+
+optimiseStore
+  :: MonadRemoteStore m
+  => m ()
+optimiseStore = doReq OptimiseStore
+
+syncWithGC
+  :: MonadRemoteStore m
+  => m ()
+syncWithGC = doReq SyncWithGC
+
+verifyStore
+  :: MonadRemoteStore m
+  => CheckMode
+  -> RepairMode
+  -> m Bool
+verifyStore check repair = doReq (VerifyStore check repair)

hnix-store-remote/src/System/Nix/Store/Remote/Client/Core.hs

@@ -0,0 +1,174 @@
+module System.Nix.Store.Remote.Client.Core
+  ( Run
+  , runStoreSocket
+  , doReq
+  ) where
+
+import Control.Monad (unless, when)
+import Control.Monad.Except (throwError)
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Data.DList (DList)
+import Data.Some (Some(Some))
+import System.Nix.Nar (NarSource)
+import System.Nix.Store.Remote.Logger (processOutput)
+import System.Nix.Store.Remote.MonadStore
+  ( MonadRemoteStore
+  , RemoteStoreError(..)
+  , RemoteStoreT
+  , runRemoteStoreT
+  , mapStoreConfig
+  , takeNarSource
+  , getStoreSocket
+  )
+import System.Nix.Store.Remote.Socket (sockPutS, sockGetS)
+import System.Nix.Store.Remote.Serializer
+  ( bool
+  , int
+  , mapErrorS
+  , protoVersion
+  , storeRequest
+  , text
+  , trustedFlag
+  , workerMagic
+  )
+import System.Nix.Store.Remote.Types.Handshake (ClientHandshakeInput(..), ClientHandshakeOutput(..))
+import System.Nix.Store.Remote.Types.Logger (Logger)
+import System.Nix.Store.Remote.Types.ProtoVersion (ProtoVersion(..), ourProtoVersion)
+import System.Nix.Store.Remote.Types.StoreConfig (PreStoreConfig, StoreConfig, preStoreConfigToStoreConfig)
+import System.Nix.Store.Remote.Types.StoreRequest (StoreRequest(..))
+import System.Nix.Store.Remote.Types.StoreReply (StoreReply(..))
+import System.Nix.Store.Remote.Types.WorkerMagic (WorkerMagic(..))
+
+import qualified Network.Socket.ByteString
+
+type Run m a = m (Either RemoteStoreError a, DList Logger)
+
+-- | Perform @StoreRequest@
+doReq
+  :: forall m a
+   . ( MonadIO m
+     , MonadRemoteStore m
+     , StoreReply a
+     , Show a
+     )
+  => StoreRequest a
+  -> m a
+doReq = \case
+  x -> do
+    sockPutS
+      (mapErrorS
+        RemoteStoreError_SerializerRequest
+          storeRequest
+      )
+      (Some x)
+
+    case x of
+      AddToStore {} -> do
+
+        ms <- takeNarSource
+        case ms of
+          Just (stream :: NarSource IO) -> do
+            soc <- getStoreSocket
+            liftIO
+              $ stream
+              $ Network.Socket.ByteString.sendAll soc
+          Nothing ->
+            throwError
+              RemoteStoreError_NoNarSourceProvided
+
+      _ -> pure ()
+
+    processOutput
+    sockGetS
+      (mapErrorS RemoteStoreError_SerializerReply
+        $ getReplyS @a
+      )
+
+runStoreSocket
+  :: ( Monad m
+     , MonadIO m
+     )
+  => PreStoreConfig
+  -> RemoteStoreT StoreConfig m a
+  -> Run m a
+runStoreSocket preStoreConfig code =
+  runRemoteStoreT preStoreConfig $ do
+    ClientHandshakeOutput{..}
+      <- greet
+          ClientHandshakeInput
+          { clientHandshakeInputOurVersion = ourProtoVersion
+          }
+
+    mapStoreConfig
+      (preStoreConfigToStoreConfig
+        clientHandshakeOutputLeastCommonVerison)
+      code
+
+  where
+    greet
+      :: MonadIO m
+      => ClientHandshakeInput
+      -> RemoteStoreT PreStoreConfig m ClientHandshakeOutput
+    greet ClientHandshakeInput{..} = do
+
+      sockPutS
+        (mapErrorS
+          RemoteStoreError_SerializerHandshake
+          workerMagic
+        )
+        WorkerMagic_One
+
+      magic <-
+        sockGetS
+        $ mapErrorS
+            RemoteStoreError_SerializerHandshake
+            workerMagic
+
+      unless
+        (magic == WorkerMagic_Two)
+        $ throwError RemoteStoreError_WorkerMagic2Mismatch
+
+      daemonVersion <- sockGetS protoVersion
+
+      when (daemonVersion < ProtoVersion 1 10)
+        $ throwError RemoteStoreError_ClientVersionTooOld
+
+      sockPutS protoVersion clientHandshakeInputOurVersion
+
+      let leastCommonVersion = min daemonVersion ourProtoVersion
+
+      when (leastCommonVersion >= ProtoVersion 1 14)
+        $ sockPutS int (0 :: Int) -- affinity, obsolete
+
+      when (leastCommonVersion >= ProtoVersion 1 11) $ do
+        sockPutS
+          (mapErrorS RemoteStoreError_SerializerPut bool)
+          False -- reserveSpace, obsolete
+
+      daemonNixVersion <- if leastCommonVersion >= ProtoVersion 1 33
+        then do
+          -- If we were buffering I/O, we would flush the output here.
+          txtVer <-
+            sockGetS
+              $ mapErrorS
+                  RemoteStoreError_SerializerGet
+                  text
+          pure $ Just txtVer
+        else pure Nothing
+
+      remoteTrustsUs <- if leastCommonVersion >= ProtoVersion 1 35
+        then do
+          sockGetS
+            $ mapErrorS RemoteStoreError_SerializerHandshake trustedFlag
+        else pure Nothing
+
+      mapStoreConfig
+        (preStoreConfigToStoreConfig leastCommonVersion)
+        processOutput
+
+      pure ClientHandshakeOutput
+        { clientHandshakeOutputNixVersion = daemonNixVersion
+        , clientHandshakeOutputTrust = remoteTrustsUs
+        , clientHandshakeOutputLeastCommonVerison = leastCommonVersion
+        , clientHandshakeOutputServerVersion = daemonVersion
+        }

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

@@ -3,23 +3,25 @@ module System.Nix.Store.Remote.Logger
   ) where
 
 import Control.Monad.Except (throwError)
+import Control.Monad.IO.Class (liftIO)
 import Data.ByteString (ByteString)
 import Data.Serialize (Result(..))
-import System.Nix.Store.Remote.Serialize.Prim (putByteString)
 import System.Nix.Store.Remote.Serializer (LoggerSError, logger, runSerialT)
-import System.Nix.Store.Remote.Socket (sockGet8, sockPut)
-import System.Nix.Store.Remote.MonadStore (MonadStore, clearData)
-import System.Nix.Store.Remote.Types (Logger(..), ProtoVersion, hasProtoVersion)
+import System.Nix.Store.Remote.Socket (sockGet8)
+import System.Nix.Store.Remote.MonadStore (MonadRemoteStore, RemoteStoreError(..), appendLog, getDataSource, getDataSink, getStoreSocket, getProtoVersion)
+import System.Nix.Store.Remote.Types.Logger (Logger(..))
+import System.Nix.Store.Remote.Types.ProtoVersion (ProtoVersion)
 
 import qualified Control.Monad
-import qualified Control.Monad.Reader
-import qualified Control.Monad.State.Strict
 import qualified Data.Serialize.Get
 import qualified Data.Serializer
+import qualified Network.Socket.ByteString
 
-processOutput :: MonadStore [Logger]
+processOutput
+  :: MonadRemoteStore m
+  => m ()
 processOutput = do
- protoVersion <- Control.Monad.Reader.asks hasProtoVersion
+ protoVersion <- getProtoVersion
  sockGet8 >>= go . (decoder protoVersion)
  where
   decoder
@@ -30,38 +32,69 @@ processOutput = do
     Data.Serialize.Get.runGetPartial
       (runSerialT protoVersion $ Data.Serializer.getS logger)
 
-  go :: Result (Either LoggerSError Logger) -> MonadStore [Logger]
+  go
+    :: MonadRemoteStore m
+    => Result (Either LoggerSError Logger)
+    -> m ()
   go (Done ectrl leftover) = do
+    let loop = do
+          protoVersion <- getProtoVersion
+          sockGet8 >>= go . (decoder protoVersion)
 
     Control.Monad.unless (leftover == mempty) $
-      -- TODO: throwError
-      error $ "Leftovers detected: '" ++ show leftover ++ "'"
+      throwError
+      $ RemoteStoreError_LoggerLeftovers
+          (show ectrl)
+          leftover
 
-    protoVersion <- Control.Monad.Reader.asks hasProtoVersion
     case ectrl of
-      -- TODO: tie this with throwError and better error type
-      Left e -> error $ show e
+      Left e -> throwError $ RemoteStoreError_SerializerLogger e
       Right ctrl -> do
         case ctrl of
-          e@(Logger_Error _) -> pure [e]
-          Logger_Last -> pure [Logger_Last]
-          Logger_Read _n -> do
-            (mdata, _) <- Control.Monad.State.Strict.get
-            case mdata of
-              Nothing   -> throwError "No data to read provided"
-              Just part -> do
-                -- XXX: we should check/assert part size against n of (Read n)
-                sockPut $ putByteString part
-                clearData
+          -- These two terminate the logger loop
+          Logger_Error e -> throwError $ RemoteStoreError_LoggerError e
+          Logger_Last -> appendLog Logger_Last
 
-            sockGet8 >>= go . (decoder protoVersion)
+          -- Read data from source
+          Logger_Read size -> do
+            mSource <- getDataSource
+            case mSource of
+              Nothing   ->
+                throwError RemoteStoreError_NoDataSourceProvided
+              Just source -> do
+                mChunk <- liftIO $ source size
+                case mChunk of
+                  Nothing -> throwError RemoteStoreError_DataSourceExhausted
+                  Just chunk -> do
+                    sock <- getStoreSocket
+                    liftIO $ Network.Socket.ByteString.sendAll sock chunk
+
+            loop
+
+          -- Write data to sink
+          Logger_Write out -> do
+            mSink <- getDataSink
+            case mSink of
+              Nothing   ->
+                throwError RemoteStoreError_NoDataSinkProvided
+              Just sink -> do
+                liftIO $ sink out
+
+            loop
+
+          -- Following we just append and loop
+          -- but listed here explicitely for posterity
+          x@(Logger_Next _) -> appendLog x >> loop
+          x@(Logger_StartActivity {}) -> appendLog x >> loop
+          x@(Logger_StopActivity {}) -> appendLog x >> loop
+          x@(Logger_Result {}) -> appendLog x >> loop
 
-          -- we should probably handle Read here as well
-          x -> do
-            next <- sockGet8 >>= go . (decoder protoVersion)
-            pure $ x : next
   go (Partial k) = do
     chunk <- sockGet8
     go (k chunk)
 
-  go (Fail msg _leftover) = error msg
+  go (Fail msg leftover) =
+    throwError
+    $ RemoteStoreError_LoggerParserFail
+        msg
+        leftover

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

@@ -1,58 +1,308 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
 module System.Nix.Store.Remote.MonadStore
-  ( MonadStore
-  , mapStoreDir
-  , getStoreDir
-  , getLog
-  , flushLog
-  , gotError
-  , getErrors
-  , setData
-  , clearData
+  ( RemoteStoreState(..)
+  , RemoteStoreError(..)
+  , WorkerError(..)
+  , WorkerException(..)
+  , RemoteStoreT
+  , runRemoteStoreT
+  , mapStoreConfig
+  , MonadRemoteStoreR(..)
+  , MonadRemoteStore
+  , getProtoVersion
   ) where
 
-import Control.Monad.Except (ExceptT)
-import Control.Monad.Reader (ReaderT, asks)
-import Control.Monad.Reader.Class (MonadReader)
-import Control.Monad.State.Strict (StateT, gets, modify)
+import Control.Exception (SomeException)
+import Control.Monad.Except (MonadError)
+import Control.Monad.IO.Class (MonadIO)
+import Control.Monad.Reader (MonadReader, ask, asks)
+import Control.Monad.State.Strict (get, modify)
+import Control.Monad.Trans (MonadTrans, lift)
+import Control.Monad.Trans.State.Strict (StateT, runStateT, mapStateT)
+import Control.Monad.Trans.Except (ExceptT, runExceptT, mapExceptT)
+import Control.Monad.Trans.Reader (ReaderT, runReaderT, withReaderT)
 import Data.ByteString (ByteString)
-
-import Control.Monad.Trans.State.Strict (mapStateT)
-import Control.Monad.Trans.Except (mapExceptT)
-import Control.Monad.Trans.Reader (withReaderT)
-
+import Data.DList (DList)
+import Data.Word (Word64)
+import Network.Socket (Socket)
+import System.Nix.Nar (NarSource)
 import System.Nix.StorePath (HasStoreDir(..), StoreDir)
-import System.Nix.Store.Remote.Types.Logger (Logger, isError)
-import System.Nix.Store.Remote.Types.StoreConfig (StoreConfig(..))
+import System.Nix.Store.Remote.Serializer (HandshakeSError, LoggerSError, RequestSError, ReplySError, SError)
+import System.Nix.Store.Remote.Types.Logger (Logger, BasicError, ErrorInfo)
+import System.Nix.Store.Remote.Types.ProtoVersion (HasProtoVersion(..), ProtoVersion)
+import System.Nix.Store.Remote.Types.StoreConfig (HasStoreSocket(..), StoreConfig)
+
+import qualified Data.DList
+
+data RemoteStoreState = RemoteStoreState {
+    remoteStoreState_logs :: DList Logger
+  , remoteStoreState_gotError :: Bool
+  , remoteStoreState_mDataSource :: Maybe (Word64 -> IO (Maybe ByteString))
+  -- ^ Source for @Logger_Read@, this will be called repeatedly
+  -- as the daemon requests chunks of size @Word64@.
+  -- If the function returns Nothing and daemon tries to read more
+  -- data an error is thrown.
+  -- Used by @AddToStoreNar@ and @ImportPaths@ operations.
+  , remoteStoreState_mDataSink :: Maybe (ByteString -> IO ())
+  -- ^ Sink for @Logger_Write@, called repeatedly by the daemon
+  -- to dump us some data. Used by @ExportPath@ operation.
+  , remoteStoreState_mNarSource :: Maybe (NarSource IO)
+  }
+
+data RemoteStoreError
+  = RemoteStoreError_Fixme String
+  | RemoteStoreError_BuildFailed
+  | RemoteStoreError_ClientVersionTooOld
+  | RemoteStoreError_Disconnected
+  | RemoteStoreError_GetAddrInfoFailed
+  | RemoteStoreError_GenericIncrementalLeftovers String ByteString -- when there are bytes left over after genericIncremental parser is done, (Done x leftover), first param is show x
+  | RemoteStoreError_GenericIncrementalFail String ByteString -- when genericIncremental parser returns ((Fail msg leftover) :: Result)
+  | RemoteStoreError_SerializerGet SError
+  | RemoteStoreError_SerializerHandshake HandshakeSError
+  | RemoteStoreError_SerializerLogger LoggerSError
+  | RemoteStoreError_SerializerPut SError
+  | RemoteStoreError_SerializerRequest RequestSError
+  | RemoteStoreError_SerializerReply ReplySError
+  | RemoteStoreError_IOException SomeException
+  | RemoteStoreError_LoggerError (Either BasicError ErrorInfo)
+  | RemoteStoreError_LoggerLeftovers String ByteString -- when there are bytes left over after incremental logger parser is done, (Done x leftover), first param is show x
+  | RemoteStoreError_LoggerParserFail String ByteString -- when incremental parser returns ((Fail msg leftover) :: Result)
+  | RemoteStoreError_NoDataSourceProvided -- remoteStoreState_mDataSource is required but it is Nothing
+  | RemoteStoreError_DataSourceExhausted -- remoteStoreState_mDataSource returned Nothing but more data was requested
+  | RemoteStoreError_NoDataSinkProvided -- remoteStoreState_mDataSink is required but it is Nothing
+  | RemoteStoreError_NoNarSourceProvided
+  | RemoteStoreError_OperationFailed
+  | RemoteStoreError_ProtocolMismatch
+  | RemoteStoreError_RapairNotSupportedByRemoteStore -- "repairing is not supported when building through the Nix daemon"
+  | RemoteStoreError_WorkerMagic2Mismatch
+  | RemoteStoreError_WorkerError WorkerError
+  -- bad / redundant
+  | RemoteStoreError_WorkerException WorkerException
+  deriving Show
+
+-- | fatal error in worker interaction which should disconnect client.
+data WorkerException
+  = WorkerException_ClientVersionTooOld
+  | WorkerException_ProtocolMismatch
+  | WorkerException_Error WorkerError
+  -- ^ allowed error outside allowed worker state
+--  | WorkerException_DecodingError DecodingError
+--  | WorkerException_BuildFailed StorePath
+  deriving (Eq, Ord, Show)
+
+-- | Non-fatal (to server) errors in worker interaction
+data WorkerError
+  = WorkerError_SendClosed
+  | WorkerError_InvalidOperation Word64
+  | WorkerError_NotYetImplemented
+  | WorkerError_UnsupportedOperation
+  deriving (Eq, Ord, Show)
+
+newtype RemoteStoreT r m a = RemoteStoreT
+  { _unRemoteStoreT
+      :: ExceptT RemoteStoreError
+          (StateT RemoteStoreState
+            (ReaderT r m)) a
+  }
+  deriving
+    ( Functor
+    , Applicative
+    , Monad
+    , MonadReader r
+    --, MonadState StoreState -- Avoid making the internal state explicit
+    , MonadError RemoteStoreError
+    , MonadIO
+    )
+
+instance MonadTrans (RemoteStoreT r) where
+  lift = RemoteStoreT . lift . lift . lift
+
+-- | Runner for @RemoteStoreT@
+runRemoteStoreT
+  :: ( HasStoreDir r
+     , HasStoreSocket r
+     , Monad m
+     )
+  => r
+  -> RemoteStoreT r m a
+  -> m (Either RemoteStoreError a, DList Logger)
+runRemoteStoreT r =
+    fmap (\(res, RemoteStoreState{..}) -> (res, remoteStoreState_logs))
+  . (`runReaderT` r)
+  . (`runStateT` emptyState)
+  . runExceptT
+  . _unRemoteStoreT
+  where
+    emptyState = RemoteStoreState
+      { remoteStoreState_logs = mempty
+      , remoteStoreState_gotError = False
+      , remoteStoreState_mDataSource = Nothing
+      , remoteStoreState_mDataSink = Nothing
+      , remoteStoreState_mNarSource = Nothing
+      }
+
+mapStoreConfig
+  :: (rb -> ra)
+  -> (RemoteStoreT ra m a -> RemoteStoreT rb m a)
+mapStoreConfig f =
+  RemoteStoreT
+  . ( mapExceptT
+    . mapStateT
+    . withReaderT
+    ) f
+  . _unRemoteStoreT
+
+class ( MonadIO m
+      , MonadError RemoteStoreError m
+      , HasStoreSocket r
+      , HasStoreDir r
+      , MonadReader r m
+      )
+      => MonadRemoteStoreR r m where
+
+  appendLog :: Logger -> m ()
+  default appendLog
+    :: ( MonadTrans t
+       , MonadRemoteStoreR r m'
+       , m ~ t m'
+       )
+    => Logger
+    -> m ()
+  appendLog = lift . appendLog
+
+  getStoreDir :: m StoreDir
+  default getStoreDir
+    :: ( MonadTrans t
+       , MonadRemoteStoreR r m'
+       , m ~ t m'
+       )
+    => m StoreDir
+  getStoreDir = lift getStoreDir
+
+  getStoreSocket :: m Socket
+  default getStoreSocket
+    :: ( MonadTrans t
+       , MonadRemoteStoreR r m'
+       , m ~ t m'
+       )
+    => m Socket
+  getStoreSocket = lift getStoreSocket
+
+  setNarSource :: NarSource IO -> m ()
+  default setNarSource
+   :: ( MonadTrans t
+      , MonadRemoteStoreR r m'
+      , m ~ t m'
+      )
+   => NarSource IO
+   -> m ()
+  setNarSource x = lift (setNarSource x)
+
+  takeNarSource :: m (Maybe (NarSource IO))
+  default takeNarSource
+   :: ( MonadTrans t
+      , MonadRemoteStoreR r m'
+      , m ~ t m'
+      )
+   => m (Maybe (NarSource IO))
+  takeNarSource = lift takeNarSource
+
+  setDataSource :: (Word64 -> IO (Maybe ByteString)) -> m ()
+  default setDataSource
+   :: ( MonadTrans t
+      , MonadRemoteStoreR r m'
+      , m ~ t m'
+      )
+   => (Word64 -> IO (Maybe ByteString))
+   -> m ()
+  setDataSource x = lift (setDataSource x)
+
+  getDataSource :: m (Maybe (Word64 -> IO (Maybe ByteString)))
+  default getDataSource
+   :: ( MonadTrans t
+      , MonadRemoteStoreR r m'
+      , m ~ t m'
+      )
+   => m (Maybe (Word64 -> IO (Maybe ByteString)))
+  getDataSource = lift getDataSource
+
+  clearDataSource :: m ()
+  default clearDataSource
+    :: ( MonadTrans t
+       , MonadRemoteStoreR r m'
+       , m ~ t m'
+       )
+    => m ()
+  clearDataSource = lift clearDataSource
+
+  setDataSink :: (ByteString -> IO ()) -> m ()
+  default setDataSink
+   :: ( MonadTrans t
+      , MonadRemoteStoreR r m'
+      , m ~ t m'
+      )
+   => (ByteString -> IO ())
+   -> m ()
+  setDataSink x = lift (setDataSink x)
+
+  getDataSink :: m (Maybe (ByteString -> IO ()))
+  default getDataSink
+   :: ( MonadTrans t
+      , MonadRemoteStoreR r m'
+      , m ~ t m'
+      )
+   => m (Maybe (ByteString -> IO ()))
+  getDataSink = lift getDataSink
+
+  clearDataSink :: m ()
+  default clearDataSink
+    :: ( MonadTrans t
+       , MonadRemoteStoreR r m'
+       , m ~ t m'
+       )
+    => m ()
+  clearDataSink = lift clearDataSink
+
+instance MonadRemoteStoreR r m => MonadRemoteStoreR r (StateT s m)
+instance MonadRemoteStoreR r m => MonadRemoteStoreR r (ReaderT r m)
+instance MonadRemoteStoreR r m => MonadRemoteStoreR r (ExceptT RemoteStoreError m)
+
+type MonadRemoteStore m = MonadRemoteStoreR StoreConfig m
+
+instance ( MonadIO m
+         , HasStoreDir r
+         , HasStoreSocket r
+         )
+         => MonadRemoteStoreR r (RemoteStoreT r m) where
+
+  getStoreDir = hasStoreDir <$> RemoteStoreT ask
+  getStoreSocket = hasStoreSocket <$> RemoteStoreT ask
+
+  appendLog x =
+    RemoteStoreT
+    $ modify
+    $ \s -> s { remoteStoreState_logs = remoteStoreState_logs s `Data.DList.snoc` x }
+
+  setDataSource x = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mDataSource = pure x }
+  getDataSource = remoteStoreState_mDataSource <$> RemoteStoreT get
+  clearDataSource = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mDataSource = Nothing }
+
+  setDataSink x = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mDataSink = pure x }
+  getDataSink = remoteStoreState_mDataSink <$> RemoteStoreT get
+  clearDataSink = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mDataSink = Nothing }
+
+  setNarSource x = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mNarSource = pure x }
+  takeNarSource = RemoteStoreT $ do
+    x <- remoteStoreState_mNarSource <$> get
+    modify $ \s -> s { remoteStoreState_mNarSource = Nothing }
+    pure x
 
 -- | Ask for a @StoreDir@
-getStoreDir :: (HasStoreDir r, MonadReader r m) => m StoreDir
-getStoreDir = asks hasStoreDir
-
-type MonadStore a
-  = ExceptT
-      String
-      (StateT (Maybe ByteString, [Logger]) (ReaderT StoreConfig IO))
-      a
-
--- | For lying about the store dir in tests
-mapStoreDir :: (StoreDir -> StoreDir) -> (MonadStore a -> MonadStore a)
-mapStoreDir f = mapExceptT . mapStateT . withReaderT
-  $ \c@StoreConfig { storeConfig_dir = sd } -> c { storeConfig_dir = f sd }
-
-gotError :: MonadStore Bool
-gotError = gets (any isError . snd)
-
-getErrors :: MonadStore [Logger]
-getErrors = gets (filter isError . snd)
-
-getLog :: MonadStore [Logger]
-getLog = gets snd
-
-flushLog :: MonadStore ()
-flushLog = modify (\(a, _b) -> (a, []))
-
-setData :: ByteString -> MonadStore ()
-setData x = modify (\(_, b) -> (Just x, b))
-
-clearData :: MonadStore ()
-clearData = modify (\(_, b) -> (Nothing, b))
+getProtoVersion
+  :: ( MonadRemoteStoreR r m
+     , HasProtoVersion r
+     )
+  => m ProtoVersion
+getProtoVersion = asks hasProtoVersion

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

@@ -1,154 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module System.Nix.Store.Remote.Protocol
-  ( WorkerOp(..)
-  , simpleOp
-  , simpleOpArgs
-  , runOp
-  , runOpArgs
-  , runOpArgsIO
-  , runStore
-  , runStoreOpts
-  , runStoreOptsTCP
-  , runStoreOpts'
-  , ourProtoVersion
-  , GCAction(..)
-  ) where
-
-import qualified Control.Monad
-import Control.Exception              ( bracket )
-import Control.Monad.Except
-import Control.Monad.Reader (asks, runReaderT)
-import Control.Monad.State.Strict
-
-import Data.Default.Class (Default(def))
-import qualified Data.Bool
-import Data.Serialize.Get
-import Data.Serialize.Put
-import qualified Data.ByteString
-
-import Network.Socket (SockAddr(SockAddrUnix))
-import qualified Network.Socket as S
-import Network.Socket.ByteString (recv, sendAll)
-
-import System.Nix.StorePath (StoreDir(..))
-import System.Nix.Store.Remote.Serialize.Prim
-import System.Nix.Store.Remote.Logger
-import System.Nix.Store.Remote.MonadStore
-import System.Nix.Store.Remote.Socket
-import System.Nix.Store.Remote.Serializer (protoVersion)
-import System.Nix.Store.Remote.Types
-
-ourProtoVersion :: ProtoVersion
-ourProtoVersion = ProtoVersion
-  { protoVersion_major = 1
-  , protoVersion_minor = 21
-  }
-
-workerMagic1 :: Int
-workerMagic1 = 0x6e697863
-workerMagic2 :: Int
-workerMagic2 = 0x6478696f
-
-defaultSockPath :: String
-defaultSockPath = "/nix/var/nix/daemon-socket/socket"
-
-simpleOp :: WorkerOp -> MonadStore Bool
-simpleOp op = simpleOpArgs op $ pure ()
-
-simpleOpArgs :: WorkerOp -> Put -> MonadStore Bool
-simpleOpArgs op args = do
-  runOpArgs op args
-  err <- gotError
-  Data.Bool.bool
-    sockGetBool
-    (do
-      -- TODO: don't use show
-      getErrors >>= throwError . show
-    )
-    err
-
-runOp :: WorkerOp -> MonadStore ()
-runOp op = runOpArgs op $ pure ()
-
-runOpArgs :: WorkerOp -> Put -> MonadStore ()
-runOpArgs op args =
-  runOpArgsIO
-    op
-    (\encode -> encode $ runPut args)
-
-runOpArgsIO
-  :: WorkerOp
-  -> ((Data.ByteString.ByteString -> MonadStore ()) -> MonadStore ())
-  -> MonadStore ()
-runOpArgsIO op encoder = do
-
-  sockPut $ putEnum op
-
-  soc <- asks storeConfig_socket
-  encoder (liftIO . sendAll soc)
-
-  out <- processOutput
-  modify (\(a, b) -> (a, b <> out))
-  err <- gotError
-  Control.Monad.when err $ do
-    -- TODO: don't use show
-    getErrors >>= throwError . show
-
-runStore :: MonadStore a -> IO (Either String a, [Logger])
-runStore = runStoreOpts defaultSockPath def
-
-runStoreOpts
-  :: FilePath -> StoreDir -> MonadStore a -> IO (Either String a, [Logger])
-runStoreOpts path = runStoreOpts' S.AF_UNIX (SockAddrUnix path)
-
-runStoreOptsTCP
-  :: String -> Int -> StoreDir -> MonadStore a -> IO (Either String a, [Logger])
-runStoreOptsTCP host port storeRootDir code = do
-  S.getAddrInfo (Just S.defaultHints) (Just host) (Just $ show port) >>= \case
-    (sockAddr:_) -> runStoreOpts' (S.addrFamily sockAddr) (S.addrAddress sockAddr) storeRootDir code
-    _ -> pure (Left "Couldn't resolve host and port with getAddrInfo.", [])
-
-runStoreOpts'
-  :: S.Family -> S.SockAddr -> StoreDir -> MonadStore a -> IO (Either String a, [Logger])
-runStoreOpts' sockFamily sockAddr storeRootDir code =
-  bracket open (S.close . storeConfig_socket) run
-
- where
-  open = do
-    soc <- S.socket sockFamily S.Stream 0
-    S.connect soc sockAddr
-    pure StoreConfig
-        { storeConfig_dir = storeRootDir
-        , storeConfig_protoVersion = ourProtoVersion
-        , storeConfig_socket = soc
-        }
-
-  greet = do
-    sockPut $ putInt workerMagic1
-    soc      <- asks hasStoreSocket
-    vermagic <- liftIO $ recv soc 16
-    let
-      eres =
-        flip runGet vermagic
-          $ (,)
-            <$> (getInt :: Get Int)
-            <*> (getInt :: Get Int)
-
-    case eres of
-      Left err -> error $ "Error parsing vermagic " ++ err
-      Right (magic2, _daemonProtoVersion) -> do
-        Control.Monad.unless (magic2 == workerMagic2) $ error "Worker magic 2 mismatch"
-
-    pv <- asks hasProtoVersion
-    sockPutS @() protoVersion pv -- clientVersion
-    sockPut $ putInt (0 :: Int)   -- affinity
-    sockPut $ putInt (0 :: Int)   -- obsolete reserveSpace
-
-    processOutput
-
-  run sock =
-    fmap (\(res, (_data, logs)) -> (res, logs))
-      $ (`runReaderT` sock)
-      $ (`runStateT` (Nothing, []))
-      $ runExceptT (greet >> code)

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

@@ -1,208 +0,0 @@
-{-# OPTIONS_GHC -Wno-orphans #-}
-{-|
-Description : Serialize instances for complex types
-Maintainer  : srk <srk@48.io>
-|-}
-module System.Nix.Store.Remote.Serialize where
-
-import Data.Serialize (Serialize(..))
-import Data.Serialize.Get (Get)
-import Data.Serialize.Put (Putter)
-import Data.Text (Text)
-import Data.Word (Word8, Word32)
-
-import qualified Control.Monad
-import qualified Data.Bits
-import qualified Data.Bool
-import qualified Data.Map
-import qualified Data.Set
-import qualified Data.Text
-import qualified Data.Vector
-
-import System.Nix.Derivation (Derivation(..), DerivationOutput(..))
-import System.Nix.Build (BuildMode(..), BuildStatus(..), BuildResult(..))
-import System.Nix.StorePath (StoreDir, StorePath)
-import System.Nix.Store.Remote.Serialize.Prim
-import System.Nix.Store.Remote.Types
-
-instance Serialize Text where
-  get = getText
-  put = putText
-
--- * BuildResult
-
-instance Serialize BuildMode where
-  get = getEnum
-  put = putEnum
-
-instance Serialize BuildStatus where
-  get = getEnum
-  put = putEnum
-
-instance Serialize BuildResult where
-  get = do
-    status <- get
-    errorMessage <-
-      (\em -> Data.Bool.bool (Just em) Nothing (Data.Text.null em))
-      <$> get
-    timesBuilt <- getInt
-    isNonDeterministic <- getBool
-    startTime <- getTime
-    stopTime <- getTime
-    pure $ BuildResult{..}
-
-  put BuildResult{..} = do
-    put status
-    case errorMessage of
-      Just err -> putText err
-      Nothing -> putText mempty
-    putInt timesBuilt
-    putBool isNonDeterministic
-    putTime startTime
-    putTime stopTime
-
--- * GCAction
---
-instance Serialize GCAction where
-  get = getEnum
-  put = putEnum
-
--- * ProtoVersion
-
--- protoVersion_major & 0xFF00
--- protoVersion_minor & 0x00FF
-instance Serialize ProtoVersion where
-  get = do
-    v <- getInt @Word32
-    pure ProtoVersion
-      { protoVersion_major = fromIntegral $ Data.Bits.shiftR v 8
-      , protoVersion_minor = fromIntegral $ v Data.Bits..&. 0x00FF
-      }
-  put p =
-    putInt @Word32
-    $ ((Data.Bits.shiftL (fromIntegral $ protoVersion_major p :: Word32) 8)
-        Data.Bits..|. fromIntegral (protoVersion_minor p))
-
--- * Derivation
-
-getDerivation
-  :: StoreDir
-  -> Get (Derivation StorePath Text)
-getDerivation storeDir = do
-  outputs <-
-    Data.Map.fromList
-    <$> (getMany $ do
-          outputName <- get
-          path <- getPathOrFail storeDir
-          hashAlgo <- get
-          hash <- get
-          pure (outputName, DerivationOutput{..})
-        )
-
-  -- Our type is Derivation, but in Nix
-  -- the type sent over the wire is BasicDerivation
-  -- which omits inputDrvs
-  inputDrvs <- pure mempty
-  inputSrcs <-
-    Data.Set.fromList
-    <$> getMany (getPathOrFail storeDir)
-
-  platform <- get
-  builder <- get
-  args <-
-    Data.Vector.fromList
-    <$> getMany get
-
-  env <-
-    Data.Map.fromList
-    <$> getMany ((,) <$> get <*> get)
-  pure Derivation{..}
-
-putDerivation :: StoreDir -> Putter (Derivation StorePath Text)
-putDerivation storeDir Derivation{..} = do
-  flip putMany (Data.Map.toList outputs)
-    $ \(outputName, DerivationOutput{..}) -> do
-        putText outputName
-        putPath storeDir path
-        putText hashAlgo
-        putText hash
-
-  putMany (putPath storeDir) inputSrcs
-  putText platform
-  putText builder
-  putMany putText args
-
-  flip putMany (Data.Map.toList env)
-    $ \(a1, a2) -> putText a1 *> putText a2
-
--- * Logger
-
-instance Serialize Activity where
-  get =
-    toEnumCheckBounds . (+(-100)) <$> getInt
-    >>= either fail pure
-  put = putInt . (+100) . fromEnum
-
-instance Serialize ActivityID where
-  get = ActivityID <$> getInt
-  put (ActivityID aid) = putInt aid
-
-instance Serialize ActivityResult where
-  get =
-    toEnumCheckBounds . (+(-100)) <$> getInt
-    >>= either fail pure
-  put = putInt . (+100) . fromEnum
-
-instance Serialize Field where
-  get = (getInt :: Get Word8) >>= \case
-    0 -> Field_LogInt <$> getInt
-    1 -> Field_LogStr <$> getText
-    x -> fail $ "Unknown log field type: " <> show x
-  put (Field_LogInt x) = putInt (0 :: Word8) >> putInt x
-  put (Field_LogStr x) = putInt (1 :: Word8) >> putText x
-
-instance Serialize Trace where
-  get = do
-    tracePosition <- (\case 0 -> Nothing; x -> Just x) <$> getInt @Int
-    traceHint <- get
-    pure Trace{..}
-  put Trace{..} = do
-    maybe (putInt @Int 0) putInt $ tracePosition
-    put traceHint
-
-instance Serialize BasicError where
-  get = do
-    basicErrorMessage <- get
-    basicErrorExitStatus <- getInt
-    pure BasicError{..}
-  put BasicError{..} = do
-    put basicErrorMessage
-    putInt basicErrorExitStatus
-
-instance Serialize ErrorInfo where
-  get = do
-    etyp <- get @Text
-    Control.Monad.unless (etyp == Data.Text.pack "Error")
-      $ fail
-      $ "get ErrorInfo: received unknown error type" ++ show etyp
-    errorInfoLevel <- get
-    _name <- get @Text -- removed error name
-    errorInfoMessage <- get
-    errorInfoPosition <- (\case 0 -> Nothing; x -> Just x) <$> getInt @Int
-    errorInfoTraces <- getMany get
-    pure ErrorInfo{..}
-  put ErrorInfo{..} = do
-    put $ Data.Text.pack "Error"
-    put errorInfoLevel
-    put $ Data.Text.pack "Error" -- removed error name
-    put errorInfoMessage
-    maybe (putInt @Int 0) putInt $ errorInfoPosition
-    putMany put errorInfoTraces
-
-instance Serialize LoggerOpCode where
-  get = getInt @Int >>= either fail pure . intToLoggerOpCode
-  put = putInt @Int . loggerOpCodeToInt
-
-instance Serialize Verbosity where
-  get = getEnum
-  put = putEnum

hnix-store-remote/src/System/Nix/Store/Remote/Serialize/Prim.hs

@@ -1,215 +0,0 @@
-{-|
-Description : Nix-like serialization primitives
-Maintainer  : srk <srk@48.io>
-|-}
-module System.Nix.Store.Remote.Serialize.Prim where
-
-import Data.ByteString (ByteString)
-import Data.Fixed (Uni)
-import Data.HashSet (HashSet)
-import Data.Serialize.Get (Get)
-import Data.Serialize.Put (Putter)
-import Data.Text (Text)
-import Data.Time (NominalDiffTime, UTCTime)
-import Data.Word (Word8)
-import System.Nix.StorePath (StoreDir, StorePath, InvalidPathError)
-
-import qualified Control.Monad
-import qualified Data.Either
-import qualified Data.HashSet
-import qualified Data.Serialize.Get
-import qualified Data.Serialize.Put
-import qualified Data.ByteString
-import qualified Data.Text.Encoding
-import qualified Data.Time.Clock.POSIX
-import qualified System.Nix.StorePath
-
--- * Int
-
--- | Deserialize Nix like integer
-getInt :: Integral a => Get a
-getInt = fromIntegral <$> Data.Serialize.Get.getWord64le
-
--- | Serialize Nix like integer
-putInt :: Integral a => Putter a
-putInt = Data.Serialize.Put.putWord64le . fromIntegral
-
--- * Bool
-
--- | Deserialize @Bool@ from integer
-getBool :: Get Bool
-getBool = (getInt :: Get Word8) >>= \case
-  0 -> pure False
-  1 -> pure True
-  x -> fail $ "illegal bool value " ++ show x
-
--- | Serialize @Bool@ into integer
-putBool :: Putter Bool
-putBool True  = putInt (1 :: Int)
-putBool False = putInt (0 :: Int)
-
--- * Enum
-
--- | Utility toEnum version checking bounds using Bounded class
-toEnumCheckBounds :: Enum a => Int -> Either String a
-toEnumCheckBounds = \case
-  x | x < minBound -> Left $ "enum out of min bound " ++ show x
-  x | x > maxBound -> Left $ "enum out of max bound " ++ show x
-  x | otherwise -> Right $ toEnum x
-
--- | Deserialize @Enum@ to integer
-getEnum :: Enum a => Get a
-getEnum =
-  toEnumCheckBounds <$> getInt
-  >>= either fail pure
-
--- | Serialize @Enum@ to integer
-putEnum :: Enum a => Putter a
-putEnum = putInt . fromEnum
-
--- * UTCTime
-
--- | Deserialize @UTCTime@ from integer
--- Only 1 second precision.
-getTime :: Get UTCTime
-getTime =
-  Data.Time.Clock.POSIX.posixSecondsToUTCTime
-  . seconds
-  <$> getInt
-  where
-    -- fancy (*10^12), from Int to Uni to Pico(seconds)
-    seconds :: Int -> NominalDiffTime
-    seconds n = realToFrac (toEnum n :: Uni)
-
--- | Serialize @UTCTime@ to integer
--- Only 1 second precision.
-putTime :: Putter UTCTime
-putTime =
-  putInt
-  . seconds
-  . Data.Time.Clock.POSIX.utcTimeToPOSIXSeconds
-  where
-    -- fancy (`div`10^12), from Pico to Uni to Int
-    seconds :: NominalDiffTime -> Int
-    seconds = (fromEnum :: Uni -> Int) . realToFrac
-
--- * Combinators
-
--- | Deserialize a list
-getMany :: Get a -> Get [a]
-getMany parser = do
-  count <- getInt
-  Control.Monad.replicateM count parser
-
--- | Serialize a list
-putMany :: Foldable t => Putter a -> Putter (t a)
-putMany printer xs = do
-  putInt (length xs)
-  mapM_ printer xs
-
--- * ByteString
-
--- | Deserialize length prefixed string
--- into @ByteString@, checking for correct padding
-getByteString :: Get ByteString
-getByteString = do
-  len <- getInt
-  st  <- Data.Serialize.Get.getByteString len
-  Control.Monad.when (len `mod` 8 /= 0) $ do
-    pads <- unpad $ fromIntegral $ 8 - (len `mod` 8)
-    Control.Monad.unless
-      (all (== 0) pads)
-      $ fail $ "No zeroes" <> show (st, len, pads)
-  pure st
-  where unpad x = Control.Monad.replicateM x Data.Serialize.Get.getWord8
-
--- | Serialize @ByteString@ using length
--- prefixed string packing with padding to 8 bytes
-putByteString :: Putter ByteString
-putByteString x = do
-  putInt len
-  Data.Serialize.Put.putByteString x
-  Control.Monad.when
-    (len `mod` 8 /= 0)
-    $ pad $ 8 - (len `mod` 8)
- where
-  len :: Int
-  len = fromIntegral $ Data.ByteString.length x
-  pad count = Control.Monad.replicateM_ count (Data.Serialize.Put.putWord8 0)
-
--- | Deserialize a list of @ByteString@s
-getByteStrings :: Get [ByteString]
-getByteStrings = getMany getByteString
-
--- | Serialize a list of @ByteString@s
-putByteStrings :: Foldable t => Putter (t ByteString)
-putByteStrings = putMany putByteString
-
--- * Text
-
--- | Deserialize @Text@
-getText :: Get Text
-getText = Data.Text.Encoding.decodeUtf8 <$> getByteString
-
--- | Serialize @Text@
-putText :: Putter Text
-putText = putByteString . Data.Text.Encoding.encodeUtf8
-
--- | Deserialize a list of @Text@s
-getTexts :: Get [Text]
-getTexts = fmap Data.Text.Encoding.decodeUtf8 <$> getByteStrings
-
--- | Serialize a list of @Text@s
-putTexts :: (Functor f, Foldable f) => Putter (f Text)
-putTexts = putByteStrings . fmap Data.Text.Encoding.encodeUtf8
-
--- * StorePath
-
--- | Deserialize @StorePath@, checking
--- that @StoreDir@ matches expected value
-getPath :: StoreDir -> Get (Either InvalidPathError StorePath)
-getPath sd =
-  System.Nix.StorePath.parsePath sd <$> getByteString
-
--- | Deserialize @StorePath@, checking
--- that @StoreDir@ matches expected value
-getPathOrFail :: StoreDir -> Get StorePath
-getPathOrFail sd =
-  getPath sd
-  >>= either
-    (fail . show)
-    pure
-
--- | Serialize @StorePath@ with its associated @StoreDir@
-putPath :: StoreDir -> Putter StorePath
-putPath storeDir =
-  putByteString
-  . System.Nix.StorePath.storePathToRawFilePath storeDir
-
--- | Deserialize a @HashSet@ of @StorePath@s
-getPaths :: StoreDir -> Get (HashSet (Either InvalidPathError StorePath))
-getPaths sd =
-  Data.HashSet.fromList
-  . fmap (System.Nix.StorePath.parsePath sd)
-  <$> getByteStrings
-
--- | Deserialize @StorePath@, checking
--- that @StoreDir@ matches expected value
-getPathsOrFail :: StoreDir -> Get (HashSet StorePath)
-getPathsOrFail sd = do
-  eps <-
-    fmap (System.Nix.StorePath.parsePath sd)
-    <$> getByteStrings
-  Control.Monad.when (any Data.Either.isLeft eps)
-    $ fail
-    $ show
-    $ Data.Either.lefts eps
-  pure $ Data.HashSet.fromList $ Data.Either.rights eps
-
--- | Serialize a @HashSet@ of @StorePath@s
-putPaths :: StoreDir -> Putter (HashSet StorePath)
-putPaths storeDir =
-  putByteStrings
-  . Data.HashSet.toList
-  . Data.HashSet.map
-     (System.Nix.StorePath.storePathToRawFilePath storeDir)

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

@@ -0,0 +1,374 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE Rank2Types #-}
+module System.Nix.Store.Remote.Server where
+
+import Control.Concurrent.Classy.Async
+import Control.Monad (join, void, when)
+import Control.Monad.Conc.Class (MonadConc)
+import Control.Monad.Except (MonadError, throwError)
+import Control.Monad.Reader (MonadReader, asks)
+import Control.Monad.Trans (lift)
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Data.Foldable (traverse_)
+import Data.IORef (IORef, atomicModifyIORef, newIORef)
+import Data.Some (Some(Some))
+import Data.Text (Text)
+import Data.Void (Void, absurd)
+import Data.Word (Word32)
+import qualified Data.Text
+import qualified Data.Text.IO
+import Network.Socket (Socket, accept, close, listen, maxListenQueue)
+import System.Nix.StorePath (StoreDir)
+import System.Nix.Store.Remote.Serializer as RB
+import System.Nix.Store.Remote.Socket
+import System.Nix.Store.Remote.Types.StoreRequest as R
+import System.Nix.Store.Remote.Types.StoreConfig (HasStoreSocket(..), StoreConfig(..), PreStoreConfig(..), preStoreConfigToStoreConfig)
+import System.Nix.Store.Remote.Types.ProtoVersion (HasProtoVersion(..), ProtoVersion(..))
+import System.Nix.Store.Remote.Types.Logger (BasicError(..), ErrorInfo, Logger(..))
+
+import System.Nix.Store.Remote.MonadStore (WorkerError(..), WorkerException(..), RemoteStoreError(..), RemoteStoreT, runRemoteStoreT, mapStoreConfig)
+import System.Nix.Store.Remote.Types.Handshake (ServerHandshakeInput(..), ServerHandshakeOutput(..))
+import System.Nix.Store.Remote.Types.ProtoVersion (ourProtoVersion)
+import System.Nix.Store.Remote.Types.WorkerMagic (WorkerMagic(..))
+
+type WorkerHelper m = forall a. StoreRequest a -> m a
+
+-- | Run an emulated nix daemon on given socket address.
+-- The deamon will close when the continuation returns.
+runDaemonSocket
+  :: forall m a
+  . ( MonadIO m
+    , MonadConc m
+    , MonadError RemoteStoreError m
+    , MonadReader StoreConfig m
+    )
+  => StoreDir
+  -> WorkerHelper m
+  -> Socket
+  -> m a
+  -> m a
+runDaemonSocket sd workerHelper lsock k = do
+  liftIO $ listen lsock maxListenQueue
+
+  liftIO $ Data.Text.IO.putStrLn "listening"
+
+  let listener :: m Void
+      listener = do
+        (sock, _) <- liftIO $ accept lsock
+        liftIO $ Data.Text.IO.putStrLn "accepting"
+
+        let preStoreConfig = PreStoreConfig
+              { preStoreConfig_socket = sock
+              , preStoreConfig_dir = sd
+              }
+
+        -- TODO: this, but without the space leak
+        fmap fst $ concurrently listener $ processConnection workerHelper preStoreConfig
+
+  either absurd id <$> race listener k
+
+-- | "main loop" of the daemon for a single connection.
+--
+-- this function should take care to not throw errors from client connections.
+processConnection
+  :: ( MonadIO m
+     , MonadError RemoteStoreError m
+     , MonadReader StoreConfig m
+     )
+  => WorkerHelper m
+  -> PreStoreConfig
+  -> m ()
+processConnection workerHelper preStoreConfig = do
+  ~() <- void $ runRemoteStoreT preStoreConfig $ do
+
+    ServerHandshakeOutput{..}
+      <- greet
+          ServerHandshakeInput
+          { serverHandshakeInputNixVersion = "nixVersion (hnix-store-remote)"
+          , serverHandshakeInputOurVersion= ourProtoVersion
+          , serverHandshakeInputTrust = Nothing
+          }
+
+    mapStoreConfig
+      (preStoreConfigToStoreConfig
+        serverHandshakeOutputLeastCommonVersion)
+      $ do
+
+        tunnelLogger <- liftIO $ newTunnelLogger
+        -- Send startup error messages to the client.
+        startWork tunnelLogger
+
+        -- TODO: do we need auth at all? probably?
+        -- If we can't accept clientVersion, then throw an error *here* (not above).
+        --authHook(*store);
+        stopWork tunnelLogger
+
+        -- Process client requests.
+        let loop = do
+              someReq <-
+                sockGetS
+                  $ mapErrorS
+                      RemoteStoreError_SerializerRequest
+                      storeRequest
+
+              lift $ performOp' workerHelper tunnelLogger someReq
+              loop
+        loop
+
+  liftIO $ Data.Text.IO.putStrLn "daemon connection done"
+  liftIO $ close $ preStoreConfig_socket preStoreConfig
+
+  where
+    -- Exchange the greeting.
+    greet
+      :: MonadIO m
+      => ServerHandshakeInput
+      -> RemoteStoreT PreStoreConfig m ServerHandshakeOutput
+    greet ServerHandshakeInput{..} = do
+      magic <-
+        sockGetS
+        $ mapErrorS
+            RemoteStoreError_SerializerHandshake
+            workerMagic
+
+      liftIO $ print ("magic" :: Text, magic)
+      when (magic /= WorkerMagic_One)
+        $ throwError
+        $ RemoteStoreError_WorkerException
+            WorkerException_ProtocolMismatch
+
+      sockPutS
+        (mapErrorS
+          RemoteStoreError_SerializerHandshake
+          workerMagic
+        )
+        WorkerMagic_Two
+
+      sockPutS protoVersion serverHandshakeInputOurVersion
+
+      clientVersion <- sockGetS protoVersion
+
+      let leastCommonVersion = min clientVersion ourProtoVersion
+
+      liftIO $ print ("Versions client, min" :: Text, clientVersion, leastCommonVersion)
+
+      when (clientVersion < ProtoVersion 1 10)
+        $ throwError
+        $ RemoteStoreError_WorkerException
+            WorkerException_ClientVersionTooOld
+
+      when (clientVersion >= ProtoVersion 1 14) $ do
+        x :: Word32 <- sockGetS int
+        when (x /= 0) $ do
+          -- Obsolete CPU affinity.
+          _ :: Word32 <- sockGetS int
+          pure ()
+
+      when (clientVersion >= ProtoVersion 1 11) $ do
+        _ :: Word32 <- sockGetS int -- obsolete reserveSpace
+        pure ()
+
+      when (clientVersion >= ProtoVersion 1 33) $ do
+        sockPutS
+          (mapErrorS
+             RemoteStoreError_SerializerPut
+             text
+          )
+          serverHandshakeInputNixVersion
+
+      when (clientVersion >= ProtoVersion 1 35) $ do
+        sockPutS
+          (mapErrorS
+             RemoteStoreError_SerializerHandshake
+             trustedFlag
+          )
+          serverHandshakeInputTrust
+
+      pure ServerHandshakeOutput
+        { serverHandshakeOutputLeastCommonVersion = leastCommonVersion
+        , serverHandshakeOutputClientVersion = clientVersion
+        }
+
+simpleOp
+  :: ( MonadIO m
+     , HasStoreSocket r
+     , HasProtoVersion r
+     , MonadError RemoteStoreError m
+     , MonadReader r m
+     )
+  => (StoreRequest () -> m ())
+  -> TunnelLogger r
+  -> m (StoreRequest ())
+  -> m ()
+simpleOp workerHelper tunnelLogger m = do
+  req <- m
+  bracketLogger tunnelLogger $ workerHelper req
+  sockPutS
+    (mapErrorS
+       RemoteStoreError_SerializerPut
+       bool
+    )
+    True
+
+simpleOpRet
+  :: ( MonadIO m
+     , HasStoreSocket r
+     , HasProtoVersion r
+     , MonadError RemoteStoreError m
+     , MonadReader r m
+     )
+  => (StoreRequest a -> m a)
+  -> TunnelLogger r
+  -> NixSerializer r SError a
+  -> m (StoreRequest a)
+  -> m ()
+simpleOpRet workerHelper tunnelLogger s m = do
+  req <- m
+  resp <- bracketLogger tunnelLogger $ workerHelper req
+  sockPutS
+    (mapErrorS
+       RemoteStoreError_SerializerPut
+       s
+    )
+    resp
+
+bracketLogger
+  :: ( MonadIO m
+     , HasStoreSocket r
+     , HasProtoVersion r
+     , MonadReader r m
+     , MonadError RemoteStoreError m
+     )
+  => TunnelLogger r
+  -> m a
+  -> m a
+bracketLogger tunnelLogger m = do
+  startWork tunnelLogger
+  a <- m
+  stopWork tunnelLogger
+  pure a
+
+{-# WARNING unimplemented "not yet implemented" #-}
+unimplemented :: WorkerException
+unimplemented = WorkerException_Error $ WorkerError_NotYetImplemented
+
+performOp'
+  :: forall m
+   . ( MonadIO m
+     , MonadError RemoteStoreError m
+     , MonadReader StoreConfig m
+     )
+  => WorkerHelper m
+  -> TunnelLogger StoreConfig
+  -> Some StoreRequest
+  -> m ()
+performOp' workerHelper tunnelLogger op = do
+  let _simpleOp' = simpleOp workerHelper tunnelLogger
+  let simpleOpRet'
+        :: NixSerializer StoreConfig SError a
+        -> m (StoreRequest a)
+        -> m ()
+      simpleOpRet' = simpleOpRet workerHelper tunnelLogger
+
+  case op of
+    Some (IsValidPath path) -> simpleOpRet' bool $ do
+      pure $ R.IsValidPath path
+
+    _ -> undefined
+
+---
+
+data TunnelLogger r = TunnelLogger
+  { _tunnelLogger_state :: IORef (TunnelLoggerState r)
+  }
+
+data TunnelLoggerState r = TunnelLoggerState
+  { _tunnelLoggerState_canSendStderr :: Bool
+  , _tunnelLoggerState_pendingMsgs :: [Logger]
+  }
+
+newTunnelLogger :: IO (TunnelLogger r)
+newTunnelLogger = TunnelLogger <$> newIORef (TunnelLoggerState False [])
+
+enqueueMsg
+  :: ( MonadIO m
+     , MonadReader r m
+     , MonadError LoggerSError m
+     , HasProtoVersion r
+     , HasStoreSocket r
+     )
+  => TunnelLogger r
+  -> Logger
+  -> m ()
+enqueueMsg x l = updateLogger x $ \st@(TunnelLoggerState c p) -> case c of
+  True -> (st, sockPutS logger l)
+  False -> (TunnelLoggerState c (l:p), pure ())
+
+log
+  :: ( MonadIO m
+     , MonadReader r m
+     , HasStoreSocket r
+     , MonadError LoggerSError m
+     , HasProtoVersion r
+     )
+  => TunnelLogger r
+  -> Text
+  -> m ()
+log l s = enqueueMsg l (Logger_Next s)
+
+startWork
+  :: (MonadIO m, MonadReader r m, HasStoreSocket r
+
+     , MonadError RemoteStoreError m
+     , HasProtoVersion r
+  )
+  => TunnelLogger r
+  -> m ()
+startWork x = updateLogger x $ \(TunnelLoggerState _ p) -> (,)
+  (TunnelLoggerState True []) $
+  (traverse_ (sockPutS logger') $ reverse p)
+  where logger' = mapErrorS RemoteStoreError_SerializerLogger logger
+
+stopWork
+  :: (MonadIO m, MonadReader r m, HasStoreSocket r
+
+     , MonadError RemoteStoreError m
+     , HasProtoVersion r
+  )
+  => TunnelLogger r
+  -> m ()
+stopWork x = updateLogger x $ \_ -> (,)
+  (TunnelLoggerState False [])
+  (sockPutS (mapErrorS RemoteStoreError_SerializerLogger logger) Logger_Last)
+
+-- | Stop sending logging and report an error.
+--
+-- Returns true if the the session was in a state that allowed the error to be
+-- sent.
+--
+-- Unlike 'stopWork', this function may be called at any time to (try) to end a
+-- session with an error.
+stopWorkOnError
+  :: (MonadIO m, MonadReader r m, HasStoreSocket r, HasProtoVersion r
+
+    , MonadError RemoteStoreError m
+  )
+  => TunnelLogger r
+  -> ErrorInfo
+  -> m Bool
+stopWorkOnError x ex = updateLogger x $ \st ->
+  case _tunnelLoggerState_canSendStderr st of
+    False -> (st, pure False)
+    True -> (,) (TunnelLoggerState False []) $ do
+      asks hasProtoVersion >>= \pv -> if protoVersion_minor pv >= 26
+        then sockPutS logger' (Logger_Error (Right ex))
+        else sockPutS logger' (Logger_Error (Left (BasicError 0 (Data.Text.pack $ show ex))))
+      pure True
+  where logger' = mapErrorS RemoteStoreError_SerializerLogger logger
+
+updateLogger
+  :: (MonadIO m, MonadReader r m, HasStoreSocket r)
+  => TunnelLogger r
+  -> (TunnelLoggerState r -> (TunnelLoggerState r, m a))
+  -> m a
+updateLogger x = join . liftIO . atomicModifyIORef (_tunnelLogger_state x)

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

@@ -1,23 +1,26 @@
 module System.Nix.Store.Remote.Socket where
 
-import Control.Monad.Except (throwError)
-import Control.Monad.Reader (asks)
+import Control.Monad.Except (MonadError, throwError)
 import Control.Monad.IO.Class (MonadIO(..))
+import Control.Monad.Reader (MonadReader, ask, asks)
 import Data.ByteString (ByteString)
-import Data.HashSet (HashSet)
 import Data.Serialize.Get (Get, Result(..))
-import Data.Serialize.Put
+import Data.Serialize.Put (Put, runPut)
 import Network.Socket.ByteString (recv, sendAll)
-import System.Nix.StorePath (StorePath)
-import System.Nix.Store.Remote.MonadStore
-import System.Nix.Store.Remote.Serializer (NixSerializer, runP)
-import System.Nix.Store.Remote.Serialize.Prim
-import System.Nix.Store.Remote.Types
+import System.Nix.Store.Remote.MonadStore (MonadRemoteStoreR, RemoteStoreError(..))
+import System.Nix.Store.Remote.Serializer (NixSerializer, runP, runSerialT)
+import System.Nix.Store.Remote.Types (HasStoreSocket(..))
 
+import qualified Control.Exception
+import qualified Data.ByteString
+import qualified Data.Serializer
 import qualified Data.Serialize.Get
 
 genericIncremental
-  :: MonadIO m
+  :: ( MonadIO m
+     , MonadError RemoteStoreError m
+     , Show a
+     )
   => m ByteString
   -> Get a
   -> m a
@@ -25,73 +28,86 @@ genericIncremental getsome parser = do
   getsome >>= go . decoder
  where
   decoder = Data.Serialize.Get.runGetPartial parser
+  go (Done x leftover) | leftover /= mempty =
+    throwError
+    $ RemoteStoreError_GenericIncrementalLeftovers
+        (show x)
+        leftover
+
   go (Done x _leftover) = pure x
+
   go (Partial k) = do
     chunk <- getsome
     go (k chunk)
-  go (Fail msg _leftover) = error msg
 
-getSocketIncremental :: Get a -> MonadStore a
-getSocketIncremental = genericIncremental sockGet8
+  go (Fail msg leftover) =
+    throwError
+    $ RemoteStoreError_GenericIncrementalFail
+        msg
+        leftover
 
-sockGet8 :: MonadStore ByteString
+sockGet8
+  :: ( MonadIO m
+     , MonadError RemoteStoreError m
+     , MonadReader r m
+     , HasStoreSocket r
+     )
+  => m ByteString
 sockGet8 = do
   soc <- asks hasStoreSocket
-  liftIO $ recv soc 8
+  eresult <- liftIO $ Control.Exception.try $ recv soc 8
+  case eresult of
+    Left e ->
+      throwError $ RemoteStoreError_IOException e
 
-sockPut :: Put -> MonadStore ()
+    Right result | Data.ByteString.length result == 0 ->
+      throwError RemoteStoreError_Disconnected
+
+    Right result | otherwise ->
+      pure result
+
+sockPut
+  :: ( MonadRemoteStoreR r m
+     , HasStoreSocket r
+     )
+  => Put
+  -> m ()
 sockPut p = do
   soc <- asks hasStoreSocket
   liftIO $ sendAll soc $ runPut p
 
 sockPutS
-  :: Show e
-  => NixSerializer ProtoVersion e a
+  :: ( MonadReader r m
+     , MonadError e m
+     , MonadIO m
+     , HasStoreSocket r
+     )
+  => NixSerializer r e a
   -> a
-  -> MonadStore ()
+  -> m ()
 sockPutS s a = do
-  soc <- asks hasStoreSocket
-  pv <- asks hasProtoVersion
-  case runP s pv a of
-    Right x -> liftIO $ sendAll soc x
-    -- TODO: errors
-    Left e -> throwError $ show e
+  r <- ask
+  case runP s r a of
+    Right x -> liftIO $ sendAll (hasStoreSocket r) x
+    Left e -> throwError e
 
-sockGet :: Get a -> MonadStore a
-sockGet = getSocketIncremental
+sockGetS
+  :: forall r e m a
+   . ( HasStoreSocket r
+     , MonadError RemoteStoreError m
+     , MonadError e m
+     , MonadReader r m
+     , MonadIO m
+     , Show a
+     , Show e
+     )
+  => NixSerializer r e a
+  -> m a
+sockGetS s = do
+  r <- ask
+  res <- genericIncremental sockGet8
+    $ runSerialT r $ Data.Serializer.getS s
 
-sockGetInt :: Integral a => MonadStore a
-sockGetInt = getSocketIncremental getInt
-
-sockGetBool :: MonadStore Bool
-sockGetBool = (== (1 :: Int)) <$> sockGetInt
-
-sockGetStr :: MonadStore ByteString
-sockGetStr = getSocketIncremental getByteString
-
-sockGetStrings :: MonadStore [ByteString]
-sockGetStrings = getSocketIncremental getByteStrings
-
-sockGetPath :: MonadStore StorePath
-sockGetPath = do
-  sd  <- getStoreDir
-  pth <- getSocketIncremental (getPath sd)
-  either
-    (throwError . show)
-    pure
-    pth
-
-sockGetPathMay :: MonadStore (Maybe StorePath)
-sockGetPathMay = do
-  sd  <- getStoreDir
-  pth <- getSocketIncremental (getPath sd)
-  pure $
-    either
-      (const Nothing)
-      Just
-      pth
-
-sockGetPaths :: MonadStore (HashSet StorePath)
-sockGetPaths = do
-  sd <- getStoreDir
-  getSocketIncremental (getPathsOrFail sd)
+  case res of
+    Right x -> pure x
+    Left e -> throwError e

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

@@ -4,9 +4,14 @@ module System.Nix.Store.Remote.Types
   , module System.Nix.Store.Remote.Types.CheckMode
   , module System.Nix.Store.Remote.Types.Logger
   , module System.Nix.Store.Remote.Types.ProtoVersion
+  , module System.Nix.Store.Remote.Types.Query
   , module System.Nix.Store.Remote.Types.StoreConfig
+  , module System.Nix.Store.Remote.Types.StoreRequest
+  , module System.Nix.Store.Remote.Types.StoreText
   , module System.Nix.Store.Remote.Types.SubstituteMode
+  , module System.Nix.Store.Remote.Types.TrustedFlag
   , module System.Nix.Store.Remote.Types.Verbosity
+  , module System.Nix.Store.Remote.Types.WorkerMagic
   , module System.Nix.Store.Remote.Types.WorkerOp
   ) where
 
@@ -15,7 +20,12 @@ import System.Nix.Store.Remote.Types.GC
 import System.Nix.Store.Remote.Types.CheckMode
 import System.Nix.Store.Remote.Types.Logger
 import System.Nix.Store.Remote.Types.ProtoVersion
+import System.Nix.Store.Remote.Types.Query
 import System.Nix.Store.Remote.Types.StoreConfig
+import System.Nix.Store.Remote.Types.StoreRequest
+import System.Nix.Store.Remote.Types.StoreText
 import System.Nix.Store.Remote.Types.SubstituteMode
+import System.Nix.Store.Remote.Types.TrustedFlag
 import System.Nix.Store.Remote.Types.Verbosity
+import System.Nix.Store.Remote.Types.WorkerMagic
 import System.Nix.Store.Remote.Types.WorkerOp

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

@@ -6,12 +6,14 @@ module System.Nix.Store.Remote.Types.GC (
     GCAction(..)
   , GCOptions(..)
   , GCResult(..)
+  , GCRoot(..)
   ) where
 
 import Data.HashSet (HashSet)
 import Data.Word (Word64)
 import GHC.Generics (Generic)
 import System.Nix.StorePath (StorePath)
+import System.Posix.ByteString (RawFilePath)
 
 -- | Garbage collection action
 data GCAction
@@ -24,24 +26,30 @@ data GCAction
 -- | Garbage collector operation options
 data GCOptions = GCOptions
   { -- | Operation
-    gcOptions_operation :: GCAction
+    gcOptionsOperation :: GCAction
     -- | If set, then reachability from the roots is ignored (unused)
-  , gcOptions_ignoreLiveness :: Bool
+  , gcOptionsIgnoreLiveness :: Bool
     -- | Paths to delete for @GCAction_DeleteSpecific@
-  , gcOptions_pathsToDelete :: HashSet StorePath
+  , gcOptionsPathsToDelete :: HashSet StorePath
     -- | Stop after `gcOptions_maxFreed` bytes have been freed
-  , gcOptions_maxFreed :: Integer
+  , gcOptionsMaxFreed :: Word64
   } deriving (Eq, Generic, Ord, Show)
 
 -- | Result of the garbage collection operation
 data GCResult = GCResult
  { -- | Depending on the action, the GC roots,
    -- or the paths that would be or have been deleted
-   gcResult_deletedPaths :: HashSet StorePath
+   gcResultDeletedPaths :: HashSet StorePath
    -- | The number of bytes that would be or was freed for
    --
    --      - @GCAction_ReturnDead@
    --      - @GCAction_DeleteDead@
    --      - @GCAction_DeleteSpecific@
- , gcResult_bytesFreed :: Word64
+ , gcResultBytesFreed :: Word64
  } deriving (Eq, Generic, Ord, Show)
+
+-- | Used as a part of the result of @FindRoots@ operation
+data GCRoot
+  = GCRoot_Censored -- ^ Source path is censored since the user is not trusted
+  | GCRoot_Path RawFilePath -- ^ Raw source path
+  deriving (Eq, Generic, Ord, Show)

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

@@ -0,0 +1,37 @@
+module System.Nix.Store.Remote.Types.Handshake
+  ( ClientHandshakeInput(..)
+  , ClientHandshakeOutput(..)
+  , ServerHandshakeInput(..)
+  , ServerHandshakeOutput(..)
+  ) where
+
+import Data.Text (Text)
+import GHC.Generics (Generic)
+import System.Nix.Store.Remote.Types.ProtoVersion (ProtoVersion)
+import System.Nix.Store.Remote.Types.TrustedFlag (TrustedFlag)
+
+-- | Data sent by the client during initial protocol handshake
+data ClientHandshakeInput = ClientHandshakeInput
+  { clientHandshakeInputOurVersion :: ProtoVersion -- ^ Our protocol version (that we advertise to the server)
+  } deriving (Eq, Generic, Ord, Show)
+
+-- | Data received by the client via initial protocol handshake
+data ClientHandshakeOutput = ClientHandshakeOutput
+  { clientHandshakeOutputNixVersion :: Maybe Text -- ^ Textual version, since 1.33
+  , clientHandshakeOutputTrust :: Maybe TrustedFlag -- ^ Whether remote side trusts us
+  , clientHandshakeOutputLeastCommonVerison :: ProtoVersion -- ^ Minimum protocol version supported by both sides
+  , clientHandshakeOutputServerVersion :: ProtoVersion -- ^ Protocol version supported by the server
+  } deriving (Eq, Generic, Ord, Show)
+
+-- | Data sent by the server during initial protocol handshake
+data ServerHandshakeInput = ServerHandshakeInput
+  { serverHandshakeInputNixVersion :: Text -- ^ Textual version, since 1.33
+  , serverHandshakeInputOurVersion :: ProtoVersion -- ^ Our protocol version (that we advertise to the client)
+  , serverHandshakeInputTrust :: Maybe TrustedFlag -- ^ Whether client should trusts us
+  } deriving (Eq, Generic, Ord, Show)
+
+-- | Data received by the server during initial protocol handshake
+data ServerHandshakeOutput = ServerHandshakeOutput
+  { serverHandshakeOutputLeastCommonVersion :: ProtoVersion -- ^ Minimum protocol version supported by both sides
+  , serverHandshakeOutputClientVersion :: ProtoVersion -- ^ Protocol version supported by the client
+  } deriving (Eq, Generic, Ord, Show)

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

@@ -5,13 +5,14 @@ module System.Nix.Store.Remote.Types.Logger
   , ErrorInfo(..)
   , Logger(..)
   , LoggerOpCode(..)
-  , loggerOpCodeToInt
-  , intToLoggerOpCode
+  , loggerOpCodeToWord64
+  , word64ToLoggerOpCode
   , isError
   ) where
 
 import Data.ByteString (ByteString)
 import Data.Text (Text)
+import Data.Word (Word64)
 import GHC.Generics
 import System.Nix.Store.Remote.Types.Activity (Activity, ActivityID, ActivityResult)
 import System.Nix.Store.Remote.Types.Verbosity (Verbosity)
@@ -55,8 +56,8 @@ data LoggerOpCode
   | LoggerOpCode_Result
   deriving (Eq, Generic, Ord, Show)
 
-loggerOpCodeToInt :: LoggerOpCode -> Int
-loggerOpCodeToInt = \case
+loggerOpCodeToWord64 :: LoggerOpCode -> Word64
+loggerOpCodeToWord64 = \case
   LoggerOpCode_Next -> 0x6f6c6d67
   LoggerOpCode_Read -> 0x64617461
   LoggerOpCode_Write -> 0x64617416
@@ -66,8 +67,8 @@ loggerOpCodeToInt = \case
   LoggerOpCode_StopActivity -> 0x53544f50
   LoggerOpCode_Result -> 0x52534c54
 
-intToLoggerOpCode :: Int -> Either String LoggerOpCode
-intToLoggerOpCode = \case
+word64ToLoggerOpCode :: Word64 -> Either String LoggerOpCode
+word64ToLoggerOpCode = \case
   0x6f6c6d67 -> Right LoggerOpCode_Next
   0x64617461 -> Right LoggerOpCode_Read
   0x64617416 -> Right LoggerOpCode_Write
@@ -80,7 +81,7 @@ intToLoggerOpCode = \case
 
 data Logger
   = Logger_Next Text
-  | Logger_Read Int         -- data needed from source
+  | Logger_Read Word64      -- data needed from source
   | Logger_Write ByteString -- data for sink
   | Logger_Last
   | Logger_Error (Either BasicError ErrorInfo)

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

@@ -1,6 +1,7 @@
 module System.Nix.Store.Remote.Types.ProtoVersion
   ( ProtoVersion(..)
   , HasProtoVersion(..)
+  , ourProtoVersion
   ) where
 
 import Data.Word (Word8, Word16)
@@ -17,3 +18,10 @@ class HasProtoVersion r where
 
 instance HasProtoVersion ProtoVersion where
   hasProtoVersion = id
+
+-- | The protocol version we support
+ourProtoVersion :: ProtoVersion
+ourProtoVersion = ProtoVersion
+  { protoVersion_major = 1
+  , protoVersion_minor = 24
+  }

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

@@ -0,0 +1,5 @@
+module System.Nix.Store.Remote.Types.Query
+  ( module System.Nix.Store.Remote.Types.Query.Missing
+  ) where
+
+import System.Nix.Store.Remote.Types.Query.Missing

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

@@ -0,0 +1,18 @@
+module System.Nix.Store.Remote.Types.Query.Missing
+  ( Missing(..)
+  ) where
+
+import Data.HashSet (HashSet)
+import Data.Word (Word64)
+import GHC.Generics (Generic)
+import System.Nix.StorePath (StorePath)
+
+-- | Result of @QueryMissing@ @StoreRequest@
+data Missing = Missing
+  { missingWillBuild :: HashSet StorePath -- ^ Paths that will be built
+  , missingWillSubstitute :: HashSet StorePath -- ^ Paths that can be substituted from cache
+  , missingUnknownPaths :: HashSet StorePath -- ^ Path w/o any information
+  , missingDownloadSize :: Word64 -- ^ Total size of packed NARs to download
+  , missingNarSize :: Word64 -- ^ Total size of NARs after unpacking
+  }
+  deriving (Eq, Generic, Ord, Show)

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

@@ -2,15 +2,18 @@
 module System.Nix.Store.Remote.Types.StoreConfig
   ( PreStoreConfig(..)
   , StoreConfig(..)
+  , TestStoreConfig(..)
   , HasStoreSocket(..)
+  , preStoreConfigToStoreConfig
   ) where
 
+import GHC.Generics (Generic)
 import Network.Socket (Socket)
 import System.Nix.StorePath (HasStoreDir(..), StoreDir)
 import System.Nix.Store.Remote.Types.ProtoVersion (HasProtoVersion(..), ProtoVersion)
 
 data PreStoreConfig = PreStoreConfig
-  { preStoreConfig_dir    :: StoreDir
+  { preStoreConfig_dir :: StoreDir
   , preStoreConfig_socket :: Socket
   }
 
@@ -27,9 +30,9 @@ instance HasStoreSocket PreStoreConfig where
   hasStoreSocket = preStoreConfig_socket
 
 data StoreConfig = StoreConfig
-  { storeConfig_dir         :: StoreDir
+  { storeConfig_dir :: StoreDir
   , storeConfig_protoVersion :: ProtoVersion
-  , storeConfig_socket      :: Socket
+  , storeConfig_socket :: Socket
   }
 
 instance HasStoreDir StoreDir where
@@ -43,3 +46,27 @@ instance HasProtoVersion StoreConfig where
 
 instance HasStoreSocket StoreConfig where
   hasStoreSocket = storeConfig_socket
+
+data TestStoreConfig = TestStoreConfig
+  { testStoreConfig_dir :: StoreDir
+  , testStoreConfig_protoVersion :: ProtoVersion
+  } deriving (Eq, Generic, Ord, Show)
+
+instance HasProtoVersion TestStoreConfig where
+  hasProtoVersion = testStoreConfig_protoVersion
+
+instance HasStoreDir TestStoreConfig where
+  hasStoreDir = testStoreConfig_dir
+
+-- | Convert @PreStoreConfig@ to @StoreConfig@
+-- adding @ProtoVersion@ to latter
+preStoreConfigToStoreConfig
+  :: ProtoVersion
+  -> PreStoreConfig
+  -> StoreConfig
+preStoreConfigToStoreConfig pv PreStoreConfig{..} =
+  StoreConfig
+    { storeConfig_dir = preStoreConfig_dir
+    , storeConfig_protoVersion = pv
+    , storeConfig_socket = preStoreConfig_socket
+    }

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

@@ -0,0 +1,60 @@
+module System.Nix.Store.Remote.Types.StoreReply
+  ( StoreReply(..)
+  ) where
+
+import Data.HashSet (HashSet)
+import Data.Map (Map)
+import System.Nix.Build (BuildResult)
+import System.Nix.StorePath (HasStoreDir(..), StorePath, StorePathName)
+import System.Nix.StorePath.Metadata (Metadata)
+import System.Nix.Store.Remote.Serializer
+import System.Nix.Store.Remote.Types.GC (GCResult, GCRoot)
+import System.Nix.Store.Remote.Types.Query.Missing (Missing)
+import System.Nix.Store.Remote.Types.ProtoVersion (HasProtoVersion)
+
+-- | Get @NixSerializer@ for some type @a@
+-- This could also be generalized for every type
+-- we have a serializer for but we mostly need
+-- this for replies and it would make look serializers
+-- quite hodor, like @a <- getS get; b <- getS get@
+class StoreReply a where
+  getReplyS
+    :: ( HasStoreDir r
+       , HasProtoVersion r
+       )
+    => NixSerializer r ReplySError a
+
+instance StoreReply () where
+  getReplyS = opSuccess
+
+instance StoreReply Bool where
+  getReplyS = mapPrimE bool
+
+instance StoreReply BuildResult where
+  getReplyS = buildResult
+
+instance StoreReply GCResult where
+  getReplyS = gcResult
+
+instance StoreReply (Map GCRoot StorePath) where
+  getReplyS = mapS gcRoot (mapPrimE storePath)
+
+instance StoreReply Missing where
+  getReplyS = missing
+
+instance StoreReply (Maybe (Metadata StorePath)) where
+  getReplyS = maybePathMetadata
+
+instance StoreReply StorePath where
+  getReplyS = mapPrimE storePath
+
+instance StoreReply (HashSet StorePath) where
+  getReplyS = mapPrimE (hashSet storePath)
+
+instance StoreReply (HashSet StorePathName) where
+  getReplyS = mapPrimE (hashSet storePathName)
+
+mapPrimE
+  :: NixSerializer r SError a
+  -> NixSerializer r ReplySError a
+mapPrimE = mapErrorS ReplySError_PrimGet

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

@@ -0,0 +1,185 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module System.Nix.Store.Remote.Types.StoreRequest
+  ( StoreRequest(..)
+  ) where
+
+import Data.GADT.Compare.TH (deriveGEq, deriveGCompare)
+import Data.GADT.Show.TH (deriveGShow)
+import Data.HashSet (HashSet)
+import Data.Kind (Type)
+import Data.Map (Map)
+import Data.Set (Set)
+import Data.Text (Text)
+import Data.Some (Some(Some))
+
+import System.Nix.Build (BuildMode, BuildResult)
+import System.Nix.Derivation (Derivation)
+import System.Nix.DerivedPath (DerivedPath)
+import System.Nix.Hash (HashAlgo)
+import System.Nix.Signature (Signature)
+import System.Nix.Store.Types (FileIngestionMethod, RepairMode)
+import System.Nix.StorePath (StorePath, StorePathName, StorePathHashPart)
+import System.Nix.StorePath.Metadata (Metadata)
+import System.Nix.Store.Remote.Types.GC (GCOptions, GCResult, GCRoot)
+import System.Nix.Store.Remote.Types.CheckMode (CheckMode)
+import System.Nix.Store.Remote.Types.Query.Missing (Missing)
+import System.Nix.Store.Remote.Types.StoreText (StoreText)
+import System.Nix.Store.Remote.Types.SubstituteMode (SubstituteMode)
+
+data StoreRequest :: Type -> Type where
+  -- | Add @NarSource@ to the store.
+  AddToStore
+    :: StorePathName -- ^ Name part of the newly created @StorePath@
+    -> FileIngestionMethod -- ^ Add target directory recursively
+    -> Some HashAlgo -- ^ Nar hashing algorithm
+    -> RepairMode -- ^ Only used by local store backend
+    -> StoreRequest StorePath
+
+  -- | Add text to store.
+  --
+  -- Reference accepts repair but only uses it
+  -- to throw error in case of remote talking to nix-daemon.
+  AddTextToStore
+    :: StoreText
+    -> HashSet StorePath -- ^ Set of @StorePath@s that the added text references
+    -> RepairMode -- ^ Repair mode, must be @RepairMode_DontRepair@ in case of remote backend
+    -> StoreRequest StorePath
+
+  AddSignatures
+    :: StorePath
+    -> Set Signature
+    -> StoreRequest ()
+
+  AddIndirectRoot
+    :: StorePath
+    -> StoreRequest ()
+
+  -- | Add temporary garbage collector root.
+  --
+  -- This root is removed as soon as the client exits.
+  AddTempRoot
+    :: StorePath
+    -> StoreRequest ()
+
+  -- | Build paths if they are an actual derivations.
+  --
+  -- If derivation output paths are already valid, do nothing.
+  BuildPaths
+    :: Set DerivedPath
+    -> BuildMode
+    -> StoreRequest ()
+
+  BuildDerivation
+    :: StorePath
+    -> Derivation StorePath Text
+    -> BuildMode
+    -> StoreRequest BuildResult
+
+  CollectGarbage
+    :: GCOptions
+    -> StoreRequest GCResult
+
+  EnsurePath
+    :: StorePath
+    -> StoreRequest ()
+
+  -- | Find garbage collector roots.
+  FindRoots
+    :: StoreRequest (Map GCRoot StorePath)
+
+  IsValidPath
+    :: StorePath
+    -> StoreRequest Bool
+
+  -- | Query valid paths from set, optionally try to use substitutes.
+  QueryValidPaths
+    :: HashSet StorePath
+    -- ^ Set of @StorePath@s to query
+    -> SubstituteMode
+    -- ^ Try substituting missing paths when @SubstituteMode_DoSubstitute@
+    -> StoreRequest (HashSet StorePath)
+
+  QueryAllValidPaths
+    :: StoreRequest (HashSet StorePath)
+
+  QuerySubstitutablePaths
+    :: HashSet StorePath
+    -> StoreRequest (HashSet StorePath)
+
+  QueryPathInfo
+    :: StorePath
+    -> StoreRequest (Maybe (Metadata StorePath))
+
+  QueryReferrers
+    :: StorePath
+    -> StoreRequest (HashSet StorePath)
+
+  QueryValidDerivers
+    :: StorePath
+    -> StoreRequest (HashSet StorePath)
+
+  QueryDerivationOutputs
+    :: StorePath
+    -> StoreRequest (HashSet StorePath)
+
+  QueryDerivationOutputNames
+    :: StorePath
+    -> StoreRequest (HashSet StorePathName)
+
+  QueryPathFromHashPart
+    :: StorePathHashPart
+    -> StoreRequest StorePath
+
+  QueryMissing
+    :: Set DerivedPath
+    -> StoreRequest Missing
+
+  OptimiseStore
+    :: StoreRequest ()
+
+  SyncWithGC
+    :: StoreRequest ()
+
+  -- returns True on errors
+  VerifyStore
+    :: CheckMode
+    -> RepairMode
+    -> StoreRequest Bool
+
+deriving instance Eq (StoreRequest a)
+deriving instance Show (StoreRequest a)
+
+deriveGEq ''StoreRequest
+deriveGCompare ''StoreRequest
+deriveGShow ''StoreRequest
+
+instance {-# OVERLAPPING #-} Eq (Some StoreRequest) where
+  Some (AddToStore a b c d) == Some (AddToStore a' b' c' d') = (a, b, c, d) == (a', b', c', d')
+  Some (AddTextToStore a b c) == Some (AddTextToStore a' b' c') = (a, b, c) == (a', b', c')
+  Some (AddSignatures a b) == Some (AddSignatures a' b') = (a, b) == (a', b')
+  Some (AddIndirectRoot a) == Some (AddIndirectRoot a') = a == a'
+  Some (AddTempRoot a) == Some (AddTempRoot a') = a == a'
+  Some (BuildPaths a b) == Some (BuildPaths a' b') = (a, b) == (a', b')
+  Some (BuildDerivation a b c) == Some (BuildDerivation a' b' c') = (a, b, c) == (a', b', c')
+  Some (CollectGarbage a) == Some (CollectGarbage a') = a == a'
+  Some (EnsurePath a) == Some (EnsurePath a') = a == a'
+  Some (FindRoots) == Some (FindRoots) = True
+  Some (IsValidPath a) == Some (IsValidPath a') = a == a'
+  Some (QueryValidPaths a b) == Some (QueryValidPaths a' b') = (a, b) == (a', b')
+  Some QueryAllValidPaths == Some QueryAllValidPaths = True
+  Some (QuerySubstitutablePaths a) == Some (QuerySubstitutablePaths a') = a == a'
+  Some (QueryPathInfo a) == Some (QueryPathInfo a') = a == a'
+  Some (QueryReferrers a) == Some (QueryReferrers a') = a == a'
+  Some (QueryValidDerivers a) == Some (QueryValidDerivers a') = a == a'
+  Some (QueryDerivationOutputs a) == Some (QueryDerivationOutputs a') = a == a'
+  Some (QueryDerivationOutputNames a) == Some (QueryDerivationOutputNames a') = a == a'
+  Some (QueryPathFromHashPart a) == Some (QueryPathFromHashPart a') = a == a'
+  Some (QueryMissing a) == Some (QueryMissing a') = a == a'
+  Some OptimiseStore == Some OptimiseStore = True
+  Some SyncWithGC == Some SyncWithGC = True
+  Some (VerifyStore a b) == Some (VerifyStore a' b') = (a, b) == (a', b')
+
+  _ == _ = False

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

@@ -0,0 +1,12 @@
+module System.Nix.Store.Remote.Types.StoreText
+  ( StoreText(..)
+  ) where
+
+import Data.Text (Text)
+import GHC.Generics (Generic)
+import System.Nix.StorePath (StorePathName)
+
+data StoreText = StoreText
+  { storeTextName :: StorePathName
+  , storeTextText :: Text
+  } deriving (Eq, Generic, Ord, Show)

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

@@ -0,0 +1,11 @@
+module System.Nix.Store.Remote.Types.TrustedFlag
+  ( TrustedFlag(..)
+  ) where
+
+import GHC.Generics (Generic)
+
+-- | Whether remote side trust us
+data TrustedFlag
+  = TrustedFlag_Trusted
+  | TrustedFlag_NotTrusted
+  deriving (Bounded, Eq, Generic, Enum, Ord, Show)

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

@@ -0,0 +1,27 @@
+module System.Nix.Store.Remote.Types.WorkerMagic
+  ( WorkerMagic(..)
+  , workerMagicToWord64
+  , word64ToWorkerMagic
+  ) where
+
+import Data.Word (Word64)
+import GHC.Generics (Generic)
+
+-- | WorkerMagic
+--
+-- Magic numbers exchange during handshake
+data WorkerMagic
+  = WorkerMagic_One
+  | WorkerMagic_Two
+  deriving (Eq, Generic, Ord, Show)
+
+workerMagicToWord64 :: WorkerMagic -> Word64
+workerMagicToWord64 = \case
+  WorkerMagic_One -> 0x6e697863
+  WorkerMagic_Two -> 0x6478696f
+
+word64ToWorkerMagic :: Word64 -> Either String WorkerMagic
+word64ToWorkerMagic = \case
+  0x6e697863 -> Right WorkerMagic_One
+  0x6478696f -> Right WorkerMagic_Two
+  x -> Left $ "Invalid WorkerMagic: " ++ show x

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

@@ -2,56 +2,58 @@ module System.Nix.Store.Remote.Types.WorkerOp
   ( WorkerOp(..)
   ) where
 
+import GHC.Generics (Generic)
+
 -- | Worker opcode
 --
 -- This type has gaps filled in so that the GHC builtin
 -- Enum instance lands on the right values.
 data WorkerOp
-  = Reserved_0__ -- 0
-  | IsValidPath -- 1
-  | Reserved_2__ -- 2
-  | HasSubstitutes -- 3
-  | QueryPathHash -- 4 // obsolete
-  | QueryReferences --  5 // obsolete
-  | QueryReferrers --  6
-  | AddToStore --  7
-  | AddTextToStore --  8 // obsolete since 1.25, Nix 3.0. Use wopAddToStore
-  | BuildPaths --  9
-  | EnsurePath --  10 0xa
-  | AddTempRoot --  11 0xb
-  | AddIndirectRoot --  12 0xc
-  | SyncWithGC --  13 0xd
-  | FindRoots --  14 0xe
-  | Reserved_15__ -- 15 0xf
-  | ExportPath --  16 0x10 // obsolete
-  | Reserved_17__ -- 17 0x11
-  | QueryDeriver --  18 0x12 // obsolete
-  | SetOptions --  19 0x13
-  | CollectGarbage --  20 0x14
-  | QuerySubstitutablePathInfo --  21 0x15
-  | QueryDerivationOutputs --  22 0x16 // obsolete
-  | QueryAllValidPaths --  23 0x17
-  | QueryFailedPaths --  24 0x18
-  | ClearFailedPaths --  25 0x19
-  | QueryPathInfo --  26 0x1a
-  | ImportPaths --  27 0x1b // obsolete
-  | QueryDerivationOutputNames --  28 0x1c // obsolete
-  | QueryPathFromHashPart --  29 0x1d
-  | QuerySubstitutablePathInfos --  30 0x1e
-  | QueryValidPaths --  31 0x1f
-  | QuerySubstitutablePaths --  32 0x20
-  | QueryValidDerivers --  33 0x21
-  | OptimiseStore --  34 0x22
-  | VerifyStore --  35 0x23
-  | BuildDerivation --  36 0x24
-  | AddSignatures --  37 0x25
-  | NarFromPath --  38 0x26
-  | AddToStoreNar --  39 0x27
-  | QueryMissing --  40 0x28
-  | QueryDerivationOutputMap --  41 0x29
-  | RegisterDrvOutput --  42 0x2a
-  | QueryRealisation --  43 0x2b
-  | AddMultipleToStore --  44 0x2c
-  | AddBuildLog --  45 0x2d
-  | BuildPathsWithResults --  46 0x2e
-  deriving (Bounded, Eq, Enum, Ord, Show, Read)
+  = WorkerOp_Reserved_0__ -- 0
+  | WorkerOp_IsValidPath -- 1
+  | WorkerOp_Reserved_2__ -- 2
+  | WorkerOp_HasSubstitutes -- 3
+  | WorkerOp_QueryPathHash -- 4 // obsolete
+  | WorkerOp_QueryReferences --  5 // obsolete
+  | WorkerOp_QueryReferrers --  6
+  | WorkerOp_AddToStore --  7
+  | WorkerOp_AddTextToStore --  8 // obsolete since 1.25, Nix 3.0. Use wopAddToStore
+  | WorkerOp_BuildPaths --  9
+  | WorkerOp_EnsurePath --  10 0xa
+  | WorkerOp_AddTempRoot --  11 0xb
+  | WorkerOp_AddIndirectRoot --  12 0xc
+  | WorkerOp_SyncWithGC --  13 0xd
+  | WorkerOp_FindRoots --  14 0xe
+  | WorkerOp_Reserved_15__ -- 15 0xf
+  | WorkerOp_ExportPath --  16 0x10 // obsolete
+  | WorkerOp_Reserved_17__ -- 17 0x11
+  | WorkerOp_QueryDeriver --  18 0x12 // obsolete
+  | WorkerOp_SetOptions --  19 0x13
+  | WorkerOp_CollectGarbage --  20 0x14
+  | WorkerOp_QuerySubstitutablePathInfo --  21 0x15
+  | WorkerOp_QueryDerivationOutputs --  22 0x16 // obsolete
+  | WorkerOp_QueryAllValidPaths --  23 0x17
+  | WorkerOp_QueryFailedPaths --  24 0x18
+  | WorkerOp_ClearFailedPaths --  25 0x19
+  | WorkerOp_QueryPathInfo --  26 0x1a
+  | WorkerOp_ImportPaths --  27 0x1b // obsolete
+  | WorkerOp_QueryDerivationOutputNames --  28 0x1c // obsolete
+  | WorkerOp_QueryPathFromHashPart --  29 0x1d
+  | WorkerOp_QuerySubstitutablePathInfos --  30 0x1e
+  | WorkerOp_QueryValidPaths --  31 0x1f
+  | WorkerOp_QuerySubstitutablePaths --  32 0x20
+  | WorkerOp_QueryValidDerivers --  33 0x21
+  | WorkerOp_OptimiseStore --  34 0x22
+  | WorkerOp_VerifyStore --  35 0x23
+  | WorkerOp_BuildDerivation --  36 0x24
+  | WorkerOp_AddSignatures --  37 0x25
+  | WorkerOp_NarFromPath --  38 0x26
+  | WorkerOp_AddToStoreNar --  39 0x27
+  | WorkerOp_QueryMissing --  40 0x28
+  | WorkerOp_QueryDerivationOutputMap --  41 0x29
+  | WorkerOp_RegisterDrvOutput --  42 0x2a
+  | WorkerOp_QueryRealisation --  43 0x2b
+  | WorkerOp_AddMultipleToStore --  44 0x2c
+  | WorkerOp_AddBuildLog --  45 0x2d
+  | WorkerOp_BuildPathsWithResults --  46 0x2e
+  deriving (Bounded, Eq, Enum, Generic, Ord, Show, Read)

hnix-store-remote/tests-io/Driver.hs

@@ -1,9 +0,0 @@
-import           NixDaemon
-import qualified Spec
-
--- we run remote tests in
--- Linux namespaces to avoid interacting with systems store
-main :: IO ()
-main = do
-  enterNamespaces
-  Spec.main

hnix-store-remote/tests-io/Main.hs

@@ -0,0 +1,12 @@
+module Main where
+
+import qualified Test.Hspec
+import qualified NixDaemonSpec
+
+-- we run remote tests in
+-- Linux namespaces to avoid interacting with systems store
+main :: IO ()
+main = do
+  NixDaemonSpec.enterNamespaces
+  Test.Hspec.hspec
+    NixDaemonSpec.spec

hnix-store-remote/tests-io/NixDaemon.hs

@@ -1,291 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module NixDaemon where
-
-import Data.Text (Text)
-import Data.Either (isRight, isLeft)
-import Data.Bool (bool)
-import Control.Monad (forM_, void)
-import Control.Monad.IO.Class (liftIO)
-import qualified System.Environment
-import Control.Exception (bracket)
-import Control.Concurrent (threadDelay)
-import qualified Data.ByteString.Char8 as BSC
-import qualified Data.Either
-import qualified Data.HashSet as HS
-import qualified Data.Map.Strict as M
-import qualified Data.Text
-import qualified Data.Text.Encoding
-import System.Directory
-import System.IO.Temp
-import qualified System.Process as P
-import System.Posix.User as U
-import System.Linux.Namespaces as NS
-import Test.Hspec (Spec, describe, context)
-import qualified Test.Hspec as Hspec
-import Test.Hspec.Expectations.Lifted
-import System.FilePath
-import System.Nix.Build
-import System.Nix.StorePath
-import System.Nix.StorePath.Metadata
-import System.Nix.Store.Remote
-import System.Nix.Store.Remote.Protocol
-
-import Crypto.Hash (SHA256)
-import System.Nix.Nar (dumpPath)
-
-createProcessEnv :: FilePath -> String -> [String] -> IO P.ProcessHandle
-createProcessEnv fp proc args = do
-  mPath         <- System.Environment.lookupEnv "PATH"
-
-  (_, _, _, ph) <-
-    P.createProcess (P.proc proc args)
-      { P.cwd = Just fp
-      , P.env = Just $ mockedEnv mPath fp
-      }
-  pure ph
-
-mockedEnv :: Maybe String -> FilePath -> [(String, FilePath)]
-mockedEnv mEnvPath fp =
-  [ ("NIX_STORE_DIR"     , fp </> "store")
-  , ("NIX_LOCALSTATE_DIR", fp </> "var")
-  , ("NIX_LOG_DIR"       , fp </> "var" </> "log")
-  , ("NIX_STATE_DIR"     , fp </> "var" </> "nix")
-  , ("NIX_CONF_DIR"      , fp </> "etc")
-  , ("HOME"              , fp </> "home")
---  , ("NIX_REMOTE", "daemon")
-    ] <> foldMap (\x -> [("PATH", x)]) mEnvPath
-
-waitSocket :: FilePath -> Int -> IO ()
-waitSocket _  0 = fail "No socket"
-waitSocket fp x = do
-  ex <- doesFileExist fp
-  bool
-    (threadDelay 100000 >> waitSocket fp (x - 1))
-    (pure ())
-    ex
-
-writeConf :: FilePath -> IO ()
-writeConf fp =
-  writeFile fp $ unlines
-    [ "build-users-group = "
-    , "trusted-users = root"
-    , "allowed-users = *"
-    , "fsync-metadata = false"
-    ]
-
-{-
- - we run in user namespace as root but groups are failed
- - => build-users-group has to be empty but we still
- - get an error (maybe older nix-daemon)
- -
-uid=0(root) gid=65534(nobody) groups=65534(nobody)
-
-drwxr-xr-x 3 0 65534 60 Nov 29 05:53 store
-
-accepted connection from pid 22959, user root (trusted)
-error: changing ownership of path '/run/user/1000/test-nix-store-06b0d249e5616122/store': Invalid argument
--}
-
-startDaemon
-  :: FilePath
-  -> IO (P.ProcessHandle, MonadStore a -> IO (Either String a, [Logger]))
-startDaemon fp = do
-  writeConf (fp </> "etc" </> "nix.conf")
-  p <- createProcessEnv fp "nix-daemon" []
-  waitSocket sockFp 30
-  pure (p, runStoreOpts sockFp (StoreDir $ BSC.pack $ fp </> "store"))
- where
-  sockFp = fp </> "var/nix/daemon-socket/socket"
-
-enterNamespaces :: IO ()
-enterNamespaces = do
-  uid <- getEffectiveUserID
-  gid <- getEffectiveGroupID
-
-  unshare [User, Network, Mount]
-  -- fmap our (parent) uid to root
-  writeUserMappings Nothing [UserMapping 0 uid 1]
-  -- fmap our (parent) gid to root group
-  writeGroupMappings Nothing [GroupMapping 0 gid 1] True
-
-withNixDaemon
-  :: ((MonadStore a -> IO (Either String a, [Logger])) -> IO a) -> IO a
-withNixDaemon action =
-  withSystemTempDirectory "test-nix-store" $ \path -> do
-
-    mapM_ (createDirectory . snd)
-          (filter ((/= "NIX_REMOTE") . fst) $ mockedEnv Nothing path)
-
-    ini <- createProcessEnv path "nix-store" ["--init"]
-    void $ P.waitForProcess ini
-
-    writeFile (path </> "dummy") "Hello World"
-
-    setCurrentDirectory path
-
-    bracket (startDaemon path)
-            (P.terminateProcess . fst)
-            (action . snd)
-
-checks :: (Show a, Show b) => IO (a, b) -> (a -> Bool) -> IO ()
-checks action check = action >>= (`Hspec.shouldSatisfy` (check . fst))
-
-it
-  :: (Show a, Show b, Monad m)
-  => String
-  -> m c
-  -> (a -> Bool)
-  -> Hspec.SpecWith (m () -> IO (a, b))
-it name action check =
-  Hspec.it name $ \run -> run (void $ action) `checks` check
-
-itRights
-  :: (Show a, Show b, Show c, Monad m)
-  => String
-  -> m d
-  -> Hspec.SpecWith (m () -> IO (Either a b, c))
-itRights name action = it name action isRight
-
-itLefts
-  :: (Show a, Show b, Show c, Monad m)
-  => String
-  -> m d
-  -> Hspec.SpecWith (m () -> IO (Either a b, c))
-itLefts name action = it name action isLeft
-
-withPath :: (StorePath -> MonadStore a) -> MonadStore a
-withPath action = do
-  path <- addTextToStore "hnix-store" "test" mempty RepairMode_DontRepair
-  action path
-
--- | dummy path, adds <tmp>/dummpy with "Hello World" contents
-dummy :: MonadStore StorePath
-dummy = do
-  let name = Data.Either.fromRight (error "impossible") $ makeStorePathName "dummy"
-  addToStore @SHA256 name (dumpPath "dummy") FileIngestionMethod_Flat RepairMode_DontRepair
-
-invalidPath :: StorePath
-invalidPath =
-  let name = Data.Either.fromRight (error "impossible") $ makeStorePathName "invalid"
-  in  unsafeMakeStorePath (mkStorePathHashPart @SHA256 "invalid") name
-
-withBuilder :: (StorePath -> MonadStore a) -> MonadStore a
-withBuilder action = do
-  path <- addTextToStore "builder" builderSh mempty RepairMode_DontRepair
-  action path
-
-builderSh :: Text
-builderSh = "declare -xpexport > $out"
-
-spec_protocol :: Spec
-spec_protocol = Hspec.around withNixDaemon $
-
-  describe "store" $ do
-
-    context "syncWithGC" $
-      itRights "syncs with garbage collector" syncWithGC
-
-    context "verifyStore" $ do
-      itRights "check=False repair=False" $
-        verifyStore
-          CheckMode_DontCheck
-          RepairMode_DontRepair
-        `shouldReturn` False
-
-      itRights "check=True repair=False" $
-        verifyStore
-          CheckMode_DoCheck
-          RepairMode_DontRepair
-        `shouldReturn` False
-
-      --privileged
-      itRights "check=True repair=True" $
-        verifyStore
-          CheckMode_DoCheck
-          RepairMode_DoRepair
-        `shouldReturn` False
-
-    context "addTextToStore" $
-      itRights "adds text to store" $ withPath pure
-
-    context "isValidPathUncached" $ do
-      itRights "validates path" $ withPath $ \path -> do
-        liftIO $ print path
-        isValidPathUncached path `shouldReturn` True
-      itLefts "fails on invalid path" $ mapStoreDir (\_ -> StoreDir "/asdf") $ isValidPathUncached invalidPath
-
-    context "queryAllValidPaths" $ do
-      itRights "empty query" queryAllValidPaths
-      itRights "non-empty query" $ withPath $ \path ->
-        queryAllValidPaths `shouldReturn` HS.fromList [path]
-
-    context "queryPathInfoUncached" $
-      itRights "queries path info" $ withPath $ \path -> do
-        meta <- queryPathInfoUncached path
-        references meta `shouldSatisfy` HS.null
-
-    context "ensurePath" $
-      itRights "simple ensure" $ withPath ensurePath
-
-    context "addTempRoot" $
-      itRights "simple addition" $ withPath addTempRoot
-
-    context "addIndirectRoot" $
-      itRights "simple addition" $ withPath addIndirectRoot
-
-    context "buildPaths" $ do
-      itRights "build Normal" $ withPath $ \path -> do
-        let pathSet = HS.fromList [path]
-        buildPaths pathSet BuildMode_Normal
-
-      itRights "build Check" $ withPath $ \path -> do
-        let pathSet = HS.fromList [path]
-        buildPaths pathSet BuildMode_Check
-
-      itLefts "build Repair" $ withPath $ \path -> do
-        let pathSet = HS.fromList [path]
-        buildPaths pathSet BuildMode_Repair
-
-    context "roots" $ context "findRoots" $ do
-        itRights "empty roots" (findRoots `shouldReturn` M.empty)
-
-        itRights "path added as a temp root" $ withPath $ \_ -> do
-          roots <- findRoots
-          roots `shouldSatisfy` ((== 1) . M.size)
-
-    context "optimiseStore" $ itRights "optimises" optimiseStore
-
-    context "queryMissing" $
-      itRights "queries" $ withPath $ \path -> do
-        let pathSet = HS.fromList [path]
-        queryMissing pathSet `shouldReturn` (HS.empty, HS.empty, HS.empty, 0, 0)
-
-    context "addToStore" $
-      itRights "adds file to store" $ do
-        fp <- liftIO $ writeSystemTempFile "addition" "lal"
-        let name = Data.Either.fromRight (error "impossible") $ makeStorePathName "tmp-addition"
-        res <- addToStore @SHA256 name (dumpPath fp) FileIngestionMethod_Flat RepairMode_DontRepair
-        liftIO $ print res
-
-    context "with dummy" $ do
-      itRights "adds dummy" dummy
-
-      itRights "valid dummy" $ do
-        path <- dummy
-        liftIO $ print path
-        isValidPathUncached path `shouldReturn` True
-
-    context "deleteSpecific" $
-      itRights "delete a path from the store" $ withPath $ \path -> do
-          -- clear temp gc roots so the delete works. restarting the nix daemon should also do this...
-          storeDir <- getStoreDir
-          let tempRootsDir = Data.Text.unpack $ mconcat [ Data.Text.Encoding.decodeUtf8 (unStoreDir storeDir), "/../var/nix/temproots/" ]
-          tempRootList <- liftIO $ listDirectory tempRootsDir
-          liftIO $ forM_ tempRootList $ \entry -> do
-            removeFile $ mconcat [ tempRootsDir, "/", entry ]
-
-          GCResult{..} <- deleteSpecific (HS.fromList [path])
-          gcResult_deletedPaths `shouldBe` HS.fromList [path]
-          gcResult_bytesFreed `shouldBe` 4
-

hnix-store-remote/tests-io/NixDaemonSpec.hs

@@ -0,0 +1,397 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module NixDaemonSpec
+  ( enterNamespaces
+  , spec
+  ) where
+
+import Control.Monad (forM_, unless, void)
+import Control.Monad.IO.Class (liftIO)
+import Crypto.Hash (SHA256)
+import Data.Some (Some(Some))
+import Data.Text (Text)
+import Test.Hspec (Spec, SpecWith, around, describe, context)
+import Test.Hspec.Expectations.Lifted
+import Test.Hspec.Nix (forceRight)
+import System.FilePath ((</>))
+import System.Linux.Namespaces (Namespace(..), GroupMapping(..), UserMapping(..))
+import System.Nix.Hash (HashAlgo(HashAlgo_SHA256))
+import System.Nix.Build (BuildMode(..))
+import System.Nix.DerivedPath (DerivedPath(..))
+import System.Nix.StorePath (StoreDir(..), StorePath)
+import System.Nix.StorePath.Metadata (Metadata(..))
+import System.Nix.Store.Remote
+import System.Nix.Store.Remote.MonadStore (MonadRemoteStore)
+import System.Process (CreateProcess(..), ProcessHandle)
+import qualified Control.Concurrent
+import qualified Control.Exception
+import qualified Data.ByteString.Char8
+import qualified Data.Either
+import qualified Data.HashSet
+import qualified Data.Map
+import qualified Data.Set
+import qualified Data.Text
+import qualified Data.Text.Encoding
+import qualified System.Directory
+import qualified System.Environment
+import qualified System.IO.Temp
+import qualified System.Linux.Namespaces
+import qualified System.Nix.StorePath
+import qualified System.Nix.Nar
+import qualified System.Nix.Store.Remote.MonadStore
+import qualified System.Posix.User
+import qualified System.Process
+import qualified Test.Hspec
+
+createProcessEnv
+  :: FilePath
+  -> String
+  -> [String]
+  -> IO ProcessHandle
+createProcessEnv fp proc args = do
+  mPath         <- System.Environment.lookupEnv "PATH"
+
+  (_, _, _, ph) <-
+    System.Process.createProcess (System.Process.proc proc args)
+      { cwd = Just fp
+      , env = Just $ mockedEnv mPath fp
+      }
+  pure ph
+
+mockedEnv
+  :: Maybe String
+  -> FilePath
+  -> [(String, FilePath)]
+mockedEnv mEnvPath fp =
+  [ ("NIX_STORE_DIR"     , fp </> "store")
+  , ("NIX_LOCALSTATE_DIR", fp </> "var")
+  , ("NIX_LOG_DIR"       , fp </> "var" </> "log")
+  , ("NIX_STATE_DIR"     , fp </> "var" </> "nix")
+  , ("NIX_CONF_DIR"      , fp </> "etc")
+  , ("HOME"              , fp </> "home")
+--  , ("NIX_REMOTE", "daemon")
+    ] <> foldMap (\x -> [("PATH", x)]) mEnvPath
+
+waitSocket
+  :: FilePath
+  -> Int
+  -> IO ()
+waitSocket _  0 = fail "No socket"
+waitSocket fp x = do
+  ex <- System.Directory.doesFileExist fp
+  unless ex $ do
+    Control.Concurrent.threadDelay 100000
+    waitSocket fp (x - 1)
+
+writeConf :: FilePath -> IO ()
+writeConf fp =
+  writeFile fp $ unlines
+    [ "build-users-group = "
+    , "trusted-users = root"
+    , "allowed-users = *"
+    , "fsync-metadata = false"
+    ]
+
+{-
+ - we run in user namespace as root but groups are failed
+ - => build-users-group has to be empty but we still
+ - get an error (maybe older nix-daemon)
+ -
+uid=0(root) gid=65534(nobody) groups=65534(nobody)
+
+drwxr-xr-x 3 0 65534 60 Nov 29 05:53 store
+
+accepted connection from pid 22959, user root (trusted)
+error: changing ownership of path '/run/user/1000/test-nix-store-06b0d249e5616122/store': Invalid argument
+-}
+
+startDaemon
+  :: FilePath
+  -> IO (ProcessHandle, MonadStore a -> Run IO a)
+startDaemon fp = do
+  writeConf (fp </> "etc" </> "nix.conf")
+  procHandle <- createProcessEnv fp "nix-daemon" []
+  waitSocket sockFp 30
+  pure ( procHandle
+       , runStoreOpts
+          sockFp
+          (StoreDir
+            $ Data.ByteString.Char8.pack
+            $ fp </> "store"
+          )
+       )
+ where
+  sockFp = fp </> "var/nix/daemon-socket/socket"
+
+enterNamespaces :: IO ()
+enterNamespaces = do
+  uid <- System.Posix.User.getEffectiveUserID
+  gid <- System.Posix.User.getEffectiveGroupID
+
+  System.Linux.Namespaces.unshare
+    [User, Network, Mount]
+
+  -- fmap our (parent) uid to root
+  System.Linux.Namespaces.writeUserMappings
+    Nothing
+    [ UserMapping
+        0    -- inside namespace
+        uid  -- outside namespace
+        1    --range
+    ]
+
+  -- fmap our (parent) gid to root group
+  System.Linux.Namespaces.writeGroupMappings
+    Nothing
+    [ GroupMapping 0 gid 1 ]
+    True
+
+withNixDaemon
+  :: ((MonadStore a -> Run IO a) -> IO a)
+  -> IO a
+withNixDaemon action =
+  System.IO.Temp.withSystemTempDirectory "test-nix-store" $ \path -> do
+
+    mapM_ (System.Directory.createDirectory . snd)
+          (filter
+            ((/= "NIX_REMOTE") . fst)
+            $ mockedEnv Nothing path)
+
+    ini <- createProcessEnv path "nix-store" ["--init"]
+    void $ System.Process.waitForProcess ini
+
+    writeFile (path </> "dummy") "Hello World"
+
+    System.Directory.setCurrentDirectory path
+
+    Control.Exception.bracket
+      (startDaemon path)
+      (System.Process.terminateProcess . fst)
+      (action . snd)
+
+checks
+  :: ( Show a
+     , Show b
+     )
+  => IO (a, b)
+  -> (a -> Bool)
+  -> IO ()
+checks action check =
+  action >>= (`Test.Hspec.shouldSatisfy` (check . fst))
+
+it
+  :: (Show a, Show b, Monad m)
+  => String
+  -> m c
+  -> (a -> Bool)
+  -> SpecWith (m () -> IO (a, b))
+it name action check =
+  Test.Hspec.it name $ \run -> run (void $ action) `checks` check
+
+itRights
+  :: ( Show a
+     , Show b
+     , Show c
+     , Monad m
+     )
+  => String
+  -> m d
+  -> SpecWith (m () -> IO (Either a b, c))
+itRights name action = it name action Data.Either.isRight
+
+itLefts
+  :: ( Show a
+     , Show b
+     , Show c
+     , Monad m
+     )
+  => String
+  -> m d
+  -> SpecWith (m () -> IO (Either a b, c))
+itLefts name action = it name action Data.Either.isLeft
+
+withPath
+  :: (StorePath -> MonadStore a)
+  -> MonadStore a
+withPath action = do
+  path <-
+    addTextToStore
+      (StoreText
+        (forceRight $ System.Nix.StorePath.mkStorePathName "hnix-store")
+        "test"
+      )
+      mempty
+      RepairMode_DontRepair
+  action path
+
+-- | dummy path, adds <tmp>/dummy with "Hello World" contents
+dummy :: MonadStore StorePath
+dummy = do
+  addToStore
+    (forceRight $ System.Nix.StorePath.mkStorePathName "dummy")
+    (System.Nix.Nar.dumpPath "dummy")
+    FileIngestionMethod_Flat
+    (Some HashAlgo_SHA256)
+    RepairMode_DontRepair
+
+invalidPath :: StorePath
+invalidPath =
+  let name = forceRight $ System.Nix.StorePath.mkStorePathName "invalid"
+  in System.Nix.StorePath.unsafeMakeStorePath
+      (System.Nix.StorePath.mkStorePathHashPart
+        @SHA256
+        "invalid")
+      name
+
+_withBuilder
+  :: MonadRemoteStore m
+  => (StorePath -> m a)
+  -> m a
+_withBuilder action = do
+  path <-
+    addTextToStore
+      (StoreText (forceRight $ System.Nix.StorePath.mkStorePathName "builder") builderSh)
+      mempty
+      RepairMode_DontRepair
+  action path
+
+builderSh :: Text
+builderSh = "declare -xpexport > $out"
+
+spec :: Spec
+spec = around withNixDaemon $
+
+  describe "store" $ do
+
+    context "syncWithGC" $
+      itRights "syncs with garbage collector" syncWithGC
+
+    context "verifyStore" $ do
+      itRights "check=False repair=False" $
+        verifyStore
+          CheckMode_DontCheck
+          RepairMode_DontRepair
+        `shouldReturn` False
+
+      itRights "check=True repair=False" $
+        verifyStore
+          CheckMode_DoCheck
+          RepairMode_DontRepair
+        `shouldReturn` False
+
+      --privileged
+      itRights "check=True repair=True" $
+        verifyStore
+          CheckMode_DoCheck
+          RepairMode_DoRepair
+        `shouldReturn` False
+
+    context "addTextToStore" $
+      itRights "adds text to store" $ withPath pure
+
+    context "isValidPath" $ do
+      itRights "validates path" $ withPath $ \path -> do
+        liftIO $ print path
+        isValidPath path `shouldReturn` True
+      itLefts "fails on invalid path"
+        $ System.Nix.Store.Remote.MonadStore.mapStoreConfig
+            (\sc -> sc { storeConfig_dir = StoreDir "/asdf" })
+            $ isValidPath invalidPath
+
+    context "queryAllValidPaths" $ do
+      itRights "empty query" queryAllValidPaths
+      itRights "non-empty query" $ withPath $ \path ->
+        queryAllValidPaths `shouldReturn` Data.HashSet.fromList [path]
+
+    context "queryPathInfo" $
+      itRights "queries path info" $ withPath $ \path -> do
+        meta <- queryPathInfo path
+        (metadataReferences <$> meta) `shouldBe` (Just mempty)
+
+    context "ensurePath" $
+      itRights "simple ensure" $ withPath ensurePath
+
+    context "addTempRoot" $
+      itRights "simple addition" $ withPath addTempRoot
+
+    context "addIndirectRoot" $
+      itRights "simple addition" $ withPath addIndirectRoot
+
+    let toDerivedPathSet p = Data.Set.fromList [DerivedPath_Opaque p]
+
+    context "buildPaths" $ do
+      itRights "build Normal" $ withPath $ \path -> do
+        buildPaths (toDerivedPathSet path) BuildMode_Normal
+
+      itRights "build Check" $ withPath $ \path -> do
+        buildPaths (toDerivedPathSet path) BuildMode_Check
+
+      itLefts "build Repair" $ withPath $ \path -> do
+        buildPaths (toDerivedPathSet path) BuildMode_Repair
+
+    context "roots" $ context "findRoots" $ do
+        itRights "empty roots" (findRoots `shouldReturn` mempty)
+
+        itRights "path added as a temp root" $ withPath $ \_ -> do
+          roots <- findRoots
+          roots `shouldSatisfy` ((== 1) . Data.Map.size)
+
+    context "optimiseStore" $ itRights "optimises" optimiseStore
+
+    context "queryMissing" $
+      itRights "queries" $ withPath $ \path -> do
+        queryMissing (toDerivedPathSet path)
+        `shouldReturn`
+        Missing
+          { missingWillBuild = mempty
+          , missingWillSubstitute = mempty
+          , missingUnknownPaths = mempty
+          , missingDownloadSize = 0
+          , missingNarSize = 0
+          }
+
+    context "addToStore" $
+      itRights "adds file to store" $ do
+        fp <-
+          liftIO
+          $ System.IO.Temp.writeSystemTempFile
+              "addition"
+              "yolo"
+
+        addToStore
+          (forceRight $ System.Nix.StorePath.mkStorePathName "tmp-addition")
+          (System.Nix.Nar.dumpPath fp)
+          FileIngestionMethod_Flat
+          (Some HashAlgo_SHA256)
+          RepairMode_DontRepair
+
+    context "with dummy" $ do
+      itRights "adds dummy" dummy
+
+      itRights "valid dummy" $ do
+        path <- dummy
+        isValidPath path `shouldReturn` True
+
+    context "collectGarbage" $ do
+      itRights "delete a specific path from the store" $ withPath $ \path -> do
+          -- clear temp gc roots so the delete works. restarting the nix daemon should also do this...
+          storeDir <- getStoreDir
+          let tempRootsDir = Data.Text.unpack $ mconcat [ Data.Text.Encoding.decodeUtf8 (unStoreDir storeDir), "/../var/nix/temproots/" ]
+          tempRootList <-
+            liftIO
+            $ System.Directory.listDirectory
+                tempRootsDir
+          liftIO $ forM_ tempRootList $ \entry -> do
+            System.Directory.removeFile
+              $ mconcat [ tempRootsDir, "/", entry ]
+
+          GCResult{..} <-
+            collectGarbage
+              GCOptions
+                { gcOptionsOperation = GCAction_DeleteSpecific
+                , gcOptionsIgnoreLiveness = False
+                , gcOptionsPathsToDelete = Data.HashSet.fromList [path]
+                , gcOptionsMaxFreed = maxBound
+                }
+          gcResultDeletedPaths `shouldBe` Data.HashSet.fromList [path]
+          gcResultBytesFreed `shouldBe` 4

hnix-store-remote/tests-io/Spec.hs

@@ -1 +0,0 @@
-{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --generated-module=Spec #-}

hnix-store-remote/tests/EnumSpec.hs

@@ -0,0 +1,136 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module EnumSpec (spec) where
+
+import Test.Hspec (SpecWith, Spec, describe, it, shouldBe)
+
+import Data.ByteString (ByteString)
+import Data.Word (Word64)
+import System.Nix.Build (BuildMode(..), BuildStatus(..))
+import System.Nix.Store.Remote.Serializer 
+  ( activity
+  , activityResult
+  , enum
+  , int
+  , loggerOpCode
+  , runP
+  , LoggerSError
+  , NixSerializer
+  , SError
+  )
+import System.Nix.Store.Remote.Types
+
+spec :: Spec
+spec = do
+  let
+    itE
+      :: ( Enum a
+         , Show a
+         )
+      => String
+      -> a
+      -> Word64
+      -> SpecWith ()
+    itE name constr value =
+      it name
+        $ ((runP enum () constr) :: Either SError ByteString)
+          `shouldBe`
+          (runP (int @Word64) () value)
+
+    itE'
+      :: Show a
+      => NixSerializer () LoggerSError a
+      -> String
+      -> a
+      -> Word64
+      -> SpecWith ()
+    itE' s name constr value =
+      it name
+        $ ((runP s () constr) :: Either LoggerSError ByteString)
+          `shouldBe`
+          (runP (int @Word64) () (value))
+
+  describe "Enums" $ do
+    describe "BuildMode enum order matches Nix" $ do
+      itE "Normal" BuildMode_Normal 0
+      itE "Repair" BuildMode_Repair 1
+      itE "Check"  BuildMode_Check  2
+
+    describe "BuildStatus enum order matches Nix" $ do
+      itE "Built"                  BuildStatus_Built                   0
+      itE "Substituted"            BuildStatus_Substituted             1
+      itE "AlreadyValid"           BuildStatus_AlreadyValid            2
+      itE "PermanentFailure"       BuildStatus_PermanentFailure        3
+      itE "InputRejected"          BuildStatus_InputRejected           4
+      itE "OutputRejected"         BuildStatus_OutputRejected          5
+      itE "TransientFailure"       BuildStatus_TransientFailure        6
+      itE "CachedFailure"          BuildStatus_CachedFailure           7
+      itE "TimedOut"               BuildStatus_TimedOut                8
+      itE "MiscFailure"            BuildStatus_MiscFailure             9
+      itE "DependencyFailed"       BuildStatus_DependencyFailed       10
+      itE "LogLimitExceeded"       BuildStatus_LogLimitExceeded       11
+      itE "NotDeterministic"       BuildStatus_NotDeterministic       12
+      itE "ResolvesToAlreadyValid" BuildStatus_ResolvesToAlreadyValid 13
+      itE "NoSubstituters"         BuildStatus_NoSubstituters         14
+
+    describe "GCAction enum order matches Nix" $ do
+      itE "ReturnLive"     GCAction_ReturnLive     0
+      itE "ReturnDead"     GCAction_ReturnDead     1
+      itE "DeleteDead"     GCAction_DeleteDead     2
+      itE "DeleteSpecific" GCAction_DeleteSpecific 3
+
+    describe "Logger" $ do
+      let itA = itE' activity
+      describe "Activity enum order matches Nix" $ do
+        itA "CopyPath"      Activity_CopyPath      100
+        itA "FileTransfer"  Activity_FileTransfer  101
+        itA "Realise"       Activity_Realise       102
+        itA "CopyPaths"     Activity_CopyPaths     103
+        itA "Builds"        Activity_Builds        104
+        itA "Build"         Activity_Build         105
+        itA "OptimiseStore" Activity_OptimiseStore 106
+        itA "VerifyPaths"   Activity_VerifyPaths   107
+        itA "Substitute"    Activity_Substitute    108
+        itA "QueryPathInfo" Activity_QueryPathInfo 109
+        itA "PostBuildHook" Activity_PostBuildHook 110
+        itA "BuildWaiting"  Activity_BuildWaiting  111
+
+      let itR = itE' activityResult
+      describe "ActivityResult enum order matches Nix" $ do
+        itR "FileLinked"       ActivityResult_FileLinked       100
+        itR "BuildLogLine"     ActivityResult_BuildLogLine     101
+        itR "UnstrustedPath"   ActivityResult_UnstrustedPath   102
+        itR "CorruptedPath"    ActivityResult_CorruptedPath    103
+        itR "SetPhase"         ActivityResult_SetPhase         104
+        itR "Progress"         ActivityResult_Progress         105
+        itR "SetExpected"      ActivityResult_SetExpected      106
+        itR "PostBuildLogLine" ActivityResult_PostBuildLogLine 107
+
+
+      let itL = itE' loggerOpCode
+      describe "LoggerOpCode matches Nix" $ do
+        itL "Next"          LoggerOpCode_Next          0x6f6c6d67
+        itL "Read"          LoggerOpCode_Read          0x64617461
+        itL "Write"         LoggerOpCode_Write         0x64617416
+        itL "Last"          LoggerOpCode_Last          0x616c7473
+        itL "Error"         LoggerOpCode_Error         0x63787470
+        itL "StartActivity" LoggerOpCode_StartActivity 0x53545254
+        itL "StopActivity"  LoggerOpCode_StopActivity  0x53544f50
+        itL "Result"        LoggerOpCode_Result        0x52534c54
+
+      describe "Verbosity enum order matches Nix" $ do
+        itE "Error"     Verbosity_Error     0
+        itE "Warn"      Verbosity_Warn      1
+        itE "Notice"    Verbosity_Notice    2
+        itE "Info"      Verbosity_Info      3
+        itE "Talkative" Verbosity_Talkative 4
+        itE "Chatty"    Verbosity_Chatty    5
+        itE "Debug"     Verbosity_Debug     6
+        itE "Vomit"     Verbosity_Vomit     7
+
+      describe "WorkerOp enum order matches Nix" $ do
+        itE "IsValidPath"           WorkerOp_IsValidPath            1
+        itE "BuildPathsWithResults" WorkerOp_BuildPathsWithResults 46
+
+
+

hnix-store-remote/tests/NixSerializerSpec.hs

@@ -3,27 +3,22 @@
 module NixSerializerSpec (spec) where
 
 import Crypto.Hash (MD5, SHA1, SHA256, SHA512)
-import Data.Dependent.Sum (DSum((:=>)))
-import Data.Fixed (Uni)
-import Data.Time (NominalDiffTime)
+import Data.Some (Some(Some))
+import Data.Time (UTCTime)
 import Test.Hspec (Expectation, Spec, describe, parallel, shouldBe)
 import Test.Hspec.QuickCheck (prop)
 import Test.QuickCheck (Gen, arbitrary, forAll, suchThat)
-import Test.QuickCheck.Instances ()
-
-import qualified Data.Time.Clock.POSIX
-import qualified Data.Serializer
-import qualified System.Nix.Build
-import qualified System.Nix.Hash
 
 import System.Nix.Arbitrary ()
-import System.Nix.Build (BuildResult)
 import System.Nix.Derivation (Derivation(inputDrvs))
+import System.Nix.Build (BuildResult(..))
 import System.Nix.StorePath (StoreDir)
-import System.Nix.StorePath.Metadata (Metadata(..))
 import System.Nix.Store.Remote.Arbitrary ()
 import System.Nix.Store.Remote.Serializer
-import System.Nix.Store.Remote.Types (ErrorInfo(..), Logger(..), ProtoVersion(..), Trace(..))
+import System.Nix.Store.Remote.Types.Logger (Logger(..))
+import System.Nix.Store.Remote.Types.ProtoVersion (HasProtoVersion(..), ProtoVersion(..))
+import System.Nix.Store.Remote.Types.StoreConfig (TestStoreConfig(..))
+import System.Nix.Store.Remote.Types.StoreRequest (StoreRequest(..))
 
 -- | Test for roundtrip using @NixSerializer@
 roundtripSReader
@@ -60,22 +55,8 @@ spec = parallel $ do
     prop "Bool" $ roundtripS bool
     prop "ByteString" $ roundtripS byteString
     prop "Text" $ roundtripS text
-    prop "Maybe Text"
-      $ forAll (arbitrary `suchThat` (/= Just ""))
-      $ roundtripS maybeText
-    prop "UTCTime" $ do
-      let
-        -- scale to seconds and back
-        toSeconds :: Int -> NominalDiffTime
-        toSeconds n = realToFrac (toEnum n :: Uni)
-        fromSeconds :: NominalDiffTime -> Int
-        fromSeconds = (fromEnum :: Uni -> Int) . realToFrac
-
-      roundtripS @Int @() $
-        Data.Serializer.mapIsoSerializer
-          (fromSeconds . Data.Time.Clock.POSIX.utcTimeToPOSIXSeconds)
-          (Data.Time.Clock.POSIX.posixSecondsToUTCTime . toSeconds)
-          time
+    prop "Maybe Text" $ roundtripS maybeText
+    prop "UTCTime" $ roundtripS @UTCTime @() time
 
   describe "Combinators" $ do
     prop "list" $ roundtripS @[Int] @() (list int)
@@ -84,14 +65,33 @@ spec = parallel $ do
     prop "mapS" $ roundtripS (mapS (int @Int) byteString)
 
   describe "Complex" $ do
-    prop "BuildResult"
-      $ forAll (arbitrary `suchThat` ((/= Just "") . System.Nix.Build.errorMessage))
-      $ \br ->
-          roundtripS @BuildResult buildResult
-            -- fix time to 0 as we test UTCTime above
-            $ br { System.Nix.Build.startTime = Data.Time.Clock.POSIX.posixSecondsToUTCTime 0
-                 , System.Nix.Build.stopTime  = Data.Time.Clock.POSIX.posixSecondsToUTCTime 0
-                 }
+    prop "DSum HashAlgo Digest" $ roundtripS namedDigest
+
+    describe "BuildResult" $ do
+      prop "< 1.28"
+        $ \sd -> forAll (arbitrary `suchThat` ((< 28) . protoVersion_minor))
+        $ \pv ->
+            roundtripSReader @TestStoreConfig buildResult (TestStoreConfig sd pv)
+            . (\x -> x { buildResultBuiltOutputs = Nothing })
+            . (\x -> x { buildResultTimesBuilt = Nothing
+                       , buildResultIsNonDeterministic = Nothing
+                       , buildResultStartTime = Nothing
+                       , buildResultStopTime = Nothing
+                       }
+              )
+      prop "= 1.28"
+        $ \sd ->
+            roundtripSReader @TestStoreConfig buildResult (TestStoreConfig sd (ProtoVersion 1 28))
+            . (\x -> x { buildResultTimesBuilt = Nothing
+                       , buildResultIsNonDeterministic = Nothing
+                       , buildResultStartTime = Nothing
+                       , buildResultStopTime = Nothing
+                       }
+              )
+      prop "> 1.28"
+        $ \sd -> forAll (arbitrary `suchThat` ((> 28) . protoVersion_minor))
+        $ \pv ->
+            roundtripSReader @TestStoreConfig buildResult (TestStoreConfig sd pv)
 
     prop "StorePath" $
       roundtripSReader @StoreDir storePath
@@ -102,17 +102,8 @@ spec = parallel $ do
     prop "StorePathName" $
       roundtripS storePathName
 
-    let narHashIsSHA256 Metadata{..} =
-          case narHash of
-            (System.Nix.Hash.HashAlgo_SHA256 :=> _) -> True
-            _ -> False
-
-    prop "Metadata (StorePath)"
-      $ \sd -> forAll (arbitrary `suchThat` (\m -> narHashIsSHA256 m && narBytes m /= Just 0))
-      $ roundtripSReader @StoreDir pathMetadata sd
-        . (\m -> m
-            { registrationTime = Data.Time.Clock.POSIX.posixSecondsToUTCTime 0
-            })
+    prop "Metadata (StorePath)" $
+      roundtripSReader @StoreDir pathMetadata
 
     prop "Some HashAlgo" $
       roundtripS someHashAlgo
@@ -134,19 +125,9 @@ spec = parallel $ do
       prop "Maybe Activity" $ roundtripS maybeActivity
       prop "ActivityResult" $ roundtripS activityResult
       prop "Field" $ roundtripS field
-      prop "Trace"
-        $ forAll (arbitrary `suchThat` ((/= Just 0) . tracePosition))
-        $ roundtripS trace
+      prop "Trace" $ roundtripS trace
       prop "BasicError" $ roundtripS basicError
-      prop "ErrorInfo"
-        $ forAll (arbitrary
-                  `suchThat`
-                    (\ErrorInfo{..}
-                        -> errorInfoPosition /= Just 0
-                           && all ((/= Just 0) . tracePosition) errorInfoTraces
-                    )
-                 )
-        $ roundtripS errorInfo
+      prop "ErrorInfo" $ roundtripS errorInfo
       prop "LoggerOpCode" $ roundtripS loggerOpCode
       prop "Verbosity" $ roundtripS verbosity
       prop "Logger"
@@ -154,11 +135,35 @@ spec = parallel $ do
         $ \pv ->
             forAll (arbitrary `suchThat` errorInfoIf (protoVersion_minor pv >= 26))
         $ roundtripSReader logger pv
-        where
-          errorInfoIf True (Logger_Error (Right x)) = noJust0s x
-          errorInfoIf False (Logger_Error (Left _)) = True
-          errorInfoIf _ (Logger_Error _) = False
-          errorInfoIf _ _ = True
-          noJust0s ErrorInfo{..} =
-            errorInfoPosition /= Just 0
-            && all ((/= Just 0) . tracePosition) errorInfoTraces
+
+  describe "Handshake" $ do
+    prop "WorkerMagic" $ roundtripS workerMagic
+    prop "TrustedFlag" $ roundtripS trustedFlag
+
+  describe "Worker protocol" $ do
+    prop "WorkerOp" $ roundtripS workerOp
+    prop "StoreText" $ roundtripS storeText
+
+    prop "StoreRequest"
+      $ \testStoreConfig ->
+          forAll (arbitrary `suchThat` (restrictProtoVersion (hasProtoVersion testStoreConfig)))
+          $ roundtripSReader @TestStoreConfig storeRequest testStoreConfig
+
+  describe "StoreReply" $ do
+    prop "()" $ roundtripS opSuccess
+    prop "GCResult" $ roundtripSReader @StoreDir gcResult
+    prop "GCRoot" $ roundtripS gcRoot
+    prop "Missing" $ roundtripSReader @StoreDir missing
+    prop "Maybe (Metadata StorePath)" $ roundtripSReader @StoreDir maybePathMetadata
+
+restrictProtoVersion :: ProtoVersion -> Some StoreRequest -> Bool
+restrictProtoVersion v (Some (BuildPaths _ _)) | v < ProtoVersion 1 30 = False
+restrictProtoVersion _ (Some (BuildDerivation _ drv _)) = inputDrvs drv == mempty
+restrictProtoVersion v (Some (QueryMissing _)) | v < ProtoVersion 1 30 = False
+restrictProtoVersion _ _ = True
+
+errorInfoIf :: Bool -> Logger -> Bool
+errorInfoIf True  (Logger_Error (Right _)) = True
+errorInfoIf False (Logger_Error (Left _))  = True
+errorInfoIf _     (Logger_Error _)         = False
+errorInfoIf _     _                        = True

hnix-store-remote/tests/SerializeSpec.hs

@@ -1,208 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module SerializeSpec (spec) where
-
-import Data.Fixed (Uni)
-import Data.Serialize (Serialize(..))
-import Data.Serialize.Get (Get, runGet)
-import Data.Serialize.Put (Putter, runPut)
-import Data.Text (Text)
-import Data.Time (NominalDiffTime)
-import Test.Hspec (Expectation, Spec, describe, it, parallel, shouldBe)
-import Test.Hspec.QuickCheck (prop)
-import Test.Hspec.Nix (roundtrips)
-import Test.QuickCheck (arbitrary, forAll, suchThat)
-import Test.QuickCheck.Instances ()
-
-import qualified Data.Either
-import qualified Data.HashSet
-import qualified Data.Time.Clock.POSIX
-import qualified System.Nix.Build
-
-import System.Nix.Arbitrary ()
-import System.Nix.Build (BuildMode(..), BuildStatus(..))
-import System.Nix.Derivation (Derivation(inputDrvs))
-import System.Nix.Store.Remote.Arbitrary ()
-import System.Nix.Store.Remote.Serialize (getDerivation, putDerivation)
-import System.Nix.Store.Remote.Serialize.Prim
-import System.Nix.Store.Remote.Types
-
--- | Test for roundtrip using @Putter@ and @Get@ functions
-roundtrips2
-  :: ( Eq a
-     , Show a
-     )
-  => Putter a
-  -> Get a
-  -> a
-  -> Expectation
-roundtrips2 putter getter =
-  roundtrips
-    (runPut . putter)
-    (runGet getter)
-
--- | Test for roundtrip using @Serialize@ instance
-roundtripS
-  :: ( Eq a
-     , Serialize a
-     , Show a
-     )
-  => a
-  -> Expectation
-roundtripS =
-  roundtrips
-    (runPut . put)
-    (runGet get)
-
-spec :: Spec
-spec = parallel $ do
-  describe "Prim" $ do
-    prop "Int" $ roundtrips2 putInt (getInt @Int)
-    prop "Bool" $ roundtrips2 putBool getBool
-    prop "ByteString" $ roundtrips2 putByteString getByteString
-
-    prop "UTCTime" $ do
-      let
-        -- scale to seconds and back
-        toSeconds :: Int -> NominalDiffTime
-        toSeconds n = realToFrac (toEnum n :: Uni)
-        fromSeconds :: NominalDiffTime -> Int
-        fromSeconds = (fromEnum :: Uni -> Int) . realToFrac
-
-      roundtrips2
-        (putTime . Data.Time.Clock.POSIX.posixSecondsToUTCTime . toSeconds)
-        (fromSeconds . Data.Time.Clock.POSIX.utcTimeToPOSIXSeconds <$> getTime)
-
-  describe "Combinators" $ do
-    prop "Many" $ roundtrips2 (putMany putInt) (getMany (getInt @Int))
-    prop "[ByteString]" $ roundtrips2 putByteStrings getByteStrings
-    prop "Text" $ roundtrips2 putText getText
-    prop "[Text]" $ roundtrips2 putTexts getTexts
-
-    prop "StorePath" $ \sd ->
-      roundtrips2
-        (putPath sd)
-        (Data.Either.fromRight undefined <$> getPath sd)
-
-    prop "HashSet StorePath" $ \sd ->
-      roundtrips2
-        (putPaths sd)
-        (Data.HashSet.map (Data.Either.fromRight undefined) <$> getPaths sd)
-
-  describe "Serialize instances" $ do
-    prop "Text" $ roundtripS @Text
-    prop "BuildMode" $ roundtripS @BuildMode
-    prop "BuildStatus" $ roundtripS @BuildStatus
-    it "BuildResult" $
-      forAll (arbitrary `suchThat` ((/= Just "") . System.Nix.Build.errorMessage))
-      $ \br ->
-          roundtripS
-            -- fix time to 0 as we test UTCTime above
-            $ br { System.Nix.Build.startTime = Data.Time.Clock.POSIX.posixSecondsToUTCTime 0
-                 , System.Nix.Build.stopTime  = Data.Time.Clock.POSIX.posixSecondsToUTCTime 0
-                 }
-
-    prop "ProtoVersion" $ roundtripS @ProtoVersion
-
-    prop "Derivation StorePath Text" $ \sd ->
-      roundtrips2
-        (putDerivation sd)
-        (getDerivation sd)
-        -- inputDrvs is not used in remote protocol serialization
-        . (\drv -> drv { inputDrvs = mempty })
-
-    describe "Logger" $ do
-      prop "Activity" $ roundtripS @Activity
-      prop "ActivityID" $ roundtripS @ActivityID
-      prop "Activity" $ roundtripS @Activity
-      prop "Field" $ roundtripS @Field
-      prop "Trace"
-        $ forAll (arbitrary `suchThat` ((/= Just 0) . tracePosition))
-        $ roundtripS @Trace
-      prop "BasicError" $ roundtripS @BasicError
-      prop "ErrorInfo"
-        $ forAll (arbitrary
-                  `suchThat`
-                    (\ErrorInfo{..}
-                        -> errorInfoPosition /= Just 0
-                           && all ((/= Just 0) . tracePosition) errorInfoTraces
-                    )
-                 )
-        $ roundtripS @ErrorInfo
-      prop "LoggerOpCode" $ roundtripS @LoggerOpCode
-      prop "Verbosity" $ roundtripS @Verbosity
-
-  describe "Enums" $ do
-    let it' name constr value = it name $ runPut (put constr) `shouldBe` runPut (putInt @Int value)
-    describe "BuildMode enum order matches Nix" $ do
-      it' "Normal" BuildMode_Normal 0
-      it' "Repair" BuildMode_Repair 1
-      it' "Check"  BuildMode_Check  2
-
-    describe "BuildStatus enum order matches Nix" $ do
-      it' "Built"                  BuildStatus_Built                   0
-      it' "Substituted"            BuildStatus_Substituted             1
-      it' "AlreadyValid"           BuildStatus_AlreadyValid            2
-      it' "PermanentFailure"       BuildStatus_PermanentFailure        3
-      it' "InputRejected"          BuildStatus_InputRejected           4
-      it' "OutputRejected"         BuildStatus_OutputRejected          5
-      it' "TransientFailure"       BuildStatus_TransientFailure        6
-      it' "CachedFailure"          BuildStatus_CachedFailure           7
-      it' "TimedOut"               BuildStatus_TimedOut                8
-      it' "MiscFailure"            BuildStatus_MiscFailure             9
-      it' "DependencyFailed"       BuildStatus_DependencyFailed       10
-      it' "LogLimitExceeded"       BuildStatus_LogLimitExceeded       11
-      it' "NotDeterministic"       BuildStatus_NotDeterministic       12
-      it' "ResolvesToAlreadyValid" BuildStatus_ResolvesToAlreadyValid 13
-      it' "NoSubstituters"         BuildStatus_NoSubstituters         14
-
-    describe "GCAction enum order matches Nix" $ do
-      it' "ReturnLive"     GCAction_ReturnLive     0
-      it' "ReturnDead"     GCAction_ReturnDead     1
-      it' "DeleteDead"     GCAction_DeleteDead     2
-      it' "DeleteSpecific" GCAction_DeleteSpecific 3
-
-    describe "Logger" $ do
-      describe "Activity enum order matches Nix" $ do
-        it' "CopyPath"      Activity_CopyPath      100
-        it' "FileTransfer"  Activity_FileTransfer  101
-        it' "Realise"       Activity_Realise       102
-        it' "CopyPaths"     Activity_CopyPaths     103
-        it' "Builds"        Activity_Builds        104
-        it' "Build"         Activity_Build         105
-        it' "OptimiseStore" Activity_OptimiseStore 106
-        it' "VerifyPaths"   Activity_VerifyPaths   107
-        it' "Substitute"    Activity_Substitute    108
-        it' "QueryPathInfo" Activity_QueryPathInfo 109
-        it' "PostBuildHook" Activity_PostBuildHook 110
-        it' "BuildWaiting"  Activity_BuildWaiting  111
-
-      describe "ActivityResult enum order matches Nix" $ do
-        it' "FileLinked"       ActivityResult_FileLinked       100
-        it' "BuildLogLine"     ActivityResult_BuildLogLine     101
-        it' "UnstrustedPath"   ActivityResult_UnstrustedPath   102
-        it' "CorruptedPath"    ActivityResult_CorruptedPath    103
-        it' "SetPhase"         ActivityResult_SetPhase         104
-        it' "Progress"         ActivityResult_Progress         105
-        it' "SetExpected"      ActivityResult_SetExpected      106
-        it' "PostBuildLogLine" ActivityResult_PostBuildLogLine 107
-
-      describe "LoggerOpCode matches Nix" $ do
-        it' "Next"          LoggerOpCode_Next          0x6f6c6d67
-        it' "Read"          LoggerOpCode_Read          0x64617461
-        it' "Write"         LoggerOpCode_Write         0x64617416
-        it' "Last"          LoggerOpCode_Last          0x616c7473
-        it' "Error"         LoggerOpCode_Error         0x63787470
-        it' "StartActivity" LoggerOpCode_StartActivity 0x53545254
-        it' "StopActivity"  LoggerOpCode_StopActivity  0x53544f50
-        it' "Result"        LoggerOpCode_Result        0x52534c54
-
-      describe "Verbosity enum order matches Nix" $ do
-        it' "Error"     Verbosity_Error     0
-        it' "Warn"      Verbosity_Warn      1
-        it' "Notice"    Verbosity_Notice    2
-        it' "Info"      Verbosity_Info      3
-        it' "Talkative" Verbosity_Talkative 4
-        it' "Chatty"    Verbosity_Chatty    5
-        it' "Debug"     Verbosity_Debug     6
-        it' "Vomit"     Verbosity_Vomit     7

hnix-store-tests/hnix-store-tests.cabal

@@ -35,29 +35,40 @@ common commons
 library
   import: commons
   exposed-modules:
-      System.Nix.Arbitrary
+      Data.ByteString.Arbitrary
+    , Data.HashSet.Arbitrary
+    , Data.Text.Arbitrary
+    , Data.Vector.Arbitrary
+    , System.Nix.Arbitrary
     , System.Nix.Arbitrary.Base
     , System.Nix.Arbitrary.Build
     , System.Nix.Arbitrary.ContentAddress
     , System.Nix.Arbitrary.Derivation
     , System.Nix.Arbitrary.DerivedPath
     , System.Nix.Arbitrary.Hash
+    , System.Nix.Arbitrary.OutputName
+    , System.Nix.Arbitrary.Realisation
     , System.Nix.Arbitrary.Signature
     , System.Nix.Arbitrary.Store.Types
     , System.Nix.Arbitrary.StorePath
     , System.Nix.Arbitrary.StorePath.Metadata
+    , System.Nix.Arbitrary.UTCTime
     , Test.Hspec.Nix
   build-depends:
       base >=4.12 && <5
     , hnix-store-core >= 0.8
     , bytestring
+    , containers
     , crypton
     , dependent-sum > 0.7
     , generic-arbitrary < 1.1
+    , hashable
     , hspec
     , QuickCheck
-    , quickcheck-instances
     , text
+    , time
+    , unordered-containers
+    , vector
   hs-source-dirs:      src
 
 test-suite props
@@ -69,6 +80,7 @@ test-suite props
       ContentAddressSpec
       DerivationSpec
       DerivedPathSpec
+      RealisationSpec
       StorePathSpec
       SignatureSpec
   hs-source-dirs:
@@ -80,8 +92,5 @@ test-suite props
     , hnix-store-core
     , hnix-store-tests
     , attoparsec
-    , containers
-    , data-default-class
-    , QuickCheck
     , text
     , hspec

hnix-store-tests/src/Data/ByteString/Arbitrary.hs

@@ -0,0 +1,10 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Data.ByteString.Arbitrary () where
+
+import Data.ByteString (ByteString)
+import Test.QuickCheck (Arbitrary(..))
+import qualified Data.ByteString.Char8
+
+instance Arbitrary ByteString where
+  arbitrary = Data.ByteString.Char8.pack <$> arbitrary
+  shrink xs = Data.ByteString.Char8.pack <$> shrink (Data.ByteString.Char8.unpack xs)

hnix-store-tests/src/Data/HashSet/Arbitrary.hs

@@ -0,0 +1,11 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Data.HashSet.Arbitrary where
+
+import Data.Hashable (Hashable)
+import Data.HashSet (HashSet)
+import Test.QuickCheck (Arbitrary(..))
+import qualified Data.HashSet
+
+instance (Hashable a, Eq a, Arbitrary a) => Arbitrary (HashSet a) where
+  arbitrary = Data.HashSet.fromList <$> arbitrary
+  shrink hashset = Data.HashSet.fromList <$> shrink (Data.HashSet.toList hashset)

hnix-store-tests/src/Data/Text/Arbitrary.hs

@@ -0,0 +1,16 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Data.Text.Arbitrary () where
+
+import Data.Text (Text)
+import Test.QuickCheck (Arbitrary(..), frequency, suchThat)
+import qualified Data.Text
+
+instance Arbitrary Text where
+  arbitrary = Data.Text.pack <$> arbitrary
+  shrink xs = Data.Text.pack <$> shrink (Data.Text.unpack xs)
+
+instance {-# OVERLAPPING #-} Arbitrary (Maybe Text) where
+  arbitrary = frequency
+    [ (1, pure Nothing)
+    , (3, Just <$> arbitrary `suchThat` (/= mempty))
+    ]

hnix-store-tests/src/Data/Vector/Arbitrary.hs

@@ -0,0 +1,20 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+-- Stolen from quickcheck-instances (BSD-3)
+module Data.Vector.Arbitrary () where
+
+import Data.Vector (Vector)
+import Test.QuickCheck (Arbitrary(..), Arbitrary1(..), arbitrary1, shrink1)
+import qualified Data.Vector
+
+instance Arbitrary1 Vector where
+  liftArbitrary =
+    fmap Data.Vector.fromList
+    . liftArbitrary
+  liftShrink shr =
+    fmap Data.Vector.fromList
+    . liftShrink shr
+    . Data.Vector.toList
+
+instance Arbitrary a => Arbitrary (Vector a) where
+  arbitrary = arbitrary1
+  shrink = shrink1

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

@@ -1,11 +1,18 @@
 module System.Nix.Arbitrary where
 
+import Data.ByteString.Arbitrary ()
+import Data.HashSet.Arbitrary ()
+import Data.Text.Arbitrary ()
+import Data.Vector.Arbitrary ()
+
 import System.Nix.Arbitrary.Base ()
 import System.Nix.Arbitrary.Build ()
 import System.Nix.Arbitrary.ContentAddress ()
 import System.Nix.Arbitrary.Derivation ()
 import System.Nix.Arbitrary.DerivedPath ()
 import System.Nix.Arbitrary.Hash ()
+import System.Nix.Arbitrary.OutputName ()
+import System.Nix.Arbitrary.Realisation ()
 import System.Nix.Arbitrary.Signature ()
 import System.Nix.Arbitrary.Store.Types ()
 import System.Nix.Arbitrary.StorePath ()

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

@@ -7,7 +7,6 @@ import System.Nix.Base
 
 import Test.QuickCheck (Arbitrary(..))
 import Test.QuickCheck.Arbitrary.Generic (GenericArbitrary(..))
-import Test.QuickCheck.Instances ()
 
 deriving via GenericArbitrary BaseEncoding
   instance Arbitrary BaseEncoding

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

@@ -3,11 +3,17 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
 module System.Nix.Arbitrary.Build where
 
+import Data.Time (UTCTime)
+import Data.Text.Arbitrary ()
+import Test.QuickCheck (Arbitrary(..), scale, suchThat)
+import Test.QuickCheck.Arbitrary.Generic (GenericArbitrary(..))
+import System.Nix.Arbitrary.OutputName ()
+import System.Nix.Arbitrary.Realisation ()
+import System.Nix.Arbitrary.UTCTime ()
+
 import System.Nix.Build
 
-import Test.QuickCheck (Arbitrary(..))
-import Test.QuickCheck.Arbitrary.Generic (GenericArbitrary(..))
-import Test.QuickCheck.Instances ()
+import qualified Data.Time.Clock.POSIX
 
 deriving via GenericArbitrary BuildMode
   instance Arbitrary BuildMode
@@ -15,5 +21,17 @@ deriving via GenericArbitrary BuildMode
 deriving via GenericArbitrary BuildStatus
   instance Arbitrary BuildStatus
 
-deriving via GenericArbitrary BuildResult
-  instance Arbitrary BuildResult
+instance Arbitrary BuildResult where
+  arbitrary = do
+    buildResultStatus <- arbitrary
+    buildResultErrorMessage <- arbitrary
+    buildResultTimesBuilt <- arbitrary `suchThat` (/= Just 0)
+    buildResultIsNonDeterministic <- arbitrary  `suchThat` (/= Nothing)
+    buildResultStartTime <- arbitrary `suchThat` (/= Just t0)
+    buildResultStopTime <- arbitrary `suchThat` (/= Just t0)
+    buildResultBuiltOutputs <- scale (`div` 10) (arbitrary `suchThat` (/= Nothing))
+
+    pure BuildResult{..}
+    where
+      t0 :: UTCTime
+      t0 = Data.Time.Clock.POSIX.posixSecondsToUTCTime 0

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

@@ -4,12 +4,13 @@
 module System.Nix.Arbitrary.Derivation where
 
 import Data.Text (Text)
+import Data.Text.Arbitrary ()
+import Data.Vector.Arbitrary ()
 import System.Nix.Derivation
 import System.Nix.StorePath (StorePath)
 
 import Test.QuickCheck (Arbitrary(..))
 import Test.QuickCheck.Arbitrary.Generic (GenericArbitrary(..))
-import Test.QuickCheck.Instances ()
 import System.Nix.Arbitrary.StorePath ()
 
 deriving via GenericArbitrary (Derivation StorePath Text)

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

@@ -3,13 +3,20 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
 module System.Nix.Arbitrary.DerivedPath where
 
-import Test.QuickCheck (Arbitrary)
+import qualified Data.Set
+import Test.QuickCheck (Arbitrary(..), oneof)
 import Test.QuickCheck.Arbitrary.Generic (GenericArbitrary(..))
+import System.Nix.Arbitrary.OutputName ()
 import System.Nix.Arbitrary.StorePath ()
-import System.Nix.DerivedPath (DerivedPath, OutputsSpec)
+import System.Nix.DerivedPath (DerivedPath, OutputsSpec(..))
 
-deriving via GenericArbitrary OutputsSpec
-  instance Arbitrary OutputsSpec
+instance Arbitrary OutputsSpec where
+  arbitrary = oneof
+    [ pure OutputsSpec_All
+    ,   OutputsSpec_Names
+      . Data.Set.fromList
+      <$> ((:) <$> arbitrary <*> arbitrary)
+    ]
 
 deriving via GenericArbitrary DerivedPath
   instance Arbitrary DerivedPath

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

@@ -4,13 +4,13 @@
 module System.Nix.Arbitrary.Hash where
 
 import Data.ByteString (ByteString)
+import Data.ByteString.Arbitrary ()
 import Crypto.Hash (Digest, MD5(..), SHA1(..), SHA256(..), SHA512(..))
 import Data.Dependent.Sum (DSum((:=>)))
 import Data.Some (Some(Some))
 import System.Nix.Hash (HashAlgo(..))
 
 import Test.QuickCheck (Arbitrary(arbitrary), oneof)
-import Test.QuickCheck.Instances ()
 
 import qualified Crypto.Hash
 

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

@@ -0,0 +1,22 @@
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module System.Nix.Arbitrary.OutputName where
+
+import System.Nix.OutputName (OutputName)
+import qualified Data.Text
+import qualified System.Nix.OutputName
+
+import Test.QuickCheck (Arbitrary(arbitrary), choose, elements, vectorOf)
+
+instance Arbitrary OutputName where
+  arbitrary =
+      either (error . show) id
+    . System.Nix.OutputName.mkOutputName
+    . Data.Text.pack <$> ((:) <$> s1 <*> limited sn)
+   where
+    alphanum = ['a' .. 'z'] <> ['A' .. 'Z'] <> ['0' .. '9']
+    s1 = elements $ alphanum <> "+-_?="
+    sn = elements $ alphanum <> "+-._?="
+    limited n = do
+      k <- choose (0, 210)
+      vectorOf k n

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

@@ -0,0 +1,27 @@
+-- due to Illegal equational constraint Test.QuickCheck.Arbitrary.Generic.TypesDiffer
+{-# LANGUAGE TypeFamilies #-}
+-- due to recent generic-arbitrary
+{-# OPTIONS_GHC -fconstraint-solver-iterations=0 #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+module System.Nix.Arbitrary.Realisation where
+
+import System.Nix.Arbitrary.Hash ()
+import System.Nix.Arbitrary.OutputName ()
+import System.Nix.Arbitrary.Signature ()
+import System.Nix.Arbitrary.StorePath ()
+import System.Nix.Realisation (DerivationOutput, Realisation)
+
+import Test.QuickCheck (Arbitrary(..))
+import Test.QuickCheck.Arbitrary.Generic (Arg, GenericArbitrary(..), genericArbitrary, genericShrink)
+
+instance
+  ( Arg (DerivationOutput outputName) outputName
+  , Arbitrary outputName
+  ) =>
+  Arbitrary (DerivationOutput outputName)
+  where
+    arbitrary = genericArbitrary
+    shrink = genericShrink
+
+deriving via GenericArbitrary Realisation
+  instance Arbitrary Realisation

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

@@ -9,7 +9,6 @@ import Crypto.Random (drgNewTest, withDRG)
 import qualified Data.ByteString as BS
 import qualified Data.Text as Text
 import Test.QuickCheck.Arbitrary.Generic (GenericArbitrary(..))
-import Test.QuickCheck.Instances ()
 import Test.QuickCheck
 
 import System.Nix.Signature

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

@@ -15,7 +15,7 @@ import System.Nix.StorePath (StoreDir(..)
   )
 import qualified System.Nix.StorePath
 
-import Test.QuickCheck (Arbitrary(arbitrary), elements, listOf, oneof)
+import Test.QuickCheck (Arbitrary(arbitrary), choose, elements, oneof, vectorOf)
 
 instance Arbitrary StoreDir where
   arbitrary =
@@ -32,12 +32,15 @@ instance Arbitrary StorePath where
 instance Arbitrary StorePathName where
   arbitrary =
       either undefined id
-    . System.Nix.StorePath.makeStorePathName
-    . Data.Text.pack <$> ((:) <$> s1 <*> listOf sn)
+    . System.Nix.StorePath.mkStorePathName
+    . Data.Text.pack <$> ((:) <$> s1 <*> limited sn)
    where
     alphanum = ['a' .. 'z'] <> ['A' .. 'Z'] <> ['0' .. '9']
-    s1       = elements $ alphanum <> "+-_?="
-    sn       = elements $ alphanum <> "+-._?="
+    s1 = elements $ alphanum <> "+-_?="
+    sn = elements $ alphanum <> "+-._?="
+    limited n = do
+      k <- choose (0, 210)
+      vectorOf k n
 
 instance Arbitrary StorePathHashPart where
   arbitrary =

hnix-store-tests/src/System/Nix/Arbitrary/StorePath/Metadata.hs

@@ -4,20 +4,32 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
 module System.Nix.Arbitrary.StorePath.Metadata where
 
+import Data.Dependent.Sum (DSum((:=>)))
+import Data.HashSet.Arbitrary ()
 import System.Nix.Arbitrary.ContentAddress ()
 import System.Nix.Arbitrary.Hash ()
 import System.Nix.Arbitrary.Signature ()
 import System.Nix.Arbitrary.StorePath ()
+import System.Nix.Arbitrary.UTCTime ()
 import System.Nix.StorePath (StorePath)
-import System.Nix.StorePath.Metadata (Metadata, StorePathTrust)
+import System.Nix.StorePath.Metadata (Metadata(..), StorePathTrust)
 
-import Test.QuickCheck (Arbitrary(..))
+import qualified System.Nix.Hash
+
+import Test.QuickCheck (Arbitrary(..), suchThat)
 import Test.QuickCheck.Arbitrary.Generic (GenericArbitrary(..))
-import Test.QuickCheck.Instances ()
 
 deriving via GenericArbitrary StorePathTrust
   instance Arbitrary StorePathTrust
 
-deriving via GenericArbitrary (Metadata StorePath)
-  instance Arbitrary (Metadata StorePath)
-
+instance Arbitrary (Metadata StorePath) where
+  arbitrary = do
+    metadataDeriverPath <- arbitrary
+    metadataNarHash <- (System.Nix.Hash.HashAlgo_SHA256 :=>) <$> arbitrary
+    metadataReferences <- arbitrary
+    metadataRegistrationTime <- arbitrary
+    metadataNarBytes <- arbitrary `suchThat` (/= Just 0)
+    metadataTrust <- arbitrary
+    metadataSigs <- arbitrary
+    metadataContentAddress <- arbitrary
+    pure Metadata{..}

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

@@ -0,0 +1,26 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+-- Stolen from quickcheck-instances (BSD-3)
+-- UTCTime/DiffTime slightly modified to produce
+-- values rounded to whole seconds
+module System.Nix.Arbitrary.UTCTime where
+
+import Data.Time (Day(..), DiffTime, UTCTime(..))
+import Test.QuickCheck (Arbitrary(..))
+
+instance Arbitrary Day where
+    arbitrary = ModifiedJulianDay <$> (2000 +) <$> arbitrary
+    shrink    = (ModifiedJulianDay <$>) . shrink . Data.Time.toModifiedJulianDay
+
+instance Arbitrary DiffTime where
+    -- without abs something weird happens, try it
+    arbitrary = fromInteger . abs <$> arbitrary
+
+instance Arbitrary UTCTime where
+    arbitrary =
+        UTCTime
+        <$> arbitrary
+        <*> arbitrary
+    shrink ut@(UTCTime day dayTime) =
+         [ ut { Data.Time.utctDay     = d' } | d' <- shrink day     ]
+      ++ [ ut { Data.Time.utctDayTime = t' } | t' <- shrink dayTime ]
+

hnix-store-tests/src/Test/Hspec/Nix.hs

@@ -1,5 +1,6 @@
 module Test.Hspec.Nix
-  ( roundtrips
+  ( forceRight
+  , roundtrips
   ) where
 
 import Test.Hspec (Expectation, shouldBe)
@@ -18,3 +19,11 @@ roundtrips
   -> Expectation
 roundtrips encode decode x =
   decode (encode x) `shouldBe` pure x
+
+forceRight
+  :: Show a
+  => Either a b
+  -> b
+forceRight = \case
+  Right x -> x
+  Left e -> error $ "forceRight failed: " ++ show e

hnix-store-tests/tests/DerivedPathSpec.hs

@@ -1,26 +1,17 @@
 module DerivedPathSpec where
 
-import Data.Default.Class (Default(def))
-import Test.Hspec (Spec, describe, shouldBe)
+import Test.Hspec (Spec, describe)
 import Test.Hspec.QuickCheck (prop)
-import Test.QuickCheck (Arbitrary(arbitrary), forAll, suchThat)
+import Test.Hspec.Nix (roundtrips)
 
 import System.Nix.Arbitrary ()
-import System.Nix.DerivedPath (DerivedPath(..), OutputsSpec(..))
 
-import qualified Data.Set
 import qualified System.Nix.DerivedPath
 
 spec :: Spec
 spec = do
   describe "DerivedPath" $ do
-    prop "roundtrips" $
-      forAll (arbitrary `suchThat` nonEmptyOutputsSpec_Names) $ \p ->
-        System.Nix.DerivedPath.parseDerivedPath def
-          (System.Nix.DerivedPath.derivedPathToText def p)
-        `shouldBe` pure p
-  where
-    nonEmptyOutputsSpec_Names :: DerivedPath -> Bool
-    nonEmptyOutputsSpec_Names (DerivedPath_Built _ (OutputsSpec_Names set)) =
-      not $ Data.Set.null set
-    nonEmptyOutputsSpec_Names _ = True
+    prop "roundtrips" $ \sd ->
+      roundtrips
+        (System.Nix.DerivedPath.derivedPathToText sd)
+        (System.Nix.DerivedPath.parseDerivedPath sd)

hnix-store-tests/tests/RealisationSpec.hs

@@ -0,0 +1,26 @@
+module RealisationSpec where
+
+import Test.Hspec (Spec, describe)
+import Test.Hspec.QuickCheck (prop)
+import Test.Hspec.Nix (roundtrips)
+
+import System.Nix.Arbitrary ()
+
+import qualified Data.Text.Lazy
+import qualified Data.Text.Lazy.Builder
+import qualified System.Nix.OutputName
+import qualified System.Nix.Realisation
+
+spec :: Spec
+spec = do
+  describe "DerivationOutput" $ do
+    prop "roundtrips" $
+      roundtrips
+        ( Data.Text.Lazy.toStrict
+        . Data.Text.Lazy.Builder.toLazyText
+        . System.Nix.Realisation.derivationOutputBuilder
+            System.Nix.OutputName.unOutputName
+        )
+        ( System.Nix.Realisation.derivationOutputParser
+            System.Nix.OutputName.mkOutputName
+        )

hnix-store-tests/tests/SignatureSpec.hs

@@ -4,10 +4,12 @@ import Test.Hspec (Spec, describe)
 import Test.Hspec.Nix (roundtrips)
 import Test.Hspec.QuickCheck (prop)
 
-import System.Nix.Signature (signatureToText, parseSignature)
+import System.Nix.Signature (signatureToText, parseSignature, narSignatureToText, parseNarSignature)
 import System.Nix.Arbitrary ()
 
 spec :: Spec
 spec = do
   describe "Signature" $ do
     prop "roundtrips" $ roundtrips signatureToText parseSignature
+  describe "NarSignature" $ do
+    prop "roundtrips" $ roundtrips narSignatureToText parseNarSignature

overlay.nix

@@ -23,17 +23,12 @@ in
       sha256 = "sha256-AnjaUzSlsLi3lIURrEfs92Jo5FzX49RyNdfDSfFV3Kk=";
     } {};
 
-  # srk 2023-11-19: default in unstable is 0.1.1.1 which
-  # fails to compile test on ghc8107
-  # but for for ghc963 we hit
-  # https://github.com/obsidiansystems/dependent-sum-template/issues/10
-  # so we use 0.1.1.1 for ghc963 and 0.2.0.0 for the rest
-  # - some weird interaction in unstable as this builds
-  # with cabal and 0.2.0.0
-  dependent-sum-template =
-    if compiler == "ghc8107" || compiler == "ghc902" || compiler == "ghc928"
-    then hsuper.dependent-sum-template_0_2_0_0
-    else hsuper.dependent-sum-template;
+  # srk 2023-12-06: until in unstable
+  dependent-sum-template = hself.callHackageDirect
+    { pkg = "dependent-sum-template";
+      ver = "0.2.0.1";
+      sha256 = "sha256-quwgFuEBrK96JZenJZcyfk/O0Gp+ukwKEpe1hMqDbIg=";
+    } {};
 
   # srk 2023-11-19: wider unix bound via CPP
   # Required for ghc963 since linux-namespaces is pinned
@@ -56,6 +51,12 @@ in
       [
         haskellLib.compose.buildFromSdist
       ];
+  hnix-store-json =
+    lib.pipe
+      (hself.callCabal2nix "hnix-store-json" ./hnix-store-json {})
+      [
+        haskellLib.compose.buildFromSdist
+      ];
   hnix-store-nar =
     lib.pipe
       (hself.callCabal2nix "hnix-store-nar" ./hnix-store-nar {})

shell.nix

@@ -6,6 +6,7 @@ let
   packages = [
     "hnix-store-core"
     "hnix-store-db"
+    "hnix-store-json"
     "hnix-store-nar"
     "hnix-store-readonly"
     "hnix-store-remote"