mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-09-11 18:05:56 +03:00
Reflect type level hash algo to value
This commit is contained in:
parent
9f98592e79
commit
6f1626a0ef
@ -13,7 +13,9 @@ Maintainer : Shea Levy <shea@shealevy.com>; Greg Hale <imalsogreg@gmail.com>
|
||||
module System.Nix.Hash (
|
||||
HNix.Digest
|
||||
|
||||
, HNix.HashAlgorithm(..)
|
||||
, HNix.HashAlgorithm
|
||||
, HNix.HashAlgorithm'(..)
|
||||
, HNix.AlgoVal(..)
|
||||
, HNix.HasDigest(..)
|
||||
, HNix.hash
|
||||
, HNix.hashLazy
|
||||
|
@ -11,6 +11,7 @@ Maintainer : Greg Hale <imalsogreg@gmail.com>
|
||||
{-# LANGUAGE KindSignatures #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeInType #-}
|
||||
|
||||
module System.Nix.Internal.Hash where
|
||||
|
||||
@ -23,6 +24,7 @@ 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.Kind (Type)
|
||||
import Data.List (foldl')
|
||||
import Data.Proxy (Proxy(Proxy))
|
||||
import qualified Data.Text as T
|
||||
@ -34,12 +36,31 @@ 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
|
||||
--
|
||||
-- When used at the type level, `n` is `Nat`
|
||||
data HashAlgorithm' n
|
||||
= MD5
|
||||
| SHA1
|
||||
| SHA256
|
||||
| Truncated Nat HashAlgorithm
|
||||
| Truncated n (HashAlgorithm' n)
|
||||
deriving (Eq, Show)
|
||||
|
||||
type HashAlgorithm = HashAlgorithm' Nat
|
||||
|
||||
class AlgoVal (a :: HashAlgorithm) where
|
||||
algoVal :: HashAlgorithm' Integer
|
||||
|
||||
instance AlgoVal MD5 where
|
||||
algoVal = MD5
|
||||
|
||||
instance AlgoVal SHA1 where
|
||||
algoVal = SHA1
|
||||
|
||||
instance AlgoVal SHA256 where
|
||||
algoVal = SHA256
|
||||
|
||||
instance forall a n.(AlgoVal a, KnownNat n) => AlgoVal (Truncated n a) where
|
||||
algoVal = Truncated (natVal (Proxy @n)) (algoVal @a)
|
||||
|
||||
-- | Types with kind @HashAlgorithm@ may be a @HasDigest@ instance
|
||||
-- if they are able to hash bytestrings via the init/update/finalize
|
||||
@ -49,7 +70,7 @@ data HashAlgorithm
|
||||
-- monomorphic hashing libraries, such as `cryptohash-sha256`.
|
||||
class HasDigest (a :: HashAlgorithm) where
|
||||
|
||||
type AlgoCtx a :: *
|
||||
type AlgoCtx a :: Type
|
||||
|
||||
initialize :: AlgoCtx a
|
||||
update :: AlgoCtx a -> BS.ByteString -> AlgoCtx a
|
||||
|
@ -18,7 +18,7 @@ module System.Nix.Path
|
||||
) where
|
||||
|
||||
import System.Nix.Hash (Digest(..),
|
||||
HashAlgorithm(Truncated, SHA256))
|
||||
HashAlgorithm'(Truncated, SHA256))
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Char8 as BSC
|
||||
import Data.Hashable (Hashable (..), hashPtrWithSalt)
|
||||
|
@ -1,13 +1,13 @@
|
||||
{-# 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 Text.Pretty.Simple
|
||||
import qualified System.Nix.GC as GC
|
||||
import System.Nix.Store.Remote
|
||||
import System.Nix.Store.Remote.Util
|
||||
|
||||
noSuchPath = fromJust $ mkPath "blah"
|
||||
|
||||
|
@ -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
|
||||
@ -32,6 +38,7 @@ module System.Nix.Store.Remote (
|
||||
import Data.Maybe
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Proxy (Proxy(Proxy))
|
||||
|
||||
import Control.Monad
|
||||
|
||||
@ -40,6 +47,7 @@ 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.Util
|
||||
|
||||
import System.Nix.Store.Remote.Types
|
||||
@ -159,9 +167,40 @@ type Source = () -- abstract binary source
|
||||
addToStoreNar :: ValidPathInfo -> Source -> RepairFlag -> CheckSigsFlag -> MonadStore ()
|
||||
addToStoreNar = undefined -- XXX
|
||||
|
||||
|
||||
-- class BaseHashAlgorithm (a :: HashAlgorithm) where
|
||||
-- baseHashAlgorithm :: Bool
|
||||
|
||||
-- instance BaseHashAlgorithm MD5 where
|
||||
-- baseHashAlgorithm = MD5
|
||||
|
||||
-- instance BaseHashAlgorithm SHA1 where
|
||||
-- baseHashAlgorithm = SHA1
|
||||
|
||||
-- instance BaseHashAlgorithm SHA256 where
|
||||
-- baseHashAlgorithm = SHA256
|
||||
|
||||
-- instance forall n a.BaseHashAlgorithm a => BaseHashAlgorithm (Truncated n a) where
|
||||
-- baseHashAlgorithm = baseHashAlgorithm @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. AlgoVal a
|
||||
=> LBS.ByteString
|
||||
-> Path
|
||||
-> Bool
|
||||
-> Proxy a
|
||||
-> PathFilter
|
||||
-> RepairFlag
|
||||
-> MonadStore Path
|
||||
addToStore name pth recursive algoProxy pfilter repair = do
|
||||
runOpArgs AddToStore $ do
|
||||
putByteStringLen name
|
||||
putByteStringLen $ if algoVal @a == SHA256 && recursive then 0 else 1
|
||||
putByteStringLen $ if recursive then 0 else 1
|
||||
putByteStringLen name
|
||||
fmap (fromMaybe "TODO: Error") sockGetPath
|
||||
|
||||
|
||||
addTextToStore :: LBS.ByteString -> LBS.ByteString -> PathSet -> RepairFlag -> MonadStore (Maybe Path)
|
||||
addTextToStore name text references' repair = do
|
||||
|
Loading…
Reference in New Issue
Block a user