Skip to content

Commit bd35b8a

Browse files
sorkisorki
committed
fixup! simple store path root, remote store rework
1 parent 80d8a38 commit bd35b8a

File tree

9 files changed

+67
-80
lines changed

9 files changed

+67
-80
lines changed

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

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,6 @@ library
2929
, System.Nix.Signature
3030
, System.Nix.StorePath
3131
, System.Nix.StorePathMetadata
32-
, System.Nix.Util
3332
, System.Nix.ValidPath
3433
build-depends: base >=4.10 && <5
3534
, base16-bytestring

‎hnix-store-core/src/System/Nix/ReadonlyStore.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,7 @@ makeTextPath fp nm h refs = makeStorePath fp ty h nm
2929
where
3030
ty = BS.intercalate ":" ("text" : map storePathToRawFilePath (HS.toList refs))
3131

32-
makeFixedOutputPath :: (ValidAlgo hashAlgo, NamedAlgo hashAlgo) => FilePath -> Bool -> Digest hashAlgo -> StorePathName -> StorePath storeDir
32+
makeFixedOutputPath :: (ValidAlgo hashAlgo, NamedAlgo hashAlgo) => FilePath -> Bool -> Digest hashAlgo -> StorePathName -> StorePath
3333
makeFixedOutputPath fp recursive h nm =
3434
makeStorePath fp ty h' nm
3535
where

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,7 @@ cabal-version: >=1.10
1515

1616
library
1717
exposed-modules: System.Nix.Store.Remote
18+
, System.Nix.Store.Remote.Binary
1819
, System.Nix.Store.Remote.Logger
1920
, System.Nix.Store.Remote.Protocol
2021
, System.Nix.Store.Remote.Types

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

Lines changed: 15 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -7,9 +7,7 @@
77
{-# LANGUAGE DataKinds #-}
88
{-# LANGUAGE TypeApplications #-}
99
{-# LANGUAGE RecordWildCards #-}
10-
{-# LANGUAGE FlexibleContexts #-}
1110
module System.Nix.Store.Remote
12-
{-
1311
(
1412
addToStore
1513
, addToStoreNar
@@ -36,35 +34,27 @@ module System.Nix.Store.Remote
3634
, syncWithGC
3735
, verifyStore
3836
)
39-
-}
4037
where
4138

4239
import Control.Monad
43-
import Control.Monad.State
4440
import Control.Monad.Except
4541
import Control.Monad.IO.Class (liftIO)
46-
import qualified Data.Binary as B
4742
import qualified Data.Binary.Put as B
48-
import Data.Maybe
49-
import qualified Data.ByteString.Char8 as BSC
43+
import Data.ByteString (ByteString)
5044
import qualified Data.ByteString.Lazy as BSL
5145
import qualified Data.Map.Strict as M
52-
import Data.Proxy (Proxy(Proxy))
46+
import Data.Proxy (Proxy)
5347
import Data.Text (Text)
54-
import qualified Data.Text.Lazy as T
55-
import qualified Data.Text.Lazy.Encoding as T
5648

5749
import qualified System.Nix.Build as Build
58-
import qualified Nix.Derivation as Drv
5950

60-
--import qualified System.Nix.GC as GC
6151
import System.Nix.Hash (Digest, ValidAlgo)
6252
import System.Nix.StorePath
6353
import System.Nix.Hash
6454
import System.Nix.Nar (localPackNar, putNar, narEffectsIO, Nar)
65-
import System.Nix.Util
6655
import System.Nix.ValidPath
6756

57+
import System.Nix.Store.Remote.Binary
6858
import System.Nix.Store.Remote.Types
6959
import System.Nix.Store.Remote.Protocol
7060
import System.Nix.Store.Remote.Util
@@ -78,22 +68,22 @@ type SubstituteFlag = Bool
7868

7969
addToStore
8070
:: forall a. (ValidAlgo a, NamedAlgo a)
81-
=> StorePathName -- BSL.ByteString
71+
=> StorePathName
8272
-> FilePath
8373
-> Bool
8474
-> Proxy a
8575
-> (StorePath -> Bool)
8676
-> RepairFlag
8777
-> MonadStore StorePath
88-
addToStore name pth recursive algoProxy pfilter repair = do
78+
addToStore name pth recursive _algoProxy pfilter repair = do
8979

9080
-- TODO: Is this lazy enough? We need `B.putLazyByteString bs` to stream `bs`
9181
bs :: BSL.ByteString <- liftIO $ B.runPut . putNar <$> localPackNar narEffectsIO pth
9282

9383
runOpArgs AddToStore $ do
9484
putText $ unStorePathName name
9585

96-
putBool $ not $ algoName @a `elem` ["sha256"] && recursive
86+
putBool $ not $ algoName @a == "sha256" && recursive
9787
putBool recursive
9888

9989
putText $ algoName @a
@@ -161,23 +151,22 @@ ensurePath :: StorePath -> MonadStore ()
161151
ensurePath pn = do
162152
void $ simpleOpArgs EnsurePath $ putPath pn
163153

164-
findRoots :: MonadStore (M.Map BSL.ByteString StorePath)
154+
findRoots :: MonadStore (M.Map ByteString StorePath)
165155
findRoots = do
166156
runOp FindRoots
167157
sd <- getStoreDir
168-
res <- getSocketIncremental (do
169-
count <- getInt
170-
res <- sequence $ replicate count ((,) <$> getByteStringLen <*> getPath sd)
171-
return res
172-
)
158+
res <- getSocketIncremental $ getMany $ (,) <$> getByteStringLen <*> getPath sd
173159

174160
r <- catRights res
175161
return $ M.fromList $ r
176162
where
177163
catRights :: [(a, Either String b)] -> MonadStore [(a, b)]
178164
catRights = mapM ex
165+
166+
ex :: (a, Either [Char] b) -> MonadStore (a, b)
179167
ex (x, Right y) = return (x, y)
180-
ex (_x , Left e) = throwError $ "Unable to decode root: " ++ show e
168+
ex (_x , Left e) = throwError $ "Unable to decode root: " ++ e
169+
181170

182171
isValidPathUncached :: StorePath -> MonadStore Bool
183172
isValidPathUncached p = do
@@ -210,13 +199,13 @@ queryPathInfoUncached path = do
210199
unless valid $ error "Path is not valid"
211200

212201
deriver <- sockGetPathMay
213-
narHash <- lBSToText <$> sockGetStr
202+
narHash <- bsToText <$> sockGetStr
214203
references <- sockGetPaths
215204
registrationTime <- sockGet getTime
216205
narSize <- sockGetInt
217206
ultimate <- sockGetBool
218-
sigs <- map lBSToText <$> sockGetStrings
219-
ca <- lBSToText <$> sockGetStr
207+
sigs <- map bsToText <$> sockGetStrings
208+
ca <- bsToText <$> sockGetStr
220209
return $ ValidPath {..}
221210

222211
queryReferrers :: StorePath -> MonadStore StorePathSet

‎hnix-store-core/src/System/Nix/Util.hs‎ renamed to ‎hnix-store-remote/src/System/Nix/Store/Remote/Binary.hs‎

Lines changed: 15 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -2,12 +2,13 @@
22
Description : Utilities for packing stuff
33
Maintainer : srk <[email protected]>
44
|-}
5-
module System.Nix.Util where
5+
module System.Nix.Store.Remote.Binary where
66

77
import Control.Monad
88
import Data.Binary.Get
99
import Data.Binary.Put
10-
import qualified Data.ByteString.Lazy as LBS
10+
import Data.ByteString (ByteString)
11+
import qualified Data.ByteString.Lazy as BSL
1112

1213
putInt :: Integral a => a -> Put
1314
putInt = putWord64le . fromIntegral
@@ -16,31 +17,33 @@ getInt :: Integral a => Get a
1617
getInt = fromIntegral <$> getWord64le
1718

1819
-- length prefixed string packing with padding to 8 bytes
19-
putByteStringLen :: LBS.ByteString -> Put
20+
putByteStringLen :: BSL.ByteString -> Put
2021
putByteStringLen x = do
21-
putInt $ fromIntegral $ len
22+
putInt len
2223
putLazyByteString x
2324
when (len `mod` 8 /= 0) $
24-
pad $ fromIntegral $ 8 - (len `mod` 8)
25-
where len = LBS.length x
26-
pad x = forM_ (take x $ cycle [0]) putWord8
25+
pad $ 8 - (len `mod` 8)
26+
where
27+
len :: Int
28+
len = fromIntegral $ BSL.length x
29+
pad count = sequence_ $ replicate count (putWord8 0)
2730

28-
putByteStrings :: Foldable t => t LBS.ByteString -> Put
31+
putByteStrings :: Foldable t => t BSL.ByteString -> Put
2932
putByteStrings xs = do
30-
putInt $ fromIntegral $ length xs
33+
putInt $ length xs
3134
mapM_ putByteStringLen xs
3235

33-
getByteStringLen :: Get LBS.ByteString
36+
getByteStringLen :: Get ByteString
3437
getByteStringLen = do
3538
len <- getInt
3639
st <- getLazyByteString len
3740
when (len `mod` 8 /= 0) $ do
3841
pads <- unpad $ fromIntegral $ 8 - (len `mod` 8)
3942
unless (all (==0) pads) $ fail $ "No zeroes" ++ show (st, len, pads)
40-
return st
43+
return $ BSL.toStrict st
4144
where unpad x = sequence $ replicate x getWord8
4245

43-
getByteStrings :: Get [LBS.ByteString]
46+
getByteStrings :: Get [ByteString]
4447
getByteStrings = do
4548
count <- getInt
4649
res <- sequence $ replicate count getByteStringLen

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

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -11,12 +11,10 @@ import Control.Monad.State (get)
1111
import Data.Binary.Get
1212

1313
import Network.Socket.ByteString (recv)
14-
import qualified Data.ByteString.Lazy as LBS
1514

15+
import System.Nix.Store.Remote.Binary
1616
import System.Nix.Store.Remote.Types
1717
import System.Nix.Store.Remote.Util
18-
import System.Nix.StorePath
19-
import System.Nix.Util
2018

2119
controlParser :: Get Logger
2220
controlParser = do

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

Lines changed: 8 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -18,17 +18,15 @@ import Control.Monad.State
1818
import Data.Binary.Get
1919
import Data.Binary.Put
2020
import qualified Data.ByteString.Char8 as BSC
21-
import qualified Data.ByteString.Lazy as LBS
22-
import qualified Data.Text as T
21+
import qualified Data.ByteString.Lazy as BSL
2322

2423
import Network.Socket hiding (send, sendTo, recv, recvFrom)
2524
import Network.Socket.ByteString (recv)
2625

26+
import System.Nix.Store.Remote.Binary
2727
import System.Nix.Store.Remote.Logger
2828
import System.Nix.Store.Remote.Types
2929
import System.Nix.Store.Remote.Util
30-
import System.Nix.Util
31-
import System.Nix.StorePath
3230

3331
protoVersion :: Int
3432
protoVersion = 0x115
@@ -124,7 +122,7 @@ simpleOpArgs op args = do
124122
case err of
125123
True -> do
126124
Error _num msg <- head <$> getError
127-
throwError $ BSC.unpack $ LBS.toStrict msg
125+
throwError $ BSC.unpack msg
128126
False -> do
129127
sockGetBool
130128

@@ -136,7 +134,7 @@ runOpArgs op args = do
136134

137135
-- Temporary hack for printing the messages destined for nix-daemon socket
138136
when False $
139-
liftIO $ LBS.writeFile "mytestfile2" $ runPut $ do
137+
liftIO $ BSL.writeFile "mytestfile2" $ runPut $ do
140138
putInt $ opNum op
141139
args
142140

@@ -150,7 +148,7 @@ runOpArgs op args = do
150148
err <- gotError
151149
when err $ do
152150
Error _num msg <- head <$> getError
153-
throwError $ BSC.unpack $ LBS.toStrict msg
151+
throwError $ BSC.unpack msg
154152

155153
runStore :: MonadStore a -> IO (Either String a, [Logger])
156154
runStore = runStoreOpts defaultSockPath "/nix/store"
@@ -162,12 +160,12 @@ runStoreOpts sockPath storeRootDir code = do
162160
open path = do
163161
soc <- socket AF_UNIX Stream 0
164162
connect soc (SockAddrUnix path)
165-
return $ StoreConfig { storeSocket = soc, storeDir = storeRootDir } -- , storeDir = oo }
163+
return $ StoreConfig { storeSocket = soc, storeDir = storeRootDir }
166164
greet = do
167165
sockPut $ putInt workerMagic1
168166
soc <- storeSocket <$> ask
169167
vermagic <- liftIO $ recv soc 16
170-
let (magic2, _daemonProtoVersion) = flip runGet (LBS.fromStrict vermagic) $ (,) <$> (getInt :: Get Int) <*> (getInt :: Get Int)
168+
let (magic2, _daemonProtoVersion) = flip runGet (BSL.fromStrict vermagic) $ (,) <$> (getInt :: Get Int) <*> (getInt :: Get Int)
171169
unless (magic2 == workerMagic2) $ error "Worker magic 2 mismatch"
172170

173171
sockPut $ putInt protoVersion -- clientVersion
@@ -177,7 +175,7 @@ runStoreOpts sockPath storeRootDir code = do
177175
processOutput
178176

179177
run sock =
180-
fmap (\(res, (handle, logs)) -> (res, logs))
178+
fmap (\(res, (_data, logs)) -> (res, logs))
181179
$ flip runReaderT sock
182180
$ flip runStateT (Nothing, [])
183181
$ runExceptT (greet >> code)

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

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@ import Network.Socket (Socket)
2323
import Control.Monad.Except
2424
import Control.Monad.Reader
2525
import Control.Monad.State
26+
2627
import System.Nix.StorePath
2728

2829
data StoreConfig = StoreConfig {
@@ -38,16 +39,16 @@ type ActivityType = Int
3839
type Verbosity = Int
3940
type ResultType = Int
4041

41-
data Field = LogStr BSL.ByteString | LogInt Int
42+
data Field = LogStr ByteString | LogInt Int
4243
deriving (Eq, Ord, Show)
4344

4445
data Logger =
45-
Next BSL.ByteString
46+
Next ByteString
4647
| Read Int -- data needed from source
47-
| Write BSL.ByteString -- data for sink
48+
| Write ByteString -- data for sink
4849
| Last
49-
| Error Int BSL.ByteString
50-
| StartActivity ActivityID Verbosity ActivityType BSL.ByteString [Field] ActivityParentID
50+
| Error Int ByteString
51+
| StartActivity ActivityID Verbosity ActivityType ByteString [Field] ActivityParentID
5152
| StopActivity ActivityID
5253
| Result ActivityID ResultType [Field]
5354
deriving (Eq, Ord, Show)

0 commit comments

Comments
 (0)