WIP addToStore protocol implementation

hnix-store-core/src/System/Nix/Internal/Hash.hs

@@ -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)

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

@@ -35,12 +35,16 @@ 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           Control.Monad
+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.Derivation     as Drv
@@ -48,6 +52,7 @@ 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)