{-|
Description : Cryptographic hashing interface for hnix-store, on top
              of the cryptohash family of libraries.
-}
{-# language AllowAmbiguousTypes #-}
{-# language TypeFamilies        #-}
{-# language ScopedTypeVariables #-}
{-# language DataKinds           #-}
{-# language ExistentialQuantification #-}
{-# language CPP #-}

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

import qualified Text.Show
import qualified Crypto.Hash            as C
import qualified Data.ByteString        as BS
import qualified Data.Text              as T
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 C.HashAlgorithm a => NamedAlgo a where
  algoName :: Text

instance NamedAlgo C.MD5 where
  algoName :: Text
algoName = Text
"md5"

instance NamedAlgo C.SHA1 where
  algoName :: Text
algoName = Text
"sha1"

instance NamedAlgo C.SHA256 where
  algoName :: Text
algoName = Text
"sha256"

instance NamedAlgo C.SHA512 where
  algoName :: Text
algoName = Text
"sha512"

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

instance Show SomeNamedDigest where
  show :: SomeNamedDigest -> String
show SomeNamedDigest
sd = case SomeNamedDigest
sd of
    SomeDigest (Digest a
digest :: C.Digest hashType) -> forall a. ToString a => a -> String
toString forall a b. (a -> b) -> a -> b
$ Text
"SomeDigest " forall a. Semigroup a => a -> a -> a
<> forall a. NamedAlgo a => Text
algoName @hashType forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> forall a. BaseEncoding -> Digest a -> Text
encodeDigestWith BaseEncoding
NixBase32 Digest a
digest

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


mkStorePathHash :: forall a . C.HashAlgorithm a => BS.ByteString -> BS.ByteString
mkStorePathHash :: forall a. HashAlgorithm a => ByteString -> ByteString
mkStorePathHash ByteString
bs =
  Int -> ByteString -> ByteString
truncateInNixWay Int
20 forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert forall a b. (a -> b) -> a -> b
$ forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
C.hash @BS.ByteString @a ByteString
bs

-- | Take BaseEncoding type of the output -> take the Digeest as input -> encode Digest
encodeDigestWith :: BaseEncoding -> C.Digest a -> T.Text
encodeDigestWith :: forall a. BaseEncoding -> Digest a -> Text
encodeDigestWith BaseEncoding
b = BaseEncoding -> ByteString -> Text
encodeWith BaseEncoding
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert


-- | Take BaseEncoding type of the input -> take the input itself -> decodeBase into Digest
decodeDigestWith :: C.HashAlgorithm a => BaseEncoding -> T.Text -> Either String (C.Digest a)
decodeDigestWith :: forall a.
HashAlgorithm a =>
BaseEncoding -> Text -> Either String (Digest a)
decodeDigestWith BaseEncoding
b Text
x =
  do
    ByteString
bs <- BaseEncoding -> Text -> Either String ByteString
decodeWith BaseEncoding
b Text
x
    let
      toEither :: Maybe (Digest a) -> Either String (Digest a)
toEither =
        forall l r. l -> Maybe r -> Either l r
maybeToRight
          (String
"Cryptonite was not able to convert '(ByteString -> Digest a)' for: '" forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show ByteString
bs forall a. Semigroup a => a -> a -> a
<>String
"'.")
    (Maybe (Digest a) -> Either String (Digest a)
toEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
C.digestFromByteString) ByteString
bs