Merge branch 'cryptohash-sha256' into fewer-dependencies

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

@@ -17,10 +17,10 @@ extra-source-files:  ChangeLog.md, README.md
 cabal-version:       >=1.10
 
 library
-  exposed-modules:     Crypto.Hash.Truncated
-                     , System.Nix.Build
+  exposed-modules:     System.Nix.Build
                      , System.Nix.Derivation
                      , System.Nix.GC
+                     , System.Nix.Hash
                      , System.Nix.Nar
                      , System.Nix.Path
                      , System.Nix.Store
@@ -31,7 +31,7 @@ library
                      , binary
                      , bytestring
                      , containers
-                     , cryptonite
+                     , cryptohash-sha256
                      , directory
                      , filepath
                       -- Drop foundation when we can drop cryptonite <0.25
@@ -44,6 +44,7 @@ library
                      , text
                      , unix
                      , unordered-containers
+                     , vector
   hs-source-dirs:      src
   default-language:    Haskell2010
 

hnix-store-core/src/Crypto/Hash/Truncated.hs

@@ -1,66 +0,0 @@
-{-|
-Description : Trunctions of cryptographic hashes.
-Maintainer  : Shea Levy <shea@shealevy.com>
--}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE CPP #-}
-module Crypto.Hash.Truncated where
-
-import Control.Monad (void)
-import Data.Coerce (coerce)
-import Data.Proxy (Proxy(..))
-import Data.Word (Word8)
-import GHC.TypeLits (Nat, KnownNat, natVal, type (<=))
-import Crypto.Hash (Digest)
-import Crypto.Hash.IO (HashAlgorithm(..),)
-import Data.ByteArray (alloc)
-import Foreign.Ptr (castPtr, Ptr)
-import Foreign.Marshal.Utils (copyBytes)
-#if MIN_VERSION_cryptonite(0,25,0)
-import Basement.Block.Mutable (Block)
-#else
-import Foundation.Array (UArray)
-#endif
-
--- | Hash algorithm 'algo' truncated to 'size' bytes.
-newtype Truncated algo (size :: Nat) = Truncated algo
-
--- | The underlying type of a 'Digest'.
-#if MIN_VERSION_cryptonite(0,25,0)
-type DigestUnwrapped = Block Word8
-#else
-type DigestUnwrapped = UArray Word8
-#endif
-
--- | Use the 'HashAlgorithm' instance of 'algo' and truncate the final
--- digest.
---
--- The implementation of finalization does some pointer munging that
--- relies on the representational equivalence of a 'Digest' and
--- 'DigestUnwrapped', but there is no way for that to be enforced by
--- the type system. Until/unless cryptonite exports this, we will have
--- to be vigilant to changes in the type.
-instance ( HashAlgorithm algo, KnownNat (HashDigestSize algo)
-         , KnownNat size, size <= HashDigestSize algo
-         ) => HashAlgorithm (Truncated algo size) where
-  type HashBlockSize (Truncated algo size) = HashBlockSize algo
-  type HashDigestSize (Truncated algo size) = size
-  type HashInternalContextSize (Truncated algo size) =
-    HashInternalContextSize algo
-  hashBlockSize = hashBlockSize @algo . coerce
-  hashDigestSize _ = fromIntegral $ natVal @size Proxy
-  hashInternalContextSize = hashInternalContextSize @algo . coerce
-  hashInternalInit = hashInternalInit @algo . coerce
-  hashInternalUpdate = hashInternalUpdate @algo . coerce
-  hashInternalFinalize cptr dptr = void @_ @DigestUnwrapped $
-      alloc (fromIntegral $ natVal @(HashDigestSize algo) Proxy) go
-    where
-      go :: Ptr (Digest algo) -> IO ()
-      go p = do
-        hashInternalFinalize (coerce cptr) p
-        copyBytes dptr (castPtr p) (fromIntegral $ natVal @size Proxy)

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

@@ -0,0 +1,105 @@
+{-|
+Description : Nix-style hashes (truncated sha256)
+Maintainer  : Shea Levy <shea@shealevy.com>
+-}
+
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module System.Nix.Hash (
+
+  -- * Introduce hashes for the store
+    hash
+  , hashlazy
+  , fromBase32
+
+  -- * cryptohash-sha256 style incremental hash building
+  , init
+  , update
+  , finalize
+
+  -- * Internal
+  , StorePathHash (..)
+  , truncate52
+  , toNixBase32
+
+  ) where
+
+import qualified Crypto.Hash.SHA256           as SHA
+import           Data.Bits
+import qualified Data.ByteString              as BS
+import qualified Data.ByteString.Lazy         as BSL
+import qualified Data.ByteString.Lazy.Builder as BSL
+import           Data.Char
+import qualified Data.Hashable                as Hashable
+import           Data.Semigroup               ((<>))
+import           Data.Word
+import qualified Data.Vector.Unboxed          as UV
+import           Prelude                      hiding (init)
+
+-- | A string, file, or NAR hash in the format
+--   used in prefixing files in the nix store
+newtype StorePathHash =
+  StorePathHash { getTruncatedHash :: BS.ByteString }
+  deriving (Eq, Hashable.Hashable, Ord, Show)
+
+
+init :: SHA.Ctx
+init = SHA.init
+
+
+update :: SHA.Ctx -> BS.ByteString -> SHA.Ctx
+update = SHA.update
+
+
+finalize :: SHA.Ctx -> StorePathHash
+finalize ctx = StorePathHash . truncate52 $ SHA.finalize ctx
+
+
+hash :: BS.ByteString -> StorePathHash
+hash bs = StorePathHash . BSL.toStrict . toNixBase32 . BSL.fromStrict . truncate' $ SHA.hash bs
+
+
+hashlazy :: BSL.ByteString -> StorePathHash
+hashlazy bs = StorePathHash . BSL.toStrict . toNixBase32 . BSL.fromStrict . truncate' $ SHA.hashlazy bs
+
+
+-- | Import and validate a store path hash
+fromBase32 :: BS.ByteString -> Maybe StorePathHash
+fromBase32 = validateRawDigest . StorePathHash
+  where validateRawDigest = Just
+  -- TODO: What should we check for? Only valid base32 chars?
+
+
+
+truncate52
+  :: BS.ByteString
+     -- ^ A sha256 hash
+  -> BS.ByteString
+truncate52 digest =
+  -- Truncate 52 bits by dropping 6 bytes worth of Word8's,
+  -- then masking 4 bits off of the 7th Word8
+  case BS.uncons (BS.drop (52 `div` 8) digest) of
+    Nothing     -> BS.empty -- We received an hash with unexpectedly short length
+    Just (x,xs) -> BS.cons (mask4bits .&. x) xs
+    where mask4bits = 2^5 - 1 :: Word8
+
+truncate' :: BS.ByteString -> BS.ByteString
+truncate' = BS.take 20
+
+
+-- | Convert a ByteString to base 32 in the way that Nix does
+toNixBase32 :: BSL.ByteString -> BSL.ByteString
+toNixBase32 x = BSL.toLazyByteString $ mconcat $ map (BSL.word8 . (symbols UV.!) . fromIntegral) vals
+  where vals = byteStringToQuintets x
+        symbols = UV.fromList $ map (fromIntegral . ord) $ filter (`notElem` ("eotu" :: String)) $ ['0'..'9'] <> ['a'..'z']
+        -- See https://github.com/NixOS/nix/blob/6f1743b1a5116ca57a60b481ee4083c891b7a334/src/libutil/hash.cc#L109
+        byteStringToQuintets :: BSL.ByteString -> [Word8]
+        byteStringToQuintets hash = map f [len-1, len-2 .. 0]
+          where hashSize = fromIntegral $ BSL.length hash
+                len = (hashSize * 8 - 1) `div` 5 + 1
+                f n = let b = n * 5
+                          (i, j) = b `divMod` 8
+                          j' = fromIntegral j
+                          --TODO: This is probably pretty slow; replace with something that doesn't use BSL.index
+                          c = ((hash `BSL.index` i) `shift` (-j')) .|. (if i >= hashSize - 1 then 0 else (hash `BSL.index` (i + 1)) `shift` (8 - j'))
+                      in c .&. 0x1f

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

@@ -6,33 +6,28 @@ Maintainer  : Shea Levy <shea@shealevy.com>
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module System.Nix.Path
   ( FilePathPart(..)
-  , PathHashAlgo
   , Path(..)
   , PathSet
   , SubstitutablePathInfo(..)
   , ValidPathInfo(..)
   , PathName(..)
+  , Roots
   , filePathPart
   , pathName
-  , Roots
   ) where
 
-import           Crypto.Hash               (Digest)
-import           Crypto.Hash.Algorithms    (SHA256)
-import           Crypto.Hash.Truncated     (Truncated)
-import qualified Data.ByteArray            as B
-import qualified Data.ByteString           as BS
+
 import qualified Data.ByteString.Char8     as BSC
 import           Data.Hashable             (Hashable (..), hashPtrWithSalt)
-import           Data.HashMap.Strict       (HashMap)
 import           Data.HashSet              (HashSet)
 import           Data.Map.Strict           (Map)
 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           (StorePathHash, toNixBase32)
+
 -- | The name portion of a Nix path.
 --
 -- Must be composed of a-z, A-Z, 0-9, +, -, ., _, ?, and =, can't
@@ -52,24 +47,15 @@ pathName n = case matchTest nameRegex n of
   True  -> Just $ PathName n
   False -> Nothing
 
--- | The hash algorithm used for store path hashes.
-type PathHashAlgo = Truncated SHA256 20
 
 -- | A path in a store.
-data Path = Path !(Digest PathHashAlgo) !PathName
+data Path = Path !StorePathHash !PathName
   deriving (Eq, Ord, Show)
 
--- | Wrapper to defined a 'Hashable' instance for 'Digest'.
-newtype HashableDigest a = HashableDigest (Digest a)
-
-instance Hashable (HashableDigest a) where
-  hashWithSalt s (HashableDigest d) = unsafeDupablePerformIO $
-    B.withByteArray d $ \ptr -> hashPtrWithSalt ptr (B.length d) s
-
 instance Hashable Path where
   hashWithSalt s (Path digest name) =
     s `hashWithSalt`
-    (HashableDigest digest) `hashWithSalt` name
+    digest `hashWithSalt` name
 
 
 type PathSet = HashSet Path
@@ -87,7 +73,7 @@ data SubstitutablePathInfo = SubstitutablePathInfo
     narSize      :: !Integer
   } deriving (Eq, Ord, Show)
 
--- | Information about @Path@
+-- | Information about 'Path'.
 data ValidPathInfo = ValidPathInfo
   { -- | Path itself
     path             :: !Path

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

@@ -6,14 +6,11 @@ Maintainer  : Shea Levy <shea@shealevy.com>
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module System.Nix.Store
   ( PathName, pathNameContents, pathName
-  , PathHashAlgo, Path(..)
+  , Path(..)
   , StoreEffects(..)
   , SubstitutablePathInfo(..)
   ) where
 
-import Crypto.Hash (Digest)
-import Crypto.Hash.Truncated (Truncated)
-import Crypto.Hash.Algorithms (SHA256)
 import qualified Data.ByteString.Lazy as BS
 import qualified Data.ByteArray as B
 import Data.Text (Text)
@@ -24,6 +21,7 @@ import Data.HashSet (HashSet)
 import Data.HashMap.Strict (HashMap)
 import System.IO.Unsafe (unsafeDupablePerformIO)
 
+import System.Nix.Hash
 import System.Nix.Path
 import System.Nix.Nar
 
@@ -63,7 +61,7 @@ data StoreEffects rootedPath validPath m =
     , -- | Get the output names of the derivation at a 'Path'.
       derivationOutputNames :: !(validPath -> m (HashSet Text))
     , -- | Get a full 'Path' corresponding to a given 'Digest'.
-      pathFromHashPart :: !(Digest PathHashAlgo -> m Path)
+      pathFromHashPart :: !(StorePathHash -> m Path)
     , -- | Add a non-nar file to the store
       addFile :: !(BS.ByteString -> m validPath)
     }

hnix-store-core/tests/Hash.hs

@@ -0,0 +1,22 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Hash where
+
+import qualified Data.ByteString.Char8 as BSC
+import           Data.Foldable
+import           Data.Semigroup
+import           Test.Tasty.Hspec
+import           Test.Tasty.HUnit
+import           System.Nix.Hash
+
+spec_hashBase32truncateParity :: Spec
+spec_hashBase32truncateParity = describe "hashBase32" $
+  for_ testCases $ \(testCase, expectation) ->
+    it ("computes correct base32 hash for string " <> BSC.unpack testCase) $
+    getTruncatedHash (hash testCase) `shouldBe` expectation
+  where
+    testCases :: [(BSC.ByteString, BSC.ByteString)]
+    testCases = []
+      -- [ ("hello", "hcv22wi9b082i6qy160jgi9cvw3am153") ]
+      -- TODO: This test fails.
+      -- See [issue #24](https://github.com/haskell-nix/hnix-store/issues/24)

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

@@ -29,12 +29,8 @@ library
                      , unix
                      , network
                      , mtl
-                     , cryptonite
                      , unordered-containers
                      , memory
---                   , pretty-simple
---                   , base16-bytestring
---                   , base32-bytestring
                      , hnix-store-core
   hs-source-dirs:      src
   default-language:    Haskell2010

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

@@ -39,6 +39,7 @@ 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
 import           System.Nix.Path
 import           System.Nix.Util
 
@@ -46,7 +47,6 @@ import           System.Nix.Store.Remote.Types
 import           System.Nix.Store.Remote.Protocol
 import           System.Nix.Store.Remote.Util
 
-import           Crypto.Hash
 
 type RepairFlag = Bool
 type CheckFlag = Bool
@@ -148,10 +148,10 @@ queryDerivationOutputNames p = do
   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 :: StorePathHash -> MonadStore (Maybe Path)
 queryPathFromHashPart d = do
   runOpArgs QueryPathFromHashPart $
-    putByteStringLen $ LBS.fromStrict $ convert d
+    putByteStringLen $ LBS.fromStrict $ getTruncatedHash d
   sockGetPath
 
 type Source = () -- abstract binary source
@@ -159,8 +159,8 @@ addToStoreNar :: ValidPathInfo -> Source -> RepairFlag -> CheckSigsFlag -> Monad
 addToStoreNar = undefined  -- XXX
 
 type PathFilter = Path -> Bool
-addToStore :: LBS.ByteString -> Path -> Bool -> PathHashAlgo -> PathFilter -> RepairFlag -> MonadStore Path
-addToStore name pth recursive hashAlgo pfilter repair = undefined -- XXX
+addToStore :: LBS.ByteString -> Path -> Bool -> PathFilter -> RepairFlag -> MonadStore Path
+addToStore name pth recursive pfilter repair = undefined -- XXX
 
 addTextToStore :: LBS.ByteString -> LBS.ByteString -> PathSet -> RepairFlag -> MonadStore (Maybe Path)
 addTextToStore name text references' repair = do

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

@@ -14,11 +14,11 @@ import qualified Data.HashSet              as HashSet
 
 import           Network.Socket.ByteString (recv, sendAll)
 
+import           System.Nix.Hash
 import           System.Nix.Store.Remote.Types
 import           System.Nix.Path
 import           System.Nix.Util
 
-import           Crypto.Hash
 
 genericIncremental :: (MonadIO m) => m (Maybe B.ByteString) -> Get a -> m a
 genericIncremental getsome parser = go decoder