WIP addToStore protocol implementation

This commit is contained in:
Greg Hale 2018-11-18 14:27:23 -05:00
parent 6f1626a0ef
commit 7bd82c9ce9
2 changed files with 53 additions and 27 deletions

View File

@ -47,21 +47,6 @@ data HashAlgorithm' n
type HashAlgorithm = HashAlgorithm' Nat
class AlgoVal (a :: HashAlgorithm) where
algoVal :: HashAlgorithm' Integer
instance AlgoVal MD5 where
algoVal = MD5
instance AlgoVal SHA1 where
algoVal = SHA1
instance AlgoVal SHA256 where
algoVal = SHA256
instance forall a n.(AlgoVal a, KnownNat n) => AlgoVal (Truncated n a) where
algoVal = Truncated (natVal (Proxy @n)) (algoVal @a)
-- | Types with kind @HashAlgorithm@ may be a @HasDigest@ instance
-- if they are able to hash bytestrings via the init/update/finalize
-- API of cryptonite
@ -185,3 +170,20 @@ truncateDigest (Digest c) = Digest $ BS.pack $ map truncOutputByte [0.. n-1]
digits32 :: V.Vector Char
digits32 = V.fromList "0123456789abcdfghijklmnpqrsvwxyz"
-- | Convert type-level @HashAlgorithm@ into the value level
class AlgoVal (a :: HashAlgorithm) where
algoVal :: HashAlgorithm' Integer
instance AlgoVal MD5 where
algoVal = MD5
instance AlgoVal SHA1 where
algoVal = SHA1
instance AlgoVal SHA256 where
algoVal = SHA256
instance forall a n.(AlgoVal a, KnownNat n) => AlgoVal (Truncated n a) where
algoVal = Truncated (natVal (Proxy @n)) (algoVal @a)

View File

@ -35,19 +35,24 @@ module System.Nix.Store.Remote (
, queryMissing
) where
import Control.Monad
import Control.Monad.IO.Class (liftIO)
import qualified Data.Binary as B
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(Proxy))
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.Encoding as T
import Control.Monad
import qualified System.Nix.Build as Build
import qualified System.Nix.Derivation as Drv
import qualified System.Nix.GC as GC
import System.Nix.Hash (Digest, HashAlgorithm)
import qualified System.Nix.Build as Build
import qualified System.Nix.Derivation as Drv
import qualified System.Nix.GC as GC
import System.Nix.Hash (Digest, HashAlgorithm)
import System.Nix.Path
import System.Nix.Hash
import System.Nix.Nar (localPackNar, putNar)
import System.Nix.Util
import System.Nix.Store.Remote.Types
@ -183,23 +188,42 @@ addToStoreNar = undefined -- XXX
-- instance forall n a.BaseHashAlgorithm a => BaseHashAlgorithm (Truncated n a) where
-- baseHashAlgorithm = baseHashAlgorithm @a
printHashType :: HashAlgorithm' Integer -> T.Text
printHashType MD5 = "MD5"
printHashType SHA1 = "SHA1"
printHashType SHA256 = "SHA256"
printHashType (Truncated _ a) = printHashType a
type PathFilter = Path -> Bool
addToStore
:: forall a. AlgoVal a
:: forall a. (HasDigest a, AlgoVal a)
=> LBS.ByteString
-> Path
-> FilePath
-> Bool
-> Proxy a
-> PathFilter
-> RepairFlag
-> MonadStore Path
addToStore name pth recursive algoProxy pfilter repair = do
-- Get length first
len <- liftIO $ LBS.length . B.runPut . putNar <$> localPackNar undefined pth
-- Fetch full NAR bytestring separately. We are trying to
-- avoid forcing the full string in memory
bs :: LBS.ByteString <- liftIO $ B.runPut . putNar <$> localPackNar undefined pth
runOpArgs AddToStore $ do
putByteStringLen name
putByteStringLen $ if algoVal @a == SHA256 && recursive then 0 else 1
putByteStringLen $ if recursive then 0 else 1
putByteStringLen name
fmap (fromMaybe "TODO: Error") sockGetPath
-- TODO: really send the string 0 or 1? Or is this Word8's 0 and 1?
putByteStringLen $ if algoVal @a `elem` [SHA256, Truncated 20 SHA256]
&& recursive
then "0"
else "1"
-- TODO: really send the string 0 or 1? Or is this Word8's 0 and 1?
putByteStringLen $ if recursive then "0" else "1"
putByteStringLen (T.encodeUtf8 . printHashType $ algoVal @a)
putInt len
B.putLazyByteString bs
fmap (fromMaybe $ error "TODO: Error") sockGetPath
addTextToStore :: LBS.ByteString -> LBS.ByteString -> PathSet -> RepairFlag -> MonadStore (Maybe Path)