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


mkStorePathHash :: forall a . C.HashAlgorithm a => BS.ByteString -> BS.ByteString
mkStorePathHash :: ByteString -> ByteString
mkStorePathHash ByteString
bs =
  Int -> ByteString -> ByteString
truncateInNixWay Int
20 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Digest a -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Digest a -> ByteString) -> Digest a -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Digest a
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 :: BaseEncoding -> Digest a -> Text
encodeDigestWith BaseEncoding
b = BaseEncoding -> ByteString -> Text
encodeWith BaseEncoding
b (ByteString -> Text)
-> (Digest a -> ByteString) -> Digest a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest a -> ByteString
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 :: 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 =
        String -> Maybe (Digest a) -> Either String (Digest a)
forall l r. l -> Maybe r -> Either l r
maybeToRight
          (String
"Cryptonite was not able to convert '(ByteString -> Digest a)' for: '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall b a. (Show a, IsString b) => a -> b
show ByteString
bs String -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
"'.")
    (Maybe (Digest a) -> Either String (Digest a)
toEither (Maybe (Digest a) -> Either String (Digest a))
-> (ByteString -> Maybe (Digest a))
-> ByteString
-> Either String (Digest a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Digest a)
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
C.digestFromByteString) ByteString
bs