WIP Merge branch 'master' into cleanup-store-record

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

@@ -24,9 +24,11 @@ library
                      , System.Nix.Internal.Hash
                      , System.Nix.Nar
                      , System.Nix.Path
+                     , System.Nix.ReadonlyStore
                      , System.Nix.Store
                      , System.Nix.Util
   build-depends:       base >=4.10
+                     , base16-bytestring
                      , bytestring
                      , binary
                      , bytestring
@@ -62,7 +64,7 @@ test-suite format-tests
        NarFormat
        Hash
    hs-source-dirs:
-       tests 
+       tests
    build-depends:
        hnix-store-core
      , base

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

@@ -12,10 +12,12 @@ Maintainer  : Shea Levy <shea@shealevy.com>; Greg Hale <imalsogreg@gmail.com>
 {-# LANGUAGE CPP #-}
 module System.Nix.Hash (
     HNix.Digest
-
   , HNix.HashAlgorithm(..)
+  , HNix.HashForm'(..)
+  , HNix.HashForm
   , HNix.NamedAlgorithm(..)
-  , HNix.NamedDigest(..)
+  , HNix.AnyDigest(..)
+  , HNix.AlgoVal(..)
   , HNix.HasDigest(..)
   , HNix.hash
   , HNix.hashLazy

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

@@ -2,50 +2,66 @@
 Description : Cryptographic hashes for hnix-store.
 Maintainer  : Greg Hale <imalsogreg@gmail.com>
 -}
-{-# LANGUAGE AllowAmbiguousTypes       #-}
-{-# LANGUAGE DataKinds                 #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE PolyKinds                 #-}
-{-# LANGUAGE RankNTypes                #-}
-{-# LANGUAGE TypeFamilies              #-}
-{-# LANGUAGE KindSignatures            #-}
-{-# LANGUAGE ScopedTypeVariables       #-}
-{-# LANGUAGE TypeApplications          #-}
-{-# LANGUAGE OverloadedStrings         #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE StandaloneDeriving        #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeInType #-}
 
 module System.Nix.Internal.Hash where
 
-import Data.Text (Text)
-import qualified Crypto.Hash.MD5       as MD5
-import qualified Crypto.Hash.SHA1      as SHA1
-import qualified Crypto.Hash.SHA256    as SHA256
-import qualified Data.ByteString       as BS
+import qualified Crypto.Hash.MD5 as MD5
+import qualified Crypto.Hash.SHA1 as SHA1
+import qualified Crypto.Hash.SHA256 as SHA256
+import           Data.Bits (xor)
+import           Data.Kind (Type)
+import           Data.List (foldl')
+import           Data.Monoid
+import           Data.Proxy (Proxy(Proxy))
+import           Data.Text (Text)
+import           Data.Word (Word8)
+import           Data.Text (Text)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base16 as Base16
 import qualified Data.ByteString.Char8 as BSC
-import           Data.Bits             (xor)
-import qualified Data.ByteString       as BS
-import qualified Data.ByteString.Lazy  as BSL
-import qualified Data.Hashable         as DataHashable
-import           Data.List             (foldl')
-import           Data.Proxy            (Proxy(Proxy))
-import qualified Data.Text             as T
-import qualified Data.Text.Encoding    as T
-import qualified Data.Vector           as V
-import           Data.Word             (Word8)
+import qualified Data.ByteString.Lazy as BSL
+import           Data.Hashable
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.Vector as V
 import           GHC.TypeLits
+import           Numeric.Natural
 
 -- | A tag for different hashing algorithms
 --   Also used as a type-level tag for hash digests
 --   (e.g. @Digest SHA256@ is the type for a sha256 hash)
+--
+--  When used at the type level, `n` is `Nat`
 data HashAlgorithm
   = MD5
   | SHA1
   | SHA256
-  | Truncated Nat HashAlgorithm
+  deriving (Eq, Ord, Show)
 
-class NamedAlgorithm (a :: HashAlgorithm) where
-  algorithmName :: Text
+data HashForm' n
+  = Plain HashAlgorithm
+  | Truncated n HashAlgorithm
+  deriving (Eq, Ord, Show)
+
+type HashForm = HashForm' Nat
+
+class HasDigest (Plain a) => NamedAlgorithm (a :: HashAlgorithm) where
+  algorithmName :: forall a. Text
 
 instance NamedAlgorithm 'MD5 where
   algorithmName = "md5"
@@ -62,9 +78,9 @@ instance NamedAlgorithm 'SHA256 where
 --
 --   Each instance defined here simply defers to one of the underlying
 --   monomorphic hashing libraries, such as `cryptohash-sha256`.
-class HasDigest (a :: HashAlgorithm) where
+class HasDigest (a :: HashForm) where
 
-  type AlgoCtx a :: *
+  type AlgoCtx a :: Type
 
   initialize        :: AlgoCtx a
   update            :: AlgoCtx a -> BS.ByteString -> AlgoCtx a
@@ -89,49 +105,57 @@ hashLazy :: forall a.HasDigest a => BSL.ByteString -> Digest a
 hashLazy bsl =
   finalize $ foldl' (update @a) (initialize @a) (BSL.toChunks bsl)
 
+digestText32 :: forall a. NamedAlgorithm a => Digest ('Plain a) -> T.Text
+digestText32 d = algorithmName @a <> ":" <> printAsBase32 d
 
-
+digestText16 :: forall a. NamedAlgorithm a => Digest ('Plain a) -> T.Text
+digestText16 (Digest bs) = algorithmName @a <> ":" <> T.decodeUtf8 (Base16.encode bs)
 
 -- | Convert any Digest to a base32-encoded string.
 --   This is not used in producing store path hashes
 printAsBase32 :: Digest a -> T.Text
 printAsBase32 (Digest bs) = printHashBytes32 bs
 
-
-instance HasDigest MD5 where
-  type AlgoCtx 'MD5 = MD5.Ctx
+instance HasDigest ('Plain 'MD5) where
+  type AlgoCtx (Plain 'MD5) = MD5.Ctx
   initialize = MD5.init
   update = MD5.update
   finalize = Digest . MD5.finalize
 
-instance HasDigest 'SHA1 where
-  type AlgoCtx SHA1 = SHA1.Ctx
+instance HasDigest ('Plain 'SHA1) where
+  type AlgoCtx (Plain SHA1) = SHA1.Ctx
   initialize = SHA1.init
   update = SHA1.update
   finalize = Digest . SHA1.finalize
 
-instance HasDigest 'SHA256 where
-  type AlgoCtx SHA256 = SHA256.Ctx
+instance HasDigest ('Plain 'SHA256) where
+  type AlgoCtx (Plain SHA256) = SHA256.Ctx
   initialize = SHA256.init
   update = SHA256.update
   finalize = Digest . SHA256.finalize
 
-instance (HasDigest a, KnownNat n) => HasDigest (Truncated n a) where
-  type AlgoCtx (Truncated n a) = AlgoCtx a
-  initialize = initialize @a
-  update = update @a
-  finalize = truncateDigest @n . finalize @a
+instance (HasDigest ('Plain a), KnownNat n) => HasDigest ('Truncated n a) where
+  type AlgoCtx ('Truncated n a) = AlgoCtx ('Plain a)
+  initialize = initialize @('Plain a)
+  update = update @('Plain a)
+  finalize = truncateDigest @n @a . finalize @('Plain a)
 
 -- | A raw hash digest, with a type-level tag
-newtype Digest (a :: HashAlgorithm) = Digest
+newtype Digest (a :: HashForm) = Digest
   { digestBytes :: BS.ByteString
     -- ^ The bytestring in a Digest is an opaque string of bytes,
     --   not some particular text encoding.
-  } deriving (Show, Eq, Ord, DataHashable.Hashable)
+  } deriving (Show, Eq, Ord, Hashable)
 
 -- | A digest from a named hash algorithm.
-data NamedDigest =
-  forall a . NamedAlgorithm a => NamedDigest (Digest a)
+data AnyDigest =
+  forall a . HasDigest a => AnyDigest (Digest a)
+
+--instance Show AnyDigest
+--instance Eq AnyDigest
+--instance Ord AnyDigest
+--instance Hashable AnyDigest where
+--  hashWithSalt salt (AnyDigest bs) = hashWithSalt salt bs
 
 -- instance DataHashable.Hashable (Digest a) where
 --   hashWithSalt a (Digest bs) = DataHashable.hashWithSalt a bs
@@ -143,8 +167,11 @@ data NamedDigest =
 printHashBytes32 :: BS.ByteString -> T.Text
 printHashBytes32 c = T.pack $ concatMap char32 [nChar - 1, nChar - 2 .. 0]
   where
-    -- The base32 encoding is 8/5's as long as the base256 digest
-    nChar = fromIntegral $ BS.length c * 8 `div` 5
+    -- The base32 encoding is 8/5's as long as the base256 digest.  This `+ 1`
+    -- `- 1` business is a bit odd, but has always been used in C++ since the
+    -- base32 truncation was added in was first added in
+    -- d58a11e019813902b6c4547ca61a127938b2cc20.
+    nChar = fromIntegral $ ((BS.length c * 8 - 1) `div` 5) + 1
 
     char32 :: Integer -> [Char]
     char32 i = [digits32 V.! digitInd]
@@ -163,7 +190,11 @@ printHashBytes32 c = T.pack $ concatMap char32 [nChar - 1, nChar - 2 .. 0]
 --   bytestring into a head part (truncation length) and tail part (leftover
 --   part) right-pads the leftovers with 0 to the truncation length, and
 --   combines the two strings bytewise with `xor`
-truncateDigest :: forall n a.(HasDigest a, KnownNat n) => Digest a -> Digest (Truncated n a)
+truncateDigest
+  :: forall n a
+  . (HasDigest ('Plain a), KnownNat n)
+  => Digest ('Plain a)
+  -> Digest (Truncated n a)
 truncateDigest (Digest c) = Digest $ BS.pack $ map truncOutputByte [0.. n-1]
   where
 
@@ -182,3 +213,26 @@ 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 :: forall a. HashAlgorithm
+
+instance AlgoVal MD5 where
+  algoVal = MD5
+
+instance AlgoVal SHA1 where
+  algoVal = SHA1
+
+instance AlgoVal SHA256 where
+  algoVal = SHA256
+
+class FormVal (a :: HashForm) where
+  formVal :: HashForm' Natural
+
+instance forall a. AlgoVal a => FormVal (Plain a) where
+  formVal = Plain $ algoVal @a
+
+instance forall a n. (AlgoVal a, KnownNat n) => FormVal (Truncated n a) where
+  formVal = Truncated (fromIntegral $ natVal (Proxy @n)) (algoVal @a)

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

@@ -3,14 +3,25 @@ Description : Types and effects for interacting with the Nix store.
 Maintainer  : Shea Levy <shea@shealevy.com>
 -}
 {-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE ExistentialQuantification  #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE KindSignatures             #-}
-{-# LANGUAGE ExistentialQuantification  #-}
-module System.Nix.Path where
+{-# LANGUAGE OverloadedStrings          #-}
+module System.Nix.Path
+  ( FilePathPart(..)
+  , filePathPart
+  , HashMode(..)
+  , PathInfo(..)
+  , Path(..)
+  , PathHashAlgo
+  , PathName(..)
+  , PathSet
+  , pathName
+  , pathToText
+  ) where
 
 import Data.Word
 import           GHC.TypeLits
-import           System.Nix.Hash
 import           Data.Time
 import qualified Data.ByteString           as BS
 import qualified Data.ByteString.Char8     as BSC
@@ -18,12 +29,20 @@ import           Data.Hashable             (Hashable (..), hashPtrWithSalt)
 import           Data.HashMap.Strict       (HashMap)
 import           Data.HashSet              (HashSet)
 import           Data.Map.Strict           (Map)
+import           Data.Monoid
 import           Data.Text                 (Text)
 import qualified Data.Text                 as T
 import           System.IO.Unsafe          (unsafeDupablePerformIO)
 import           Text.Regex.Base.RegexLike (makeRegex, matchTest)
 import           Text.Regex.TDFA.Text      (Regex)
 
+import           System.Nix.Hash
+import           System.Nix.Hash           (Digest(..),
+                                            HashAlgorithm(SHA256),
+                                            HashForm'(Truncated),
+                                            NamedAlgorithm)
+import           System.Nix.Internal.Hash
+
 -- | The hash algorithm used for store path hashes.
 type PathHashAlgo = 'Truncated 20 'SHA256
 
@@ -38,7 +57,7 @@ newtype PathName = PathName
 -- | A regular expression for matching a valid 'PathName'
 nameRegex :: Regex
 nameRegex =
-  makeRegex "[a-zA-Z0-9\\+\\-\\_\\?\\=][a-zA-Z0-9\\+\\-\\.\\_\\?\\=]*"
+  makeRegex ("[a-zA-Z0-9\\+\\-\\_\\?\\=][a-zA-Z0-9\\+\\-\\.\\_\\?\\=]*" :: String)
 
 -- | Construct a 'PathName', assuming the provided contents are valid.
 pathName :: Text -> Maybe PathName
@@ -47,23 +66,25 @@ pathName n = case matchTest nameRegex n of
   False -> Nothing
 
 -- | A path in a store.
---
--- @root@: The root path of the store (e.g. "/nix/store").
-data Path (root :: Symbol) = Path !(Digest PathHashAlgo) !PathName
+-- Does not include the path *to* the store, e.g. "/nix/store".
+data Path = Path !(Digest PathHashAlgo) !PathName
   deriving (Eq, Ord, Show)
 
-type PathSet root = HashSet (Path root)
+pathToText :: Text -> Path -> Text
+pathToText storeDir (Path h nm) = storeDir <> "/" <> printAsBase32 h <> "-" <> pathNameContents nm
+
+type PathSet = HashSet Path
 
 -- | Metadata about a valid @Path@ in the store.
-data PathInfo store = PathInfo
+data PathInfo = PathInfo
   { -- | Path itself
-    path             :: !(Path store)
+    path             :: !Path
   , -- | The .drv which led to this 'Path'.
-    deriver        :: !(Maybe (Path store))
+    deriver        :: !(Maybe Path)
   , -- | The hash of the serialization of this path.
-    narHash          :: !NamedDigest
+    narHash          :: !AnyDigest
   , -- | The references of the 'Path'.
-    references     :: !(PathSet store)
+    references     :: !PathSet
   , -- | When this store path was registered valid.
     registrationTime :: !UTCTime
   , -- | The size of the uncompressed NAR serialization of this
@@ -76,26 +97,36 @@ data PathInfo store = PathInfo
     sigs             :: ![Text] -- TODO better type?
   , -- | Whether or not the store path is content-addressed, and if so
     ca               :: !(Maybe ContentAddressedHash)
-  }
-
+  } --deriving (Eq, Ord, Show)
 
 -- | The different types of content-addressed hashing we have in Nix.
 data ContentAddressedHash
-  = RegularFile (Digest SHA256)
+  = RegularFile (Digest ('Plain 'SHA256))
     -- ^ A regular file hashed like sha256sum.
   | forall algo . NamedAlgorithm algo =>
-      FixedFile (HashMode algo) (Digest algo)
+      FixedFile HashMode (Digest (Plain algo))
       -- ^ A file hashed via the add-fixed-file-to-store approach.
       -- This can in fact overlap with RegularFile (if the 'HashMode'
       -- is 'Flat @SHA256'), but the resulting Nix store hash is
       -- different for stupid legacy reasons.
 
 -- | A specification of how to hash a file.
-data HashMode (a :: HashAlgorithm)
+data HashMode
   = Flat -- ^ Normal hashing of a regular file.
   | Recursive -- ^ Hashing of a serialization of a file, compatible
               -- with directories and executable files as well as
               -- regular files.
 
-instance Hashable (Path store) where
+instance Hashable Path where
   hashWithSalt s (Path hash name) = s `hashWithSalt` hash `hashWithSalt` name
+
+-- | A valid filename or directory name
+newtype FilePathPart = FilePathPart { unFilePathPart :: BSC.ByteString }
+  deriving (Eq, Ord, Show)
+
+-- | Construct FilePathPart from Text by checking that there
+--   are no '/' or '\\NUL' characters
+filePathPart :: BSC.ByteString -> Maybe FilePathPart
+filePathPart p = case BSC.any (`elem` ['/', '\NUL']) p of
+  False -> Just $ FilePathPart p
+  True  -> Nothing

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

@@ -0,0 +1,33 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+
+module System.Nix.ReadonlyStore where
+
+import           Data.ByteString (ByteString)
+import           Data.ByteString.Base16 as Base16
+import qualified Data.HashSet as HS
+import           Data.Text (Text)
+import qualified Data.Text as T
+import           Data.Text.Encoding
+import           System.Nix.Internal.Hash
+import           System.Nix.Path
+
+makeStorePath :: Text -> Text -> Digest ('Plain 'SHA256) -> Text -> Path
+makeStorePath storeDir ty h nm = Path storeHash (PathName nm)
+  where
+    s = T.intercalate ":"
+      [ ty
+      , digestText16 h
+      , storeDir
+      , nm
+      ]
+    storeHash = truncateDigest $ hash $ encodeUtf8 s
+
+makeTextPath :: Text -> Text -> Digest ('Plain 'SHA256) -> PathSet -> Path
+makeTextPath storeDir nm h refs = makeStorePath storeDir ty h nm
+  where
+    ty = T.intercalate ":" ("text" : map (pathToText storeDir) (HS.toList refs))
+
+computeStorePathForText :: Text -> Text -> ByteString -> PathSet -> Path
+computeStorePathForText storeDir nm s refs = makeTextPath storeDir nm (hash s) refs

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

@@ -8,6 +8,7 @@ Maintainer  : Shea Levy <shea@shealevy.com>
 module System.Nix.Store where
 
 import Data.ByteString.Lazy (ByteString)
+import Numeric.Natural (Natural)
 import System.Nix.Hash (NamedAlgorithm, HashAlgorithm)
 import System.Nix.Path
 import System.Nix.Nar
@@ -17,23 +18,23 @@ import System.Nix.Nar
 -- @root@: The root path of the store (e.g. "/nix/store").
 --
 -- @m@: The monad the effects operate in.
-data StoreEffects root m = StoreEffects
+data StoreEffects m = StoreEffects
   { regularFileToStore -- ^ Add a regular file to the store with the
                        -- given references, hashed with 'SHA256'.
       :: PathName -- ^ The name of the path.
       -> ByteString -- ^ The contents of the file.
-      -> PathSet root -- ^ The references of the path.
-      -> m (Path root) -- ^ The added store path.
+      -> PathSet -- ^ The references of the path.
+      -> m Path -- ^ The added store path.
   , fixedFileToStore -- ^ Add a fixed file (possibly not regular) to
                      -- the store with the diven hash algorithm.
-      :: forall a . (NamedAlgorithm a)
-      => PathName -- ^ The name of the path.
-      -> HashMode a -- ^ How to hash the file.
+      :: HashAlgorithm
+      -> PathName -- ^ The name of the path.
+      -> HashMode -- ^ How to hash the file.
       -> Nar -- ^ A nix archive dump of the file.
-      -> m (Path root)
+      -> m Path
   , importPath -- ^ Import a serialization of a valid path into the
                -- store.
-      :: PathInfo root -- ^ Store path metadata.
+      :: PathInfo -- ^ Store path metadata.
       -> Nar -- ^ A nix archive dump of file.
       -> Repair -- ^ Whether to overwrite the path if it is already
                 -- valid in the store.
@@ -42,7 +43,6 @@ data StoreEffects root m = StoreEffects
       -> m ()
   }
 
-
 -- | Flag to indicate whether a command should overwrite a specified
 -- path if it already exists (in an attempt to fix issues).
 data Repair = Repair | DontRepair

hnix-store-core/tests/Hash.hs

@@ -31,6 +31,10 @@ spec_hash = do
 
   describe "hashing parity with nix-store" $ do
 
+    it "produces (base32 . sha256) of \"nix-output:foo\" the same as Nix does at the moment for placeholder \"foo\"" $
+      shouldBe (printAsBase32 (hash @SHA256 "nix-output:foo"))
+               "1x0ymrsy7yr7i9wdsqy9khmzc1yy7nvxw6rdp72yzn50285s67j5"
+
     it "produces (base32 . sha1) of \"Hello World\" the same as the thesis" $
       shouldBe (printAsBase32 (hash @SHA1 "Hello World"))
                "s23c9fs0v32pf6bhmcph5rbqsyl5ak8a"

hnix-store-remote/app/Main.hs

@@ -1,13 +1,15 @@
 {-# LANGUAGE OverloadedStrings   #-}
 import qualified Data.ByteString.Lazy as LBS
-import qualified Data.HashSet as HS
-import qualified System.Nix.GC as GC
-import System.Nix.Store.Remote
-import System.Nix.Store.Remote.Util
-import Data.Maybe
-import Control.Monad.Reader
+import qualified Data.HashSet         as HS
+import           Data.Maybe
+import           Control.Monad.Reader
+import           Text.Pretty.Simple
+import           Data.Proxy
 
-import Text.Pretty.Simple
+import qualified System.Nix.GC                as GC
+import           System.Nix.Path              (PathHashAlgo)
+import           System.Nix.Store.Remote
+import           System.Nix.Store.Remote.Util
 
 noSuchPath = fromJust $ mkPath "blah"
 
@@ -17,19 +19,27 @@ main = do
 
     verifyStore False False
 
-    (Just path) <- addTextToStore "hnix-store" "test" (HS.fromList [])  False
+    (Just path)  <- addTextToStore "hnix-store" "test" (HS.fromList [])  False
+
+    -- (Just path2) <-  addTextToStore "hnix-store2" "test2" (HS.fromList [])  False
+    path2 <- addToStore "hi-test-file"
+      "/home/greghale/code/hnix-store/hnix-store-remote/hi"
+      False (Proxy :: Proxy PathHashAlgo) (const True) False
 
     valid <- isValidPathUncached path
-    case valid of
-      True -> do
+    valid2 <- isValidPathUncached path2
+
+    case (valid, valid2) of
+      (True, True) -> do
         info <- queryPathInfoUncached path
-        return (path, info)
+        info2 <- queryPathInfoUncached path2
+        return (path, info, path2, info2)
       _ -> error "shouldn't happen"
 
   pPrint x
   case x of
     (Left err, log) -> putStrLn err >> print log
-    (Right (path, pathinfo), log) -> do
+    (Right (path, pathinfo, path2, pathinfo2), log) -> do
       gcres <- runStore $ do
         collectGarbage $ GC.Options
           { GC.operation = GC.DeleteSpecific

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

@@ -21,6 +21,7 @@ library
                      , System.Nix.Store.Remote.Util
 
   build-depends:       base >=4.10
+                     , base64-bytestring
                      , bytestring
                      , binary
                      , bytestring

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

@@ -1,4 +1,10 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE KindSignatures      #-}
 {-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications    #-}
 module System.Nix.Store.Remote (
     runStore
   , isValidPathUncached
@@ -29,23 +35,33 @@ 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, narEffectsIO)
 import           System.Nix.Util
 
 import           System.Nix.Store.Remote.Types
 import           System.Nix.Store.Remote.Protocol
 import           System.Nix.Store.Remote.Util
 
+-- tmp
+import qualified Data.ByteString.Base64.Lazy as B64
+
 type RepairFlag = Bool
 type CheckFlag = Bool
 type CheckSigsFlag = Bool
@@ -159,9 +175,43 @@ type Source = () -- abstract binary source
 addToStoreNar :: ValidPathInfo -> Source -> RepairFlag -> CheckSigsFlag -> MonadStore ()
 addToStoreNar = undefined  -- XXX
 
+printHashType :: HashAlgorithm' Integer -> T.Text
+printHashType MD5             = "MD5"
+printHashType SHA1            = "SHA1"
+printHashType SHA256          = "SHA256"
+printHashType (Truncated _ a) = printHashType a
+
 type PathFilter = Path -> Bool
-addToStore :: LBS.ByteString -> Path -> Bool -> HashAlgorithm -> PathFilter -> RepairFlag -> MonadStore Path
-addToStore name pth recursive hashAlgo pfilter repair = undefined -- XXX
+
+addToStore
+  :: forall a. (HasDigest a, AlgoVal 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
+    if algoVal @a `elem` [SHA256, Truncated 20 SHA256] && recursive
+      then putInt 0
+      else putInt 1
+    if recursive
+      then putInt 1
+      else putInt 0
+
+    putByteStringLen (T.encodeUtf8 . T.toLower . printHashType $ algoVal @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

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

@@ -127,6 +127,13 @@ runOp op = runOpArgs op $ return ()
 
 runOpArgs :: WorkerOp -> Put -> MonadStore ()
 runOpArgs op args = do
+
+  -- Temporary hack for printing the messages destined for nix-daemon socket
+  when False $
+    liftIO $ LBS.writeFile "mytestfile2" $ runPut $ do
+      putInt $ opNum op
+      args
+
   sockPut $ do
     putInt $ opNum op
     args

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

@@ -15,6 +15,7 @@ import qualified Data.HashSet              as HashSet
 import           Network.Socket.ByteString (recv, sendAll)
 
 import           System.Nix.Store.Remote.Types
+import           System.Nix.Hash
 import           System.Nix.Path
 import           System.Nix.Util
 
@@ -73,7 +74,7 @@ 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 (undefined $ LBS.toStrict p) x --XXX: hash
+             Just x -> Just $ Path (hash $ LBS.toStrict p) x --XXX: hash
              Nothing -> Nothing
 
 -- WOOT