hnix-store-remote: Remove erroneous path putting/getting.

mkPath's logic was completely wrong (tried to make a PathName out of
the entire path, made up a hash based on the whole path rather than
parsing base32) and putPath ignored the store directory and the hash
part.

Much of the code that depended on these functions was actually
correct, but ultimately did the wrong thing. We can resurrect those
from git once the primitives are correctly implemented.

Author: shlevy

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

@@ -1,5 +1,5 @@
 name:                hnix-store-remote
-version:             0.1.0.0
+version:             0.2.0.0
 synopsis:            Remote hnix store
 description:         Implementation of the nix store using the daemon protocol.
 homepage:            https://github.com/haskell-nix/hnix-store

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

@@ -7,244 +7,23 @@
 {-# LANGUAGE TypeApplications    #-}
 module System.Nix.Store.Remote (
     runStore
-  , isValidPathUncached
-  , queryValidPaths
-  , queryAllValidPaths
-  , querySubstitutablePaths
-  , querySubstitutablePathInfos
-  , queryPathInfoUncached
-  , queryReferrers
-  , queryValidDerivers
-  , queryDerivationOutputs
-  , queryDerivationOutputNames
-  , queryPathFromHashPart
-  , addToStore
-  , addTextToStore
-  , buildPaths
-  , ensurePath
-  , addTempRoot
-  , addIndirectRoot
   , syncWithGC
-  , findRoots
-  , collectGarbage
   , optimiseStore
   , verifyStore
-  , addSignatures
   ) where
 
 import           Control.Monad
-import           Control.Monad.IO.Class    (liftIO)
-import qualified Data.Binary.Put           as B
-import           Data.Maybe
-import qualified Data.ByteString.Lazy      as LBS
-import qualified Data.Map.Strict           as M
-import           Data.Proxy                (Proxy)
-import qualified Data.Text.Lazy                 as T
-import qualified Data.Text.Lazy.Encoding        as T
-
-import qualified System.Nix.Build          as Build
-import qualified System.Nix.GC             as GC
-import           System.Nix.Path
-import           System.Nix.Hash
-import           System.Nix.Nar            (localPackNar, putNar, narEffectsIO)
-import           System.Nix.Util
 
 import           System.Nix.Store.Remote.Types
 import           System.Nix.Store.Remote.Protocol
 import           System.Nix.Store.Remote.Util
 
 type RepairFlag = Bool
 type CheckFlag = Bool
-type SubstituteFlag = Bool
-
---setOptions :: StoreSetting -> MonadStore ()
-
-isValidPathUncached :: Path -> MonadStore Bool
-isValidPathUncached p = simpleOpArgs IsValidPath $ putPath p
-
-queryValidPaths :: PathSet -> SubstituteFlag -> MonadStore PathSet
-queryValidPaths ps substitute = do
-  runOpArgs QueryValidPaths $ do
-    putPaths ps
-    putBool substitute
-  sockGetPaths
-
-queryAllValidPaths :: MonadStore PathSet
-queryAllValidPaths = do
-  runOp QueryAllValidPaths
-  sockGetPaths
-
-querySubstitutablePaths :: PathSet -> MonadStore PathSet
-querySubstitutablePaths ps = do
-  runOpArgs QuerySubstitutablePaths $ do
-    putPaths ps
-  sockGetPaths
-
-querySubstitutablePathInfos :: PathSet -> MonadStore [SubstitutablePathInfo]
-querySubstitutablePathInfos ps = do
-  runOpArgs QuerySubstitutablePathInfos $ do
-    putPaths ps
-
-  cnt <- sockGetInt
-  forM (take cnt $ cycle [(0 :: Int)]) $ pure $ do
-      _pth <- sockGetPath
-      drv <- sockGetStr
-      refs <- sockGetPaths
-      dlSize <- sockGetInt
-      narSize' <- sockGetInt
-      return $ SubstitutablePathInfo {
-                 deriver = mkPath drv
-               , references = refs
-               , downloadSize = dlSize
-               , narSize = narSize'
-               }
-
-queryPathInfoUncached :: Path -> MonadStore ValidPathInfo
-queryPathInfoUncached p = do
-  runOpArgs QueryPathInfo $ do
-    putPath p
-
-  valid <- sockGetBool
-  unless valid $ error "Path is not valid"
-
-  drv <- sockGetStr
-  hash' <- lBSToText <$> sockGetStr
-  refs <- sockGetPaths
-  regTime <- sockGetInt
-  size <- sockGetInt
-  ulti <- sockGetBool
-  sigs' <- map lBSToText <$> sockGetStrings
-  ca' <- lBSToText <$> sockGetStr
-  return $ ValidPathInfo {
-             path = p
-           , deriverVP = mkPath drv
-           , narHash = hash'
-           , referencesVP = refs
-           , registrationTime = regTime
-           , narSizeVP = size
-           , ultimate = ulti
-           , sigs = sigs'
-           , ca = ca'
-           }
-
-queryReferrers :: Path -> MonadStore PathSet
-queryReferrers p = do
-  runOpArgs QueryReferrers $ do
-    putPath p
-  sockGetPaths
-
-queryValidDerivers :: Path -> MonadStore PathSet
-queryValidDerivers p = do
-  runOpArgs QueryValidDerivers $ do
-    putPath p
-  sockGetPaths
-
-queryDerivationOutputs :: Path -> MonadStore PathSet
-queryDerivationOutputs p = do
-  runOpArgs QueryDerivationOutputs $
-    putPath p
-  sockGetPaths
-
-queryDerivationOutputNames :: Path -> MonadStore PathSet
-queryDerivationOutputNames p = do
-  runOpArgs QueryDerivationOutputNames $
-    putPath p
-  sockGetPaths
-
--- XXX: this is broken as I don't know how to get hashes from paths (fix mkPath)
-queryPathFromHashPart :: Digest PathHashAlgo -> MonadStore (Maybe Path)
-queryPathFromHashPart d = do
-  runOpArgs QueryPathFromHashPart $
-    -- TODO: replace `undefined` with digest encoding function when
-    --       [issue 24](https://github.com/haskell-nix/hnix-store/issues/24) is
-    --       closed
-    putByteStringLen $ LBS.fromStrict $ undefined d
-  sockGetPath
-
-type PathFilter = Path -> Bool
-
-addToStore
-  :: forall a. (ValidAlgo a, NamedAlgo a)
-  => LBS.ByteString
-  -> FilePath
-  -> Bool
-  -> Proxy a
-  -> PathFilter
-  -> RepairFlag
-  -> MonadStore Path
-addToStore name pth recursive algoProxy pfilter repair = do
-
-  -- TODO: Is this lazy enough? We need `B.putLazyByteString bs` to stream `bs`
-  bs  :: LBS.ByteString <- liftIO $ B.runPut . putNar <$> localPackNar narEffectsIO pth
-
-  runOpArgs AddToStore $ do
-    putByteStringLen name
-    putInt 1
-    if recursive
-      then putInt 1
-      else putInt 0
-
-    putByteStringLen (T.encodeUtf8 . T.toLower . T.fromStrict $ algoName @a)
-
-    B.putLazyByteString bs
-
-  fmap (fromMaybe $ error "TODO: Error") sockGetPath
-
-
-addTextToStore :: LBS.ByteString -> LBS.ByteString -> PathSet -> RepairFlag -> MonadStore (Maybe Path)
-addTextToStore name text references' repair = do
-  runOpArgs AddTextToStore $ do
-    putByteStringLen name
-    putByteStringLen text
-    putPaths references'
-  sockGetPath
-
-buildPaths :: PathSet -> Build.BuildMode -> MonadStore ()
-buildPaths ps bm = void $ simpleOpArgs EnsurePath $ do
-  putPaths ps
-  putInt $ fromEnum bm
-
-ensurePath :: Path -> MonadStore ()
-ensurePath pn = void $ simpleOpArgs EnsurePath $ putPath pn
-
-addTempRoot :: Path -> MonadStore ()
-addTempRoot pn = void $ simpleOpArgs AddTempRoot $ putPath pn
-
-addIndirectRoot :: Path -> MonadStore ()
-addIndirectRoot pn = void $ simpleOpArgs AddIndirectRoot $ putPath pn
 
 syncWithGC :: MonadStore ()
 syncWithGC = void $ simpleOp SyncWithGC
 
-findRoots :: MonadStore Roots
-findRoots = do
-  runOp FindRoots
-  res <- getSocketIncremental (do
-      count <- getInt
-      res <- sequence $ replicate count ((,) <$> getPath <*> getPath)
-      return res
-    )
-
-  return $ M.fromList $ catMaybesTupled res
-  where
-   catMaybesTupled :: [(Maybe a, Maybe b)] -> [(a, b)]
-   catMaybesTupled ls = map (\(Just x, Just y) -> (x, y)) $ filter (\(x,y) -> isJust x && isJust y) ls
-
-collectGarbage :: GC.Options -> MonadStore GC.Result
-collectGarbage opts = do
-  runOpArgs CollectGarbage $ do
-    putInt $ fromEnum $ GC.operation opts
-    putPaths $ GC.pathsToDelete opts
-    putBool $ GC.ignoreLiveness opts
-    putInt $ GC.maxFreed opts
-    forM_ [(0 :: Int)..2] $ pure $ putInt (0 :: Int) -- removed options
-
-  paths <- sockGetPaths
-  freed <- sockGetInt
-  _obsolete <- sockGetInt :: MonadStore Int
-
-  return $ GC.Result paths freed
-
 optimiseStore :: MonadStore ()
 optimiseStore = void $ simpleOp OptimiseStore
 
@@ -253,8 +32,3 @@ verifyStore :: CheckFlag -> RepairFlag -> MonadStore Bool
 verifyStore check repair = simpleOpArgs VerifyStore $ do
   putBool check
   putBool repair
-
-addSignatures :: Path -> [LBS.ByteString] -> MonadStore ()
-addSignatures p signatures = void $ simpleOpArgs AddSignatures $ do
-  putPath p
-  putByteStrings signatures

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

@@ -16,7 +16,6 @@ import           Network.Socket.ByteString (recv, sendAll)
 
 import           System.Nix.Store.Remote.Types
 import           System.Nix.Hash
-import           System.Nix.Path
 import           System.Nix.Util
 
 
@@ -44,12 +43,6 @@ sockGet = do
   soc <- ask
   liftIO $ Just <$> recv soc 8
 
-sockGetPath :: MonadStore (Maybe Path)
-sockGetPath = getSocketIncremental getPath
-
-sockGetPaths :: MonadStore PathSet
-sockGetPaths = getSocketIncremental getPaths
-
 sockGetInt :: Integral a => MonadStore a
 sockGetInt = getSocketIncremental getInt
 
@@ -68,36 +61,6 @@ lBSToText = T.pack . BSC.unpack . LBS.toStrict
 textToLBS :: Text -> LBS.ByteString
 textToLBS = LBS.fromStrict . BSC.pack . T.unpack
 
--- XXX: needs work
-mkPath :: LBS.ByteString -> Maybe Path
-mkPath p = case (pathName $ lBSToText p) of
-             -- TODO: replace `undefined` with digest encoding function when
-             --       [issue 24](https://github.com/haskell-nix/hnix-store/issues/24)
-             --       is closed
-             Just x -> Just $ Path (hash $ LBS.toStrict p) x --XXX: hash
-             Nothing -> Nothing
-
--- WOOT
--- import           Data.ByteString.Base32    as Base32
---drvP = Path (fromJust $ digestFromByteString $ pls $ Base32.decode $ BSC.take 32 $ BSC.drop (BSC.length "/nix/store/") drv) (fromJust $ pathName $ T.pack $ BSC.unpack drv)
---pls (Left _) = error "unable to decode hash"
---pls (Right x) = x
-
-getPath :: Get (Maybe Path)
-getPath = mkPath <$> getByteStringLen
-
-getPaths :: Get PathSet
-getPaths = HashSet.fromList . catMaybes . map mkPath <$> getByteStrings
-
-putPathName :: PathName -> Put
-putPathName = putByteStringLen . textToLBS . pathNameContents
-
-putPath :: Path -> Put
-putPath (Path _hash name) = putPathName name
-
-putPaths :: PathSet -> Put
-putPaths = putByteStrings . HashSet.map (\(Path _hash name) -> textToLBS $ pathNameContents name)
-
 putBool :: Bool -> Put
 putBool True  = putInt (1 :: Int)
 putBool False = putInt (0 :: Int)