Merge pull request #28 from haskell-nix/store-hash-api

Add basic hashing API

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

@@ -21,6 +21,7 @@ library
                      , System.Nix.Derivation
                      , System.Nix.GC
                      , System.Nix.Hash
+                     , System.Nix.Internal.Hash
                      , System.Nix.Nar
                      , System.Nix.Path
                      , System.Nix.Store
@@ -30,6 +31,9 @@ library
                      , binary
                      , bytestring
                      , containers
+                     , cryptohash-md5
+                     , cryptohash-sha1
+                     , cryptohash-sha256
                      , directory
                      , filepath
                      , hashable
@@ -39,6 +43,7 @@ library
                      , text
                      , unix
                      , unordered-containers
+                     , vector
   hs-source-dirs:      src
   default-language:    Haskell2010
 
@@ -54,6 +59,7 @@ test-suite format-tests
    main-is: Driver.hs
    other-modules:
        NarFormat
+       Hash
    hs-source-dirs:
        tests 
    build-depends:
@@ -70,5 +76,6 @@ test-suite format-tests
      , tasty-hspec
      , tasty-hunit
      , tasty-quickcheck
+     , temporary
      , text
    default-language: Haskell2010

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

@@ -1,30 +1,25 @@
 {-|
-Description : Trunctions of cryptographic hashes.
-Maintainer  : Shea Levy <shea@shealevy.com>
+Description : Cryptographic hashes for hnix-store.
+Maintainer  : Shea Levy <shea@shealevy.com>; Greg Hale <imalsogreg@gmail.com>
 -}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE CPP #-}
-module System.Nix.Hash where
+module System.Nix.Hash (
+    HNix.Digest
 
-import Control.Monad (void)
-import Data.Coerce (coerce)
-import qualified Data.ByteString as BS
-import Data.Hashable (Hashable (..))
-import Data.Proxy (Proxy(..))
-import Data.Word (Word8)
-import GHC.TypeLits (Nat, KnownNat, natVal, type (<=))
-import Foreign.Ptr (castPtr, Ptr)
-import Foreign.Marshal.Utils (copyBytes)
+  , HNix.HashAlgorithm(..)
+  , HNix.HasDigest(..)
+  , HNix.hash
+  , HNix.hashLazy
 
-data HashAlgorithm = TruncatedSHA256 | MD5
+  , HNix.printAsBase32
+  ) where
 
-newtype Digest (algo :: HashAlgorithm) = Digest { getDigestBytes :: BS.ByteString }
-  deriving (Eq, Ord, Show)
+import qualified System.Nix.Internal.Hash as HNix
 
-instance Hashable (Digest algo) where
-  hashWithSalt s (Digest bytes) = hashWithSalt s bytes

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

@@ -0,0 +1,166 @@
+{-|
+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    #-}
+
+module System.Nix.Internal.Hash where
+
+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 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           GHC.TypeLits
+
+-- | 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)
+data HashAlgorithm
+  = MD5
+  | SHA1
+  | SHA256
+  | Truncated Nat HashAlgorithm
+
+
+-- | Types with kind @HashAlgorithm@ may be a @HasDigest@ instance
+--   if they are able to hash bytestrings via the init/update/finalize
+--   API of cryptonite
+--
+--   Each instance defined here simply defers to one of the underlying
+--   monomorphic hashing libraries, such as `cryptohash-sha256`.
+class HasDigest (a :: HashAlgorithm) where
+
+  type AlgoCtx a :: *
+
+  initialize        :: AlgoCtx a
+  update            :: AlgoCtx a -> BS.ByteString -> AlgoCtx a
+  finalize          :: AlgoCtx a -> Digest a
+
+
+-- | The cryptographic hash of of a strict bytestring, where hash
+--   algorithm is chosen by the type of the digest
+--   For example:
+--   > let d = hash "Hello, sha-256!" :: Digest SHA256
+--   or
+--   > :set -XTypeApplications
+--   > let d = hash @SHA256 "Hello, sha-256!"
+hash :: forall a.HasDigest a => BS.ByteString -> Digest a
+hash bs =
+  finalize $ update @a (initialize @a) bs
+
+-- | The cryptographic hash of a lazy bytestring. Use is the same
+--   as for @hash@. This runs in constant space, but forces the
+--   entire bytestring
+hashLazy :: forall a.HasDigest a => BSL.ByteString -> Digest a
+hashLazy bsl =
+  finalize $ foldl' (update @a) (initialize @a) (BSL.toChunks bsl)
+
+
+
+
+-- | 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
+  initialize = MD5.init
+  update = MD5.update
+  finalize = Digest . MD5.finalize
+
+instance HasDigest 'SHA1 where
+  type AlgoCtx SHA1 = SHA1.Ctx
+  initialize = SHA1.init
+  update = SHA1.update
+  finalize = Digest . SHA1.finalize
+
+instance HasDigest 'SHA256 where
+  type AlgoCtx 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
+
+-- | A raw hash digest, with a type-level tag
+newtype Digest (a :: HashAlgorithm) = 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)
+
+
+-- instance DataHashable.Hashable (Digest a) where
+--   hashWithSalt a (Digest bs) = DataHashable.hashWithSalt a bs
+--   hashWithSalt = coerce . DataHash
+
+
+-- | Internal function for encoding bytestrings into base32 according to
+--  nix's convention
+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
+
+    char32 :: Integer -> [Char]
+    char32 i = [digits32 V.! digitInd]
+      where
+        byte j   = BS.index c (fromIntegral j)
+        digitInd = fromIntegral $
+                   sum [fromIntegral (byte j) * (256^j)
+                       | j <- [0 .. BS.length c - 1]]
+                   `div` (32^i)
+                   `mod` 32
+
+
+-- | Internal function for producing the bitwise truncation of bytestrings.
+--   When truncation length is greater than the length of the bytestring,
+--   but less than twice the bytestring length, truncation splits the
+--   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 (Digest c) = Digest $ BS.pack $ map truncOutputByte [0.. n-1]
+  where
+
+    n = fromIntegral $ natVal (Proxy @n)
+
+    truncOutputByte :: Int -> Word8
+    truncOutputByte i = foldl' (aux i) 0 [0 .. BS.length c - 1]
+
+    inputByte :: Int -> Word8
+    inputByte j = BS.index c (fromIntegral j)
+
+    aux :: Int -> Word8 -> Int -> Word8
+    aux i x j = if j `mod` fromIntegral n == fromIntegral i
+                then xor x (inputByte $ fromIntegral j)
+                else x
+
+digits32 :: V.Vector Char
+digits32 = V.fromList "0123456789abcdfghijklmnpqrsvwxyz"

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

@@ -18,7 +18,7 @@ module System.Nix.Path
   ) where
 
 import           System.Nix.Hash           (Digest(..),
-                                            HashAlgorithm(TruncatedSHA256))
+                                            HashAlgorithm(Truncated, SHA256))
 import qualified Data.ByteString           as BS
 import qualified Data.ByteString.Char8     as BSC
 import           Data.Hashable             (Hashable (..), hashPtrWithSalt)
@@ -32,7 +32,8 @@ import           Text.Regex.Base.RegexLike (makeRegex, matchTest)
 import           Text.Regex.TDFA.Text      (Regex)
 
 -- | The hash algorithm used for store path hashes.
-type PathHashAlgo = TruncatedSHA256
+type PathHashAlgo = Truncated 20 SHA256
+
 
 -- | The name portion of a Nix path.
 --

hnix-store-core/tests/Hash.hs

@@ -0,0 +1,45 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications    #-}
+
+module Hash where
+
+import           Control.Monad.IO.Class      (liftIO)
+import           Control.Exception           (bracket)
+import qualified Data.ByteString             as BS
+import qualified Data.ByteString.Base64.Lazy as B64
+import qualified Data.ByteString.Lazy        as BSL
+import           Data.Monoid                 ((<>))
+import qualified Data.Text                   as T
+import           System.Directory            (removeFile)
+import           System.IO.Temp              (withSystemTempFile, writeSystemTempFile)
+import qualified System.IO                   as IO -- (hGetContents, hPutStr, openFile)
+import qualified System.Process              as P
+import           Test.Tasty                  as T
+import           Test.Tasty.Hspec
+import qualified Test.Tasty.HUnit            as HU
+import           Test.Tasty.QuickCheck
+import           Text.Read                   (readMaybe)
+
+import           System.Nix.Hash
+import           System.Nix.Path
+import           NarFormat -- TODO: Move the fixtures into a common module
+
+spec_hash :: Spec
+spec_hash = do
+
+  describe "hashing parity with nix-store" $ do
+
+    it "produces (base32 . sha1) of \"Hello World\" the same as the thesis" $
+      shouldBe (printAsBase32 (hash @SHA1 "Hello World"))
+               "s23c9fs0v32pf6bhmcph5rbqsyl5ak8a"
+
+    -- The example in question:
+    -- https://nixos.org/nixos/nix-pills/nix-store-paths.html
+    it "produces same base32 as nix pill flat file example" $ do
+      let exampleStr =
+            "source:sha256:2bfef67de873c54551d884fdab3055d84d573e654efa79db3"
+            <> "c0d7b98883f9ee3:/nix/store:myfile"
+      shouldBe (printAsBase32 @PathHashAlgo (hash exampleStr))
+        "xv2iccirbrvklck36f1g7vldn5v58vck"