fixup! simple store path root, remote store rework

Author: sorki

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

@@ -29,7 +29,6 @@ library
                      , System.Nix.Signature
                      , System.Nix.StorePath
                      , System.Nix.StorePathMetadata
-                     , System.Nix.ValidPath
   build-depends:       base >=4.10 && <5
                      , attoparsec
                      , base16-bytestring

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

@@ -47,3 +47,4 @@ data StorePathTrust
   | -- | It was built elsewhere (and substituted or similar) and so
     -- is less trusted
     BuiltElsewhere
+  deriving (Show, Eq)

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

@@ -43,6 +43,7 @@ import qualified Data.Binary.Put           as B
 import           Data.ByteString           (ByteString)
 import qualified Data.ByteString.Lazy      as BSL
 import qualified Data.Map.Strict           as M
+import qualified Data.Set
 import           Data.Proxy                (Proxy)
 import           Data.Text                 (Text)
 
@@ -52,14 +53,14 @@ import           System.Nix.Hash           (Digest, ValidAlgo)
 import           System.Nix.StorePath
 import           System.Nix.Hash
 import           System.Nix.Nar            (localPackNar, putNar, narEffectsIO, Nar)
-import           System.Nix.ValidPath
+import           System.Nix.StorePathMetadata
 
 import           System.Nix.Store.Remote.Binary
 import           System.Nix.Store.Remote.Types
 import           System.Nix.Store.Remote.Protocol
 import           System.Nix.Store.Remote.Util
 
-import Data.Text.Encoding (encodeUtf8)
+import qualified Data.Text.Encoding -- (encodeUtf8)
 
 type RepairFlag = Bool
 type CheckFlag = Bool
@@ -71,11 +72,10 @@ addToStore
   => StorePathName
   -> FilePath
   -> Bool
-  -> Proxy a
   -> (StorePath -> Bool)
   -> RepairFlag
   -> MonadStore StorePath
-addToStore name pth recursive _algoProxy pfilter repair = do
+addToStore name pth recursive _pathFilter _repair = do
 
   -- TODO: Is this lazy enough? We need `B.putLazyByteString bs` to stream `bs`
   bs  :: BSL.ByteString <- liftIO $ B.runPut . putNar <$> localPackNar narEffectsIO pth
@@ -92,23 +92,32 @@ addToStore name pth recursive _algoProxy pfilter repair = do
 
   sockGetPath
 
-addToStoreNar :: ValidPath -> Nar -> RepairFlag -> CheckSigsFlag -> MonadStore ()
-addToStoreNar ValidPath{..} nar repair checkSigs = do
+addToStoreNar :: StorePathMetadata -> Nar -> RepairFlag -> CheckSigsFlag -> MonadStore ()
+addToStoreNar StorePathMetadata{..} nar repair checkSigs = do
   -- after the command, protocol asks for data via Read message
   -- so we provide it here
   let n = B.runPut $ putNar nar
   setData n
 
   void $ runOpArgs AddToStoreNar $ do
     putPath path
-    maybe (putText "") (putPath) deriver
-    putText narHash
+    maybe (putText "") (putPath) deriverPath
+    let putNarHash :: SomeNamedDigest -> B.PutM ()
+        putNarHash (SomeDigest n) = putByteStringLen
+          $ BSL.fromStrict
+          $ Data.Text.Encoding.encodeUtf8
+          $ encodeBase32 n
+
+    putNarHash narHash
     putPaths references
     putTime registrationTime
-    putInt narSize
-    putBool ultimate
-    putTexts sigs
-    putText ca
+    -- XXX
+    maybe (error "NO NAR BYTES") putInt narBytes
+    putBool (trust == BuiltLocally)
+    -- XXX
+    putTexts [""]
+    -- XXX
+    putText ""
 
     putBool repair
     putBool (not checkSigs)
@@ -190,23 +199,38 @@ querySubstitutablePaths ps = do
     putPaths ps
   sockGetPaths
 
-queryPathInfoUncached :: StorePath -> MonadStore ValidPath
+queryPathInfoUncached :: forall a.NamedAlgo a => StorePath -> MonadStore StorePathMetadata
 queryPathInfoUncached path = do
   runOpArgs QueryPathInfo $ do
     putPath path
 
   valid <- sockGetBool
   unless valid $ error "Path is not valid"
 
-  deriver <- sockGetPathMay
-  narHash <- bsToText <$> sockGetStr
+  deriverPath <- sockGetPathMay
+
+  narHashText <- Data.Text.Encoding.decodeUtf8 <$> sockGetStr
+  let narHash = case decodeBase32 narHashText of
+        Left e -> error e
+        Right x -> SomeDigest @a x
+
   references <- sockGetPaths
   registrationTime <- sockGet getTime
-  narSize <- sockGetInt
+  narBytes <- Just <$> sockGetInt
   ultimate <- sockGetBool
-  sigs <- map bsToText <$> sockGetStrings
+
+  -- XXX
+  sigStrings <- map bsToText <$> sockGetStrings
+
+  let sigs = Data.Set.empty
+      contentAddressableAddress = Nothing
+
   ca <- bsToText <$> sockGetStr
-  return $ ValidPath {..}
+
+  let trust = if ultimate then BuiltLocally
+                          else BuiltElsewhere
+
+  return $ StorePathMetadata {..}
 
 queryReferrers :: StorePath -> MonadStore StorePathSet
 queryReferrers p = do
@@ -235,7 +259,7 @@ queryDerivationOutputNames p = do
 queryPathFromHashPart :: Digest StorePathHashAlgo -> MonadStore StorePath
 queryPathFromHashPart storePathHash = do
   runOpArgs QueryPathFromHashPart $
-    putByteStringLen $ BSL.fromStrict $ encodeUtf8 $ encodeBase32 storePathHash
+    putByteStringLen $ BSL.fromStrict $ Data.Text.Encoding.encodeUtf8 $ encodeBase32 storePathHash
   sockGetPath
 
 queryMissing :: StorePathSet -> MonadStore (StorePathSet, StorePathSet, StorePathSet, Integer, Integer)
@@ -253,7 +277,7 @@ queryMissing ps = do
 optimiseStore :: MonadStore ()
 optimiseStore = void $ simpleOp OptimiseStore
 
-syncWithGC ::MonadStore ()
+syncWithGC :: MonadStore ()
 syncWithGC = void $ simpleOp SyncWithGC
 
 -- returns True on errors

hnix-store-remote/tests/NixDaemon.hs

@@ -46,7 +46,7 @@ import           System.Nix.Hash
 import           System.Nix.StorePath
 import           System.Nix.ReadonlyStore
 import           System.Nix.Nar
-import qualified System.Nix.ValidPath        as VP
+import qualified System.Nix.StorePathMetadata as VP
 import           System.Nix.Store.Remote
 import           System.Nix.Store.Remote.Logger
 import           System.Nix.Store.Remote.Types
@@ -148,7 +148,7 @@ withPath action = do
 -- | dummy path, adds <tmp>/dummpy with "Hello World" contents
 dummy = do
   let Right n = makeStorePathName "dummy"
-  res <- addToStore n "dummy" False (Proxy :: Proxy 'SHA256) (pure True) False
+  res <- addToStore @SHA256 n "dummy" False (pure True) False
   return res
 
 invalidPath :: StorePath
@@ -162,7 +162,8 @@ withNar act = do
 
   let narContents = runPut $ putNar nar
       narHash = hashLazy @SHA256 narContents
-      narSize = BSL.length narContents
+      -- narSize vs narBytes
+      narBytes = BSL.length narContents
 
   deriver <- addTextToStore "some-deriver" "" (HS.fromList [])  False
 
@@ -172,16 +173,16 @@ withNar act = do
 
   addTempRoot path
 
-  let vp = VP.ValidPath
+  let vp = VP.StorePathMetadata
             { VP.path =  path
-            , VP.deriver = Just deriver
-            , VP.narHash = (encodeBase16 narHash)
+            , VP.deriverPath = Just deriver
+            , VP.narHash = SomeDigest narHash
             , VP.references = HS.empty
             , VP.registrationTime = now
-            , VP.narSize = fromIntegral narSize
-            , VP.ultimate = True
-            , VP.sigs = []
-            , VP.ca = ""
+            , VP.narBytes = Just $ fromIntegral narBytes
+            , VP.trust = VP.BuiltLocally
+            , VP.sigs = S.empty -- []
+            , VP.contentAddressableAddress = Nothing
             }
 
   addToStoreNar vp nar False False
@@ -227,7 +228,7 @@ spec_protocol = Hspec.around withNixDaemon $ do
       itRights "non-empty query" $ withPath $ \path -> queryAllValidPaths `shouldReturn` (HS.fromList [path])
 
     context "queryPathInfoUncached" $ do
-      itRights "queries path info" $ withPath $ queryPathInfoUncached
+      itRights "queries path info" $ withPath $ queryPathInfoUncached @SHA256
 
     context "ensurePath" $ do
       itRights "simple ensure" $ withPath $ ensurePath
@@ -277,7 +278,7 @@ spec_protocol = Hspec.around withNixDaemon $ do
       itRights "adds file to store" $ do
         fp <- liftIO $ writeSystemTempFile "addition" "lal"
         let Right n = makeStorePathName "tmp-addition"
-        res <- addToStore n fp False (Proxy :: Proxy 'SHA256) (pure True) False
+        res <- addToStore @SHA256 n fp False (pure True) False
         liftIO $ print res
 
     context "with dummy" $ do