Merge #157: migration (cryptohash-* -> cryptonite)

2024-12-13 23:56:37 +03:00 · 2021-06-10 15:27:16 +03:00 · 2021-06-10 15:27:16 +03:00 · ad4642bf4b
commit ad4642bf4b
parent 35da3c9ae1 e4948a9fe1
17 changed files with 335 additions and 282 deletions
--- a/hnix-store-core/ChangeLog.md
+++ b/hnix-store-core/ChangeLog.md
@ -1,9 +1,41 @@
-# Revision history for hnix-store-core
+# ChangeLog
+
+## WIP
+
+* Breaking:
+
+  * [(link)](https://github.com/haskell-nix/hnix-store/pull/157/commits/97146b41cc87327625e02b81971aeb2fd7d66a3f) Migration from packages `cryptohash-` -> `cryptonite`:
+    `System.Nix.Hash`:
+      * rm `data HashAlgorithm` in favour of `cryptonite: class HashAlgorithm`
+      * rm `class ValidAlgo` in favour of `cryptonite: class HashAlgorithm`.
+      * `class NamedAlgo` removed `hashSize` in favour of `cryptonite: class HashAlgorithm: hashDigestSize`. Former became a subclas of the latter.
+      * rm `hash` in favour of `cryptonite: hash`
+      * rm `hashLazy` in favour of `cryptonite: hashlazy`
+  * [(link)](https://github.com/haskell-nix/hnix-store/pull/157/commits/2af74986de8aef1a13dbfc955886f9935ca246a3) `System.Nix.Hash`: Base encoding/decoding function for hashes changed (due to changes in type system & separation of specially truncated Nix Store hasing):
+    * `encode(InBase -> DigestWith)`
+    * `decode(Base -> DigestWith)`
+  * [(link)](https://github.com/haskell-nix/hnix-store/pull/157/commits/2af74986de8aef1a13dbfc955886f9935ca246a3) `System.Nix.StorePath`:
+    * rm `type StorePathHashAlgo = 'Truncated 20 'SHA256` in favour of `StorePathHashPart` & `mkStorePathHashPart`.
+    * rm `unStorePathName`, please use `GHC: coerce` for `StorePathName <-> Text`, `StorePathName` data constructor is provided.
+  * `Internal` modules now have export lists, if something, please contact.
+
+
+* Additional:
+
+  * [(link)](https://github.com/haskell-nix/hnix-store/pull/157/commits/2af74986de8aef1a13dbfc955886f9935ca246a3) `System.Nix.StorePath`:
+    * exposed `StorePathName` data constructor to API.
+    * added `newtype StorePathHashPart = StorePathHashPart ByteString`.
+      * added builder `mkStorePathHashPart :: ByteString -> StorePathHashPart`
+  * [(link)](https://github.com/haskell-nix/hnix-store/pull/157/commits/2af74986de8aef1a13dbfc955886f9935ca246a3) `System.Nix.Hash`:
+    * Nix store (which are specially truncated) hashes are now handled separately from other hashes:
+      * add `mkStorePathHash` - a function to create a content into Nix storepath-style hash:
+        `mkStorePathHash :: HashAlgorithm a => ByteString -> ByteString`
+        but recommend to at once use `mkStorePathHashPart`.
+    

 ## [0.4.3.0](https://github.com/haskell-nix/hnix-store/compare/0.4.2.0...0.4.3.0) 2021-05-30

 * Additional:
-
  * [(link)](https://github.com/haskell-nix/hnix-store/commit/b85f7c875fe6b0bca939ffbcd8b9bd0ab1598aa0) `System.Nix.ReadonlyStore`: add a readonly `computeStorePathForPath`
  * [(link)](https://github.com/haskell-nix/hnix-store/commit/db71ecea3109c0ba270fa98a9041a8556e35217f) `System.Nix.ReadonlyStore`: `computeStorePathForPath`: force SHA256 as it's the only valid choice
  * [(link)](https://github.com/haskell-nix/hnix-store/commit/5fddf3c66ba1bcabb72c4d6b6e09fb41a7acd62c): `makeTextPath`: order the references
--- a/hnix-store-core/hnix-store-core.cabal
+++ b/hnix-store-core/hnix-store-core.cabal
@ -33,7 +33,9 @@ library
    , System.Nix.Build
    , System.Nix.Derivation
    , System.Nix.Hash
+    , System.Nix.Internal.Base
    , System.Nix.Internal.Base32
+    , System.Nix.Internal.Truncation
    , System.Nix.Internal.Hash
    , System.Nix.Internal.Nar.Parser
    , System.Nix.Internal.Nar.Streamer
@ -54,10 +56,9 @@ library
    , bytestring
    , cereal
    , containers
-    , cryptohash-md5
-    , cryptohash-sha1
-    , cryptohash-sha256
-    , cryptohash-sha512
+    -- Required for cryptonite low-level type convertion
+    , memory
+    , cryptonite
    , directory
    , filepath
    , hashable
@ -104,6 +105,7 @@ test-suite format-tests
    , binary
    , bytestring
    , containers
+    , cryptonite
    , directory
    , filepath
    , process
--- a/hnix-store-core/src/System/Nix/Hash.hs
+++ b/hnix-store-core/src/System/Nix/Hash.hs
@ -2,21 +2,17 @@
 Description : Cryptographic hashes for hnix-store.
 -}
 module System.Nix.Hash
-  ( Hash.Digest
-
-  , Hash.HashAlgorithm(..)
-  , Hash.ValidAlgo(..)
+  ( Hash.mkStorePathHash
  , Hash.NamedAlgo(..)
  , Hash.SomeNamedDigest(..)

-  , Hash.hash
-  , Hash.hashLazy
  , Hash.mkNamedDigest

-  , Hash.BaseEncoding(..)
-  , Hash.encodeInBase
-  , Hash.decodeBase
+  , Base.BaseEncoding(..)
+  , Hash.encodeDigestWith
+  , Hash.decodeDigestWith
  )
 where

 import qualified System.Nix.Internal.Hash      as Hash
+import qualified System.Nix.Internal.Base      as Base
--- a/hnix-store-core/src/System/Nix/Internal/Base.hs
+++ b/hnix-store-core/src/System/Nix/Internal/Base.hs
@ -0,0 +1,45 @@
+{-# LANGUAGE CPP #-}
+
+module System.Nix.Internal.Base
+  ( BaseEncoding(Base16,NixBase32,Base64)
+  , encodeWith
+  , decodeWith
+  )
+where
+
+import qualified Data.Text              as T
+import qualified Data.Text.Encoding     as T
+import qualified Data.ByteString        as Bytes
+import qualified Data.ByteString.Base16 as Base16
+import qualified System.Nix.Base32      as Base32  -- Nix has own Base32 encoding
+import qualified Data.ByteString.Base64 as Base64
+
+-- | Constructors to indicate the base encodings
+data BaseEncoding
+  = NixBase32
+  -- | ^ Nix has a special map of Base32 encoding
+  -- Placed first, since it determines Haskell optimizations of pattern matches, & NixBase seems be the most widely used in Nix.
+  | Base16
+  | Base64
+
+
+-- | Encode @ByteString@ with @Base@ encoding, produce @Text@.
+encodeWith :: BaseEncoding -> Bytes.ByteString -> T.Text
+encodeWith Base16 = T.decodeUtf8 . Base16.encode
+encodeWith NixBase32 = Base32.encode
+encodeWith Base64 = T.decodeUtf8 . Base64.encode
+
+-- | Take the input & @Base@ encoding witness -> decode into @Text@.
+decodeWith :: BaseEncoding -> T.Text -> Either String Bytes.ByteString
+#if MIN_VERSION_base16_bytestring(1,0,0)
+decodeWith Base16 = Base16.decode . T.encodeUtf8
+#else
+decodeWith Base16 = lDecode  -- this tacit sugar simply makes GHC pleased with number of args
+ where
+  lDecode t =
+    case Base16.decode (T.encodeUtf8 t) of
+      (x, "") -> pure $ x
+      _       -> Left $ "Unable to decode base16 string" <> T.unpack t
+#endif
+decodeWith NixBase32 = Base32.decode
+decodeWith Base64 = Base64.decode . T.encodeUtf8
--- a/hnix-store-core/src/System/Nix/Internal/Base32.hs
+++ b/hnix-store-core/src/System/Nix/Internal/Base32.hs
@ -1,4 +1,9 @@
-module System.Nix.Internal.Base32 where
+module System.Nix.Internal.Base32
+ ( encode
+ , decode
+ , digits32
+ )
+where


 import           Data.Bool                      ( bool )
@ -22,7 +27,7 @@ digits32 = Vector.fromList "0123456789abcdfghijklmnpqrsvwxyz"

 -- | Encode a 'BS.ByteString' in Nix's base32 encoding
 encode :: ByteString -> Text
-encode c = Data.Text.pack $ fmap char32 [nChar - 1, nChar - 2 .. 0]
+encode c = Data.Text.pack $ takeCharPosFromDict <$> [nChar - 1, nChar - 2 .. 0]
 where
  -- Each base32 character gives us 5 bits of information, while
  -- each byte gives is 8. Because 'div' rounds down, we need to add
@ -43,8 +48,8 @@ encode c = Data.Text.pack $ fmap char32 [nChar - 1, nChar - 2 .. 0]
      [ fromIntegral (byte j) * (256 ^ j)
        | j <- [0 .. Bytes.length c - 1] ]

-  char32 :: Integer -> Char
-  char32 i = digits32 Vector.! digitInd
+  takeCharPosFromDict :: Integer -> Char
+  takeCharPosFromDict i = digits32 Vector.! digitInd
   where
    digitInd =
      fromIntegral $
@ -54,7 +59,7 @@ encode c = Data.Text.pack $ fmap char32 [nChar - 1, nChar - 2 .. 0]
 decode :: Text -> Either String ByteString
 decode what =
  bool
-    (Left "Invalid Base32 string")
+    (Left "Invalid NixBase32 string")
    (unsafeDecode what)
    (Data.Text.all (`elem` digits32) what)

--- a/hnix-store-core/src/System/Nix/Internal/Hash.hs
+++ b/hnix-store-core/src/System/Nix/Internal/Hash.hs
@ -12,223 +12,96 @@ Description : Cryptographic hashing interface for hnix-store, on top
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE CPP #-}

-module System.Nix.Internal.Hash where
+module System.Nix.Internal.Hash
+  ( NamedAlgo(..)
+  , SomeNamedDigest(..)
+  , mkNamedDigest
+  , encodeDigestWith
+  , decodeDigestWith
+  , mkStorePathHash
+  )
+where

-import qualified Crypto.Hash.MD5        as MD5
-import qualified Crypto.Hash.SHA1       as SHA1
-import qualified Crypto.Hash.SHA256     as SHA256
-import qualified Crypto.Hash.SHA512     as SHA512
+import qualified Crypto.Hash            as C
 import qualified Data.ByteString        as BS
-import qualified Data.ByteString.Base16 as Base16
-import qualified System.Nix.Base32      as Base32  -- Nix has own Base32 encoding
-import qualified Data.ByteString.Base64 as Base64
-import           Data.Bits              (xor)
-import qualified Data.ByteString.Lazy   as BSL
-import qualified Data.Hashable          as DataHashable
-import           Data.List              (foldl')
-import           Data.Proxy             (Proxy(Proxy))
 import           Data.Text              (Text)
 import qualified Data.Text              as T
-import qualified Data.Text.Encoding     as T
-import           Data.Word              (Word8)
-import           GHC.TypeLits           (Nat, KnownNat, natVal)
-import           Data.Coerce            (coerce)
-
-- | Constructors to indicate the base encodings
-data BaseEncoding
-  = Base16
-  | Base32
-  -- | ^ Nix has a special map of Base32 encoding
-  | Base64
-
-- | The universe of supported hash algorithms.
--
-- Currently only intended for use at the type level.
-data HashAlgorithm
-  = MD5
-  | SHA1
-  | SHA256
-  | SHA512
-  | Truncated Nat HashAlgorithm
-    -- ^ The hash algorithm obtained by truncating the result of the
-    -- input 'HashAlgorithm' to the given number of bytes. See
-    -- 'truncateDigest' for a description of the truncation algorithm.
-
-- | The result of running a 'HashAlgorithm'.
-newtype Digest (a :: HashAlgorithm) =
-  Digest BS.ByteString deriving (Eq, Ord, DataHashable.Hashable)
-
-instance Show (Digest a) where
-  show = ("Digest " <>) . show . encodeInBase Base32
-
-- | The primitive interface for incremental hashing for a given
-- 'HashAlgorithm'. Every 'HashAlgorithm' should have an instance.
-class ValidAlgo (a :: HashAlgorithm) where
-  -- | The incremental state for constructing a hash.
-  type AlgoCtx a
-
-  -- | Start building a new hash.
-  initialize        :: AlgoCtx a
-  -- | Append a 'BS.ByteString' to the overall contents to be hashed.
-  update            :: AlgoCtx a -> BS.ByteString -> AlgoCtx a
-  -- | Finish hashing and generate the output.
-  finalize          :: AlgoCtx a -> Digest a
+import           System.Nix.Internal.Base
+import           Data.ByteArray
+import           System.Nix.Internal.Truncation

 -- | A 'HashAlgorithm' with a canonical name, for serialization
 -- purposes (e.g. SRI hashes)
-class ValidAlgo a => NamedAlgo (a :: HashAlgorithm) where
+class C.HashAlgorithm a => NamedAlgo a where
  algoName :: Text
-  hashSize :: Int

-instance NamedAlgo 'MD5 where
+instance NamedAlgo C.MD5 where
  algoName = "md5"
-  hashSize = 16

-instance NamedAlgo 'SHA1 where
+instance NamedAlgo C.SHA1 where
  algoName = "sha1"
-  hashSize = 20

-instance NamedAlgo 'SHA256 where
+instance NamedAlgo C.SHA256 where
  algoName = "sha256"
-  hashSize = 32

-instance NamedAlgo 'SHA512 where
+instance NamedAlgo C.SHA512 where
  algoName = "sha512"
-  hashSize = 64

 -- | A digest whose 'NamedAlgo' is not known at compile time.
-data SomeNamedDigest = forall a . NamedAlgo a => SomeDigest (Digest a)
+data SomeNamedDigest = forall a . NamedAlgo a => SomeDigest (C.Digest a)

 instance Show SomeNamedDigest where
  show sd = case sd of
-    SomeDigest (digest :: Digest hashType) -> T.unpack $ "SomeDigest " <> algoName @hashType <> ":" <> encodeInBase Base32 digest
+    SomeDigest (digest :: C.Digest hashType) -> T.unpack $ "SomeDigest " <> algoName @hashType <> ":" <> encodeDigestWith NixBase32 digest

 mkNamedDigest :: Text -> Text -> Either String SomeNamedDigest
 mkNamedDigest name sriHash =
  let (sriName, h) = T.breakOnEnd "-" sriHash in
-    if sriName == "" || sriName == (name <> "-")
+    if sriName == "" || sriName == name <> "-"
    then mkDigest h
    else Left $ T.unpack $ "Sri hash method " <> sriName <> " does not match the required hash type " <> name
 where
  mkDigest h = case name of
-    "md5"    -> SomeDigest <$> decodeGo @'MD5    h
-    "sha1"   -> SomeDigest <$> decodeGo @'SHA1   h
-    "sha256" -> SomeDigest <$> decodeGo @'SHA256 h
-    "sha512" -> SomeDigest <$> decodeGo @'SHA512 h
+    "md5"    -> SomeDigest <$> decodeGo C.MD5    h
+    "sha1"   -> SomeDigest <$> decodeGo C.SHA1   h
+    "sha256" -> SomeDigest <$> decodeGo C.SHA256 h
+    "sha512" -> SomeDigest <$> decodeGo C.SHA512 h
    _        -> Left $ "Unknown hash name: " <> T.unpack name
-  decodeGo :: forall a . (NamedAlgo a, ValidAlgo a) => Text -> Either String (Digest a)
-  decodeGo h
-    | size == base16Len = decodeBase Base16 h
-    | size == base32Len = decodeBase Base32 h
-    | size == base64Len = decodeBase Base64 h
+  decodeGo :: forall a . NamedAlgo a => a -> Text -> Either String (C.Digest a)
+  decodeGo a h
+    | size == base16Len = decodeDigestWith Base16 h
+    | size == base32Len = decodeDigestWith NixBase32 h
+    | size == base64Len = decodeDigestWith Base64 h
    | otherwise = Left $ T.unpack sriHash <> " is not a valid " <> T.unpack name <> " hash. Its length (" <> show size <> ") does not match any of " <> show [base16Len, base32Len, base64Len]
   where
    size = T.length h
-    hsize = hashSize @a
+    hsize = C.hashDigestSize a
    base16Len = hsize * 2
    base32Len = ((hsize * 8 - 1) `div` 5) + 1;
    base64Len = ((4 * hsize `div` 3) + 3) `div` 4 * 4;


-- | Hash an entire (strict) 'BS.ByteString' as a single call.
--
--   For example:
--   > let d = hash "Hello, sha-256!" :: Digest SHA256
--   or
--   > :set -XTypeApplications
--   > let d = hash @SHA256 "Hello, sha-256!"
-hash :: forall a.ValidAlgo a => BS.ByteString -> Digest a
-hash bs =
-  finalize $ update @a (initialize @a) bs
-
-- | Hash an entire (lazy) 'BSL.ByteString' as a single call.
--
-- Use is the same as for 'hash'.  This runs in constant space, but
-- forces the entire bytestring.
-hashLazy :: forall a.ValidAlgo a => BSL.ByteString -> Digest a
-hashLazy bsl =
-  finalize $ foldl' (update @a) (initialize @a) (BSL.toChunks bsl)
-
+mkStorePathHash :: forall a . C.HashAlgorithm a => BS.ByteString -> BS.ByteString
+mkStorePathHash bs =
+  truncateInNixWay 20 $ convert $ C.hash @BS.ByteString @a bs

 -- | Take BaseEncoding type of the output -> take the Digeest as input -> encode Digest
-encodeInBase :: BaseEncoding -> Digest a -> T.Text
-encodeInBase Base16 = T.decodeUtf8 . Base16.encode . coerce
-encodeInBase Base32 = Base32.encode . coerce
-encodeInBase Base64 = T.decodeUtf8 . Base64.encode . coerce
+encodeDigestWith :: BaseEncoding -> C.Digest a -> T.Text
+encodeDigestWith b = encodeWith b . convert


 -- | Take BaseEncoding type of the input -> take the input itself -> decodeBase into Digest
-decodeBase :: BaseEncoding -> T.Text -> Either String (Digest a)
-#if MIN_VERSION_base16_bytestring(1,0,0)
-decodeBase Base16 = fmap Digest . Base16.decode . T.encodeUtf8
-#else
-decodeBase Base16 = lDecode  -- this tacit sugar simply makes GHC pleased with number of args
+decodeDigestWith :: C.HashAlgorithm a => BaseEncoding -> T.Text -> Either String (C.Digest a)
+decodeDigestWith b x =
+  do
+    bs <- decodeWith b x
+    let
+      toEither =
+        maybeToRight
+          ("Cryptonite was not able to convert '(ByteString -> Digest a)' for: '" <> show bs <>"'.")
+    (toEither . C.digestFromByteString) bs
 where
-  lDecode t = case Base16.decode (T.encodeUtf8 t) of
-    (x, "") -> Right $ Digest x
-    _       -> Left $ "Unable to decode base16 string" <> T.unpack t
-#endif
-decodeBase Base32 = fmap Digest . Base32.decode
-decodeBase Base64 = fmap Digest . Base64.decode . T.encodeUtf8
-
-
-- | Uses "Crypto.Hash.MD5" from cryptohash-md5.
-instance ValidAlgo 'MD5 where
-  type AlgoCtx 'MD5 = MD5.Ctx
-  initialize = MD5.init
-  update = MD5.update
-  finalize = Digest . MD5.finalize
-
-- | Uses "Crypto.Hash.SHA1" from cryptohash-sha1.
-instance ValidAlgo 'SHA1 where
-  type AlgoCtx 'SHA1 = SHA1.Ctx
-  initialize = SHA1.init
-  update = SHA1.update
-  finalize = Digest . SHA1.finalize
-
-- | Uses "Crypto.Hash.SHA256" from cryptohash-sha256.
-instance ValidAlgo 'SHA256 where
-  type AlgoCtx 'SHA256 = SHA256.Ctx
-  initialize = SHA256.init
-  update = SHA256.update
-  finalize = Digest . SHA256.finalize
-
-- | Uses "Crypto.Hash.SHA512" from cryptohash-sha512.
-instance ValidAlgo 'SHA512 where
-  type AlgoCtx 'SHA512 = SHA512.Ctx
-  initialize = SHA512.init
-  update = SHA512.update
-  finalize = Digest . SHA512.finalize
-
-- | Reuses the underlying 'ValidAlgo' instance, but does a
-- 'truncateDigest' at the end.
-instance (ValidAlgo a, KnownNat n) => ValidAlgo ('Truncated n a) where
-  type AlgoCtx ('Truncated n a) = AlgoCtx a
-  initialize = initialize @a
-  update = update @a
-  finalize = truncateDigest @n . finalize @a
-
-- | Bytewise truncation of a 'Digest'.
--
-- 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.(KnownNat n) => Digest a -> Digest ('Truncated n a)
-truncateDigest (Digest c) =
-    Digest $ BS.pack $ fmap 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
+  -- To not depend on @extra@
+  maybeToRight :: b -> Maybe a -> Either b a
+  maybeToRight _ (Just r) = pure r
+  maybeToRight y Nothing  = Left y
--- a/hnix-store-core/src/System/Nix/Internal/Nar/Parser.hs
+++ b/hnix-store-core/src/System/Nix/Internal/Nar/Parser.hs
@ -7,7 +7,13 @@
 {-# LANGUAGE TupleSections              #-}
 {-# LANGUAGE TypeFamilies               #-}

-module System.Nix.Internal.Nar.Parser where
+module System.Nix.Internal.Nar.Parser
+  ( runParser
+  , parseNar
+  , testParser
+  , testParser'
+  )
+where

 import qualified Algebra.Graph                   as Graph
 import qualified Algebra.Graph.ToGraph           as Graph
--- a/hnix-store-core/src/System/Nix/Internal/Nar/Streamer.hs
+++ b/hnix-store-core/src/System/Nix/Internal/Nar/Streamer.hs
@ -3,7 +3,11 @@
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE ScopedTypeVariables #-}

-module System.Nix.Internal.Nar.Streamer where
+module System.Nix.Internal.Nar.Streamer
+  ( streamNarIO
+  , IsExecutable(..)
+  )
+where

 import           Control.Monad                    ( forM_
                                                  , when
--- a/hnix-store-core/src/System/Nix/Internal/Signature.hs
+++ b/hnix-store-core/src/System/Nix/Internal/Signature.hs
@ -4,7 +4,11 @@ Description : Nix-relevant interfaces to NaCl signatures.
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE CPP #-}

-module System.Nix.Internal.Signature where
+module System.Nix.Internal.Signature
+  ( Signature
+  , NarSignature(..)
+  )
+where


 import           Data.ByteString                    ( ByteString )
--- a/hnix-store-core/src/System/Nix/Internal/StorePath.hs
+++ b/hnix-store-core/src/System/Nix/Internal/StorePath.hs
@ -1,29 +1,40 @@
 {-|
 Description : Representation of Nix store paths.
 -}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE TypeInType #-} -- Needed for GHC 8.4.4 for some reason
-
-module System.Nix.Internal.StorePath where
-import           System.Nix.Hash                ( HashAlgorithm
-                                                  ( Truncated
-                                                  , SHA256
-                                                  )
-                                                , Digest
-                                                , BaseEncoding(..)
-                                                , encodeInBase
-                                                , decodeBase
-                                                , SomeNamedDigest
-                                                )
-
+{-# LANGUAGE DataKinds #-}

+module System.Nix.Internal.StorePath
+  ( -- * Basic store path types
+    StorePath(..)
+  , StorePathName(..)
+  , StorePathSet
+  , mkStorePathHashPart
+  , StorePathHashPart(..)
+  , ContentAddressableAddress(..)
+  , NarHashMode(..)
+  , -- * Manipulating 'StorePathName'
+    makeStorePathName
+  , validStorePathName
+  , -- * Rendering out 'StorePath's
+    storePathToFilePath
+  , storePathToRawFilePath
+  , storePathToText
+  , storePathToNarInfo
+  , -- * Parsing 'StorePath's
+    parsePath
+  , pathParser
+  )
+where
+import           System.Nix.Internal.Hash
+import           System.Nix.Internal.Base
 import qualified System.Nix.Internal.Base32    as Nix.Base32
-                                                ( digits32 )

 import           Data.ByteString                ( ByteString )
 import qualified Data.ByteString.Char8         as Bytes.Char8
@ -39,6 +50,10 @@ import qualified Data.Attoparsec.Text.Lazy     as Parser.Text.Lazy
 import qualified System.FilePath               as FilePath
 import           Data.Hashable                  ( Hashable(..) )
 import           Data.HashSet                   ( HashSet )
+import           Data.Coerce                    ( coerce )
+import           Crypto.Hash                    ( SHA256
+                                                , Digest
+                                                )

 -- | A path in a Nix store.
 --
@ -52,7 +67,7 @@ import           Data.HashSet                   ( HashSet )
 data StorePath = StorePath
  { -- | The 160-bit hash digest reflecting the "address" of the name.
    -- Currently, this is a truncated SHA256 hash.
-    storePathHash :: !(Digest StorePathHashAlgo)
+    storePathHash :: !StorePathHashPart
  , -- | The (typically human readable) name of the path. For packages
    -- this is typically the package name and version (e.g.
    -- hello-1.2.3).
@ -80,7 +95,11 @@ newtype StorePathName = StorePathName
  } deriving (Eq, Hashable, Ord)

 -- | The hash algorithm used for store path hashes.
-type StorePathHashAlgo = 'Truncated 20 'SHA256
+newtype StorePathHashPart = StorePathHashPart ByteString
+  deriving (Eq, Hashable, Ord, Show)
+
+mkStorePathHashPart :: ByteString -> StorePathHashPart
+mkStorePathHashPart = coerce . mkStorePathHash @SHA256

 -- | A set of 'StorePath's.
 type StorePathSet = HashSet StorePath
@ -98,7 +117,7 @@ data ContentAddressableAddress
  = -- | The path is a plain file added via makeTextPath or
    -- addTextToStore. It is addressed according to a sha256sum of the
    -- file contents.
-    Text !(Digest 'SHA256)
+    Text !(Digest SHA256)
  | -- | The path was added to the store via makeFixedOutputPath or
    -- addToStore. It is addressed according to some hash algorithm
    -- applied to the nar serialization via some 'NarHashMode'.
@ -118,7 +137,7 @@ data NarHashMode
 makeStorePathName :: Text -> Either String StorePathName
 makeStorePathName n =
  if validStorePathName n
-    then Right $ StorePathName n
+    then pure $ StorePathName n
    else Left $ reasonInvalid n

 reasonInvalid :: Text -> String
@ -154,7 +173,7 @@ storePathToRawFilePath StorePath{..} =
  root <> "/" <> hashPart <> "-" <> name
 where
  root     = Bytes.Char8.pack storePathRoot
-  hashPart = Text.encodeUtf8 $ encodeInBase Base32 storePathHash
+  hashPart = Text.encodeUtf8 $ encodeWith NixBase32 $ coerce storePathHash
  name     = Text.encodeUtf8 $ unStorePathName storePathName

 -- | Render a 'StorePath' as a 'FilePath'.
@ -169,7 +188,7 @@ storePathToText = Text.pack . Bytes.Char8.unpack . storePathToRawFilePath
 -- can be used to query binary caches.
 storePathToNarInfo :: StorePath -> Bytes.Char8.ByteString
 storePathToNarInfo StorePath{..} =
-  Text.encodeUtf8 $ encodeInBase Base32 storePathHash <> ".narinfo"
+  Text.encodeUtf8 $ encodeWith NixBase32 (coerce storePathHash) <> ".narinfo"

 -- | Parse `StorePath` from `Bytes.Char8.ByteString`, checking
 -- that store directory matches `expectedRoot`.
@ -177,8 +196,8 @@ parsePath :: FilePath -> Bytes.Char8.ByteString -> Either String StorePath
 parsePath expectedRoot x =
  let
    (rootDir, fname) = FilePath.splitFileName . Bytes.Char8.unpack $ x
-    (digestPart, namePart) = Text.breakOn "-" $ Text.pack fname
-    digest = decodeBase Base32 digestPart
+    (storeBasedHashPart, namePart) = Text.breakOn "-" $ Text.pack fname
+    storeHash = decodeWith NixBase32 storeBasedHashPart
    name = makeStorePathName . Text.drop 1 $ namePart
    --rootDir' = dropTrailingPathSeparator rootDir
    -- cannot use ^^ as it drops multiple slashes /a/b/// -> /a/b
@ -188,7 +207,7 @@ parsePath expectedRoot x =
        then Right rootDir'
        else Left $ "Root store dir mismatch, expected" <> expectedRoot <> "got" <> rootDir'
  in
-    StorePath <$> digest <*> name <*> storeDir
+    StorePath <$> coerce storeHash <*> name <*> storeDir

 pathParser :: FilePath -> Parser StorePath
 pathParser expectedRoot = do
@ -200,7 +219,7 @@ pathParser expectedRoot = do
      <?> "Expecting path separator"

  digest <-
-    decodeBase Base32
+    decodeWith NixBase32
    <$> Parser.Text.Lazy.takeWhile1 (`elem` Nix.Base32.digits32)
      <?> "Invalid Base32 part"

@ -219,4 +238,4 @@ pathParser expectedRoot = do
  either
    fail
    pure
-    (StorePath <$> digest <*> name <*> pure expectedRoot)
+    (StorePath <$> coerce digest <*> name <*> pure expectedRoot)
--- a/hnix-store-core/src/System/Nix/Internal/Truncation.hs
+++ b/hnix-store-core/src/System/Nix/Internal/Truncation.hs
@ -0,0 +1,44 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE DataKinds           #-}
+
+module System.Nix.Internal.Truncation
+  ( truncateInNixWay
+  )
+where
+
+import qualified Data.ByteString        as Bytes
+import           Data.Bits              (xor)
+import           Data.List              (foldl')
+import           Data.Word              (Word8)
+import           Data.Bool                 (bool)
+
+-- | Bytewise truncation of a 'Digest'.
+--
+-- 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'.
+truncateInNixWay
+  :: Int -> Bytes.ByteString -> Bytes.ByteString
+--  2021-06-07: NOTE: Renamed function, since truncation can be done in a lot of ways, there is no practice of truncting hashes this way, moreover:
+-- 1. <https://crypto.stackexchange.com/questions/56337/strength-of-hash-obtained-by-xor-of-parts-of-sha3>
+-- 2. <https://www.reddit.com/r/crypto/comments/6olqfm/ways_to_truncated_hash/>
+truncateInNixWay n c =
+    Bytes.pack $ fmap truncOutputByte [0 .. n-1]
+  where
+
+    truncOutputByte :: Int -> Word8
+    truncOutputByte i = foldl' (aux i) 0 [0 .. Bytes.length c - 1]
+
+    inputByte :: Int -> Word8
+    inputByte j = Bytes.index c j
+
+    aux :: Int -> Word8 -> Int -> Word8
+    aux i x j =
+      bool
+        id
+        (`xor` inputByte j)
+        (j `mod` n == i)
+        x
--- a/hnix-store-core/src/System/Nix/ReadonlyStore.hs
+++ b/hnix-store-core/src/System/Nix/ReadonlyStore.hs
@ -16,35 +16,45 @@ import           System.Nix.Hash
 import           System.Nix.Nar
 import           System.Nix.StorePath
 import           Control.Monad.State.Strict
+import           Data.Coerce                    ( coerce )
+import           Crypto.Hash                    ( Context
+                                                , Digest
+                                                , hash
+                                                , hashlazy
+                                                , hashInit
+                                                , hashUpdate
+                                                , hashFinalize
+                                                , SHA256
+                                                )


 makeStorePath
-  :: forall hashAlgo
-   . (NamedAlgo hashAlgo)
+  :: forall h
+   . (NamedAlgo h)
  => FilePath
  -> ByteString
-  -> Digest hashAlgo
+  -> Digest h
  -> StorePathName
  -> StorePath
-makeStorePath fp ty h nm = StorePath storeHash nm fp
+makeStorePath fp ty h nm = StorePath (coerce storeHash) nm fp
 where
-  storeHash = hash s
+  storeHash = mkStorePathHash @h s

  s =
    BS.intercalate ":" $
      ty:fmap encodeUtf8
-        [ algoName @hashAlgo
-        , encodeInBase Base16 h
+        [ algoName @h
+        , encodeDigestWith Base16 h
        , T.pack fp
-        , unStorePathName nm
+        , coerce nm
        ]

 makeTextPath
-  :: FilePath -> StorePathName -> Digest 'SHA256 -> StorePathSet -> StorePath
+  :: FilePath -> StorePathName -> Digest SHA256 -> StorePathSet -> StorePath
 makeTextPath fp nm h refs = makeStorePath fp ty h nm
 where
  ty =
-    BS.intercalate ":" ("text" : sort (fmap storePathToRawFilePath (HS.toList refs)))
+    BS.intercalate ":" $ "text" : sort (storePathToRawFilePath <$> HS.toList refs)

 makeFixedOutputPath
  :: forall hashAlgo
@ -60,11 +70,11 @@ makeFixedOutputPath fp recursive h =
    else makeStorePath fp "output:out" h'
 where
  h' =
-    hash @'SHA256
+    hash @ByteString @SHA256
      $  "fixed:out:"
      <> encodeUtf8 (algoName @hashAlgo)
      <> (if recursive then ":r:" else ":")
-      <> encodeUtf8 (encodeInBase Base16 h)
+      <> encodeUtf8 (encodeDigestWith Base16 h)
      <> ":"

 computeStorePathForText
@ -82,10 +92,10 @@ computeStorePathForPath name pth recursive _pathFilter _repair = do
  selectedHash <- if recursive then recursiveContentHash else flatContentHash
  pure $ makeFixedOutputPath "/nix/store" recursive selectedHash name
 where
-  recursiveContentHash :: IO (Digest 'SHA256)
-  recursiveContentHash = finalize <$> execStateT streamNarUpdate (initialize @'SHA256)
-  streamNarUpdate :: StateT (AlgoCtx 'SHA256) IO ()
-  streamNarUpdate = streamNarIO (modify . flip (update @'SHA256)) narEffectsIO pth
+  recursiveContentHash :: IO (Digest SHA256)
+  recursiveContentHash = hashFinalize <$> execStateT streamNarUpdate (hashInit @SHA256)
+  streamNarUpdate :: StateT (Context SHA256) IO ()
+  streamNarUpdate = streamNarIO (modify . flip (hashUpdate @ByteString @SHA256)) narEffectsIO pth

-  flatContentHash :: IO (Digest 'SHA256)
-  flatContentHash = hashLazy <$> narReadFile narEffectsIO pth
+  flatContentHash :: IO (Digest SHA256)
+  flatContentHash = hashlazy <$> narReadFile narEffectsIO pth
--- a/hnix-store-core/src/System/Nix/StorePath.hs
+++ b/hnix-store-core/src/System/Nix/StorePath.hs
@ -4,14 +4,14 @@ Description : Representation of Nix store paths.
 module System.Nix.StorePath
  ( -- * Basic store path types
    StorePath(..)
-  , StorePathName
+  , StorePathName(..)
  , StorePathSet
-  , StorePathHashAlgo
+  , mkStorePathHashPart
+  , StorePathHashPart(..)
  , ContentAddressableAddress(..)
  , NarHashMode(..)
  , -- * Manipulating 'StorePathName'
    makeStorePathName
-  , unStorePathName
  , validStorePathName
  , -- * Rendering out 'StorePath's
    storePathToFilePath
--- a/hnix-store-core/tests/Arbitrary.hs
+++ b/hnix-store-core/tests/Arbitrary.hs
@ -1,3 +1,4 @@
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE FlexibleInstances    #-}
 {-# LANGUAGE DataKinds            #-}
 {-# OPTIONS_GHC -Wno-orphans      #-}
@ -10,10 +11,13 @@ import qualified Data.Text                     as T

 import           Test.Tasty.QuickCheck

-import           System.Nix.Hash
-import           System.Nix.Internal.Hash
-import           System.Nix.StorePath
 import           System.Nix.Internal.StorePath
+import           Control.Applicative                ( liftA3 )
+import           Data.Coerce                        ( coerce )
+import           Crypto.Hash                        ( SHA256
+                                                    , Digest
+                                                    , hash
+                                                    )

 genSafeChar :: Gen Char
 genSafeChar = choose ('\1', '\127') -- ASCII without \NUL
@ -22,7 +26,7 @@ nonEmptyString :: Gen String
 nonEmptyString = listOf1 genSafeChar

 dir :: Gen String
-dir = ('/':) <$> (listOf1 $ elements $ '/':['a'..'z'])
+dir = ('/':) <$> listOf1 (elements $ '/':['a'..'z'])

 instance Arbitrary StorePathName where
  arbitrary = StorePathName . T.pack <$> ((:) <$> s1 <*> listOf sn)
@ -31,10 +35,10 @@ instance Arbitrary StorePathName where
    s1       = elements $ alphanum <> "+-_?="
    sn       = elements $ alphanum <> "+-._?="

-instance Arbitrary (Digest StorePathHashAlgo) where
-  arbitrary = hash . BSC.pack <$> arbitrary
+instance Arbitrary StorePathHashPart where
+  arbitrary = mkStorePathHashPart . BSC.pack <$> arbitrary

-instance Arbitrary (Digest 'SHA256) where
+instance Arbitrary (Digest SHA256) where
  arbitrary = hash . BSC.pack <$> arbitrary

 newtype NixLike = NixLike {getNixLike :: StorePath}
@ -42,15 +46,19 @@ newtype NixLike = NixLike {getNixLike :: StorePath}

 instance Arbitrary NixLike where
  arbitrary =
-    NixLike
-      <$> (StorePath
-         <$> arbitraryTruncatedDigest
-         <*> arbitrary
-         <*> pure "/nix/store"
-        )
+    NixLike <$>
+      (liftA3 StorePath
+        arbitraryTruncatedDigest
+        arbitrary
+        (pure "/nix/store")
+      )
   where
    -- 160-bit hash, 20 bytes, 32 chars in base32
-    arbitraryTruncatedDigest = Digest . BSC.pack <$> replicateM 20 genSafeChar
+    arbitraryTruncatedDigest = coerce . BSC.pack <$> replicateM 20 genSafeChar

 instance Arbitrary StorePath where
-  arbitrary = StorePath <$> arbitrary <*> arbitrary <*> dir
+  arbitrary =
+    liftA3 StorePath
+      arbitrary
+      arbitrary
+      dir
--- a/hnix-store-core/tests/Derivation.hs
+++ b/hnix-store-core/tests/Derivation.hs
@ -20,11 +20,11 @@ processDerivation source dest = do
  contents <- Data.Text.IO.readFile source
  either
    fail
-    (\ drv ->
-      Data.Text.IO.writeFile dest
-        . Data.Text.Lazy.toStrict
-        . Data.Text.Lazy.Builder.toLazyText
-        $ buildDerivation drv
+    -- It seems to be derivation.
+    (Data.Text.IO.writeFile dest
+      . Data.Text.Lazy.toStrict
+      . Data.Text.Lazy.Builder.toLazyText
+      . buildDerivation
    )
    (Data.Attoparsec.Text.parseOnly
      (parseDerivation "/nix/store")
--- a/hnix-store-core/tests/Hash.hs
+++ b/hnix-store-core/tests/Hash.hs
@ -6,13 +6,13 @@

 module Hash where

-import           Control.Monad               (forM_)
+import           Control.Monad               ( forM_ )
+import           Data.ByteString             ( ByteString )
 import qualified Data.ByteString.Char8       as BSC
 import qualified Data.ByteString.Base16      as B16
 import qualified System.Nix.Base32           as B32
 import qualified Data.ByteString.Base64.Lazy as B64
 import qualified Data.ByteString.Lazy        as BSL
-import           Data.Text                   (Text)

 import           Test.Hspec
 import           Test.Tasty.QuickCheck
@ -20,6 +20,13 @@ import           Test.Tasty.QuickCheck
 import           System.Nix.Hash
 import           System.Nix.StorePath
 import           Arbitrary
+import           System.Nix.Internal.Base
+import           Data.Coerce                ( coerce )
+import           Crypto.Hash                ( MD5
+                                            , SHA1
+                                            , SHA256
+                                            , hash
+                                            )

 spec_hash :: Spec
 spec_hash = do
@ -27,13 +34,13 @@ 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 (encodeInBase Base32 (hash @'SHA256 "nix-output:foo"))
+      shouldBe (encodeDigestWith NixBase32 (hash @ByteString @SHA256 "nix-output:foo"))
               "1x0ymrsy7yr7i9wdsqy9khmzc1yy7nvxw6rdp72yzn50285s67j5"
    it "produces (base16 . md5) of \"Hello World\" the same as the thesis" $
-      shouldBe (encodeInBase Base16 (hash @'MD5 "Hello World"))
+      shouldBe (encodeDigestWith Base16 (hash @ByteString @MD5 "Hello World"))
               "b10a8db164e0754105b7a99be72e3fe5"
    it "produces (base32 . sha1) of \"Hello World\" the same as the thesis" $
-      shouldBe (encodeInBase Base32 (hash @'SHA1 "Hello World"))
+      shouldBe (encodeDigestWith NixBase32 (hash @ByteString @SHA1 "Hello World"))
               "s23c9fs0v32pf6bhmcph5rbqsyl5ak8a"

    -- The example in question:
@ -42,21 +49,17 @@ spec_hash = do
      let exampleStr =
            "source:sha256:2bfef67de873c54551d884fdab3055d84d573e654efa79db3"
            <> "c0d7b98883f9ee3:/nix/store:myfile"
-      shouldBe (encodeInBase32 @StorePathHashAlgo (hash exampleStr))
+      shouldBe (encodeWith NixBase32 $ coerce $ mkStorePathHashPart exampleStr)
        "xv2iccirbrvklck36f1g7vldn5v58vck"
-   where
-    encodeInBase32 :: Digest a -> Text
-    encodeInBase32 = encodeInBase Base32

 -- | Test that Nix-like base32 encoding roundtrips
 prop_nixBase32Roundtrip :: Property
 prop_nixBase32Roundtrip = forAllShrink nonEmptyString genericShrink $
-  \x -> Right (BSC.pack x) === (B32.decode . B32.encode . BSC.pack $ x)
+  \x -> pure (BSC.pack x) === (B32.decode . B32.encode . BSC.pack $ x)

 -- | API variants
-prop_nixBase16Roundtrip :: Digest StorePathHashAlgo -> Property
-prop_nixBase16Roundtrip =
-  \(x :: Digest StorePathHashAlgo) -> Right x === (decodeBase Base16 . encodeInBase Base16 $ x)
+prop_nixBase16Roundtrip :: StorePathHashPart -> Property
+prop_nixBase16Roundtrip x = pure (coerce x) === decodeWith Base16 (encodeWith Base16 $ coerce x)

 -- | Hash encoding conversion ground-truth.
 -- Similiar to nix/tests/hash.sh
--- a/hnix-store-core/tests/NarFormat.hs
+++ b/hnix-store-core/tests/NarFormat.hs
@ -26,9 +26,11 @@ import qualified Data.Map                         as Map
 import           Data.Maybe                       (fromMaybe)
 import qualified Data.Text                        as T
 import qualified Data.Text.Encoding               as E
-import           System.Directory                 (doesDirectoryExist, doesPathExist,
-                                                   removeDirectoryRecursive,
-                                                   removeFile)
+import           System.Directory                 ( doesDirectoryExist
+                                                  , doesPathExist
+                                                  , removeDirectoryRecursive
+                                                  , removeFile
+                                                  )
 import qualified System.Directory                 as Directory
 import           System.Environment               (getEnv)
 import           System.FilePath                  ((<.>), (</>))