{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE CPP #-}
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 Crypto.Hash.SHA512 as SHA512
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as Base16
import qualified System.Nix.Base32 as Base32
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)
data BaseEncoding
= Base16
| Base32
| Base64
data HashAlgorithm
= MD5
| SHA1
| SHA256
| SHA512
| Truncated Nat HashAlgorithm
newtype Digest (a :: HashAlgorithm) =
Digest BS.ByteString deriving (Digest a -> Digest a -> Bool
(Digest a -> Digest a -> Bool)
-> (Digest a -> Digest a -> Bool) -> Eq (Digest a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: HashAlgorithm). Digest a -> Digest a -> Bool
/= :: Digest a -> Digest a -> Bool
$c/= :: forall (a :: HashAlgorithm). Digest a -> Digest a -> Bool
== :: Digest a -> Digest a -> Bool
$c== :: forall (a :: HashAlgorithm). Digest a -> Digest a -> Bool
Eq, Eq (Digest a)
Eq (Digest a)
-> (Digest a -> Digest a -> Ordering)
-> (Digest a -> Digest a -> Bool)
-> (Digest a -> Digest a -> Bool)
-> (Digest a -> Digest a -> Bool)
-> (Digest a -> Digest a -> Bool)
-> (Digest a -> Digest a -> Digest a)
-> (Digest a -> Digest a -> Digest a)
-> Ord (Digest a)
Digest a -> Digest a -> Bool
Digest a -> Digest a -> Ordering
Digest a -> Digest a -> Digest a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (a :: HashAlgorithm). Eq (Digest a)
forall (a :: HashAlgorithm). Digest a -> Digest a -> Bool
forall (a :: HashAlgorithm). Digest a -> Digest a -> Ordering
forall (a :: HashAlgorithm). Digest a -> Digest a -> Digest a
min :: Digest a -> Digest a -> Digest a
$cmin :: forall (a :: HashAlgorithm). Digest a -> Digest a -> Digest a
max :: Digest a -> Digest a -> Digest a
$cmax :: forall (a :: HashAlgorithm). Digest a -> Digest a -> Digest a
>= :: Digest a -> Digest a -> Bool
$c>= :: forall (a :: HashAlgorithm). Digest a -> Digest a -> Bool
> :: Digest a -> Digest a -> Bool
$c> :: forall (a :: HashAlgorithm). Digest a -> Digest a -> Bool
<= :: Digest a -> Digest a -> Bool
$c<= :: forall (a :: HashAlgorithm). Digest a -> Digest a -> Bool
< :: Digest a -> Digest a -> Bool
$c< :: forall (a :: HashAlgorithm). Digest a -> Digest a -> Bool
compare :: Digest a -> Digest a -> Ordering
$ccompare :: forall (a :: HashAlgorithm). Digest a -> Digest a -> Ordering
$cp1Ord :: forall (a :: HashAlgorithm). Eq (Digest a)
Ord, Int -> Digest a -> Int
Digest a -> Int
(Int -> Digest a -> Int)
-> (Digest a -> Int) -> Hashable (Digest a)
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall (a :: HashAlgorithm). Int -> Digest a -> Int
forall (a :: HashAlgorithm). Digest a -> Int
hash :: Digest a -> Int
$chash :: forall (a :: HashAlgorithm). Digest a -> Int
hashWithSalt :: Int -> Digest a -> Int
$chashWithSalt :: forall (a :: HashAlgorithm). Int -> Digest a -> Int
DataHashable.Hashable)
instance Show (Digest a) where
show :: Digest a -> String
show = (String
"Digest " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> (Digest a -> String) -> Digest a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. Show a => a -> String
show (Text -> String) -> (Digest a -> Text) -> Digest a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseEncoding -> Digest a -> Text
forall (a :: HashAlgorithm). BaseEncoding -> Digest a -> Text
encodeInBase BaseEncoding
Base32
class ValidAlgo (a :: HashAlgorithm) where
type AlgoCtx a
initialize :: AlgoCtx a
update :: AlgoCtx a -> BS.ByteString -> AlgoCtx a
finalize :: AlgoCtx a -> Digest a
class ValidAlgo a => NamedAlgo (a :: HashAlgorithm) where
algoName :: Text
hashSize :: Int
instance NamedAlgo 'MD5 where
algoName :: Text
algoName = Text
"md5"
hashSize :: Int
hashSize = Int
16
instance NamedAlgo 'SHA1 where
algoName :: Text
algoName = Text
"sha1"
hashSize :: Int
hashSize = Int
20
instance NamedAlgo 'SHA256 where
algoName :: Text
algoName = Text
"sha256"
hashSize :: Int
hashSize = Int
32
instance NamedAlgo 'SHA512 where
algoName :: Text
algoName = Text
"sha512"
hashSize :: Int
hashSize = Int
64
data SomeNamedDigest = forall a . NamedAlgo a => SomeDigest (Digest a)
instance Show SomeNamedDigest where
show :: SomeNamedDigest -> String
show SomeNamedDigest
sd = case SomeNamedDigest
sd of
SomeDigest (Digest a
digest :: Digest hashType) -> Text -> String
T.unpack (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 :: HashAlgorithm). 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 :: HashAlgorithm). BaseEncoding -> Digest a -> Text
encodeInBase BaseEncoding
Base32 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
T.unpack (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 :: HashAlgorithm).
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
<$> Text -> Either String (Digest 'MD5)
forall (a :: HashAlgorithm).
(NamedAlgo a, ValidAlgo a) =>
Text -> Either String (Digest a)
decodeGo @'MD5 Text
h
Text
"sha1" -> Digest 'SHA1 -> SomeNamedDigest
forall (a :: HashAlgorithm).
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
<$> Text -> Either String (Digest 'SHA1)
forall (a :: HashAlgorithm).
(NamedAlgo a, ValidAlgo a) =>
Text -> Either String (Digest a)
decodeGo @'SHA1 Text
h
Text
"sha256" -> Digest 'SHA256 -> SomeNamedDigest
forall (a :: HashAlgorithm).
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
<$> Text -> Either String (Digest 'SHA256)
forall (a :: HashAlgorithm).
(NamedAlgo a, ValidAlgo a) =>
Text -> Either String (Digest a)
decodeGo @'SHA256 Text
h
Text
"sha512" -> Digest 'SHA512 -> SomeNamedDigest
forall (a :: HashAlgorithm).
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
<$> Text -> Either String (Digest 'SHA512)
forall (a :: HashAlgorithm).
(NamedAlgo a, ValidAlgo a) =>
Text -> Either String (Digest a)
decodeGo @'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
T.unpack Text
name
decodeGo :: forall a . (NamedAlgo a, ValidAlgo a) => Text -> Either String (Digest a)
decodeGo :: Text -> Either String (Digest a)
decodeGo 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).
BaseEncoding -> Text -> Either String (Digest a)
decodeBase 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).
BaseEncoding -> Text -> Either String (Digest a)
decodeBase BaseEncoding
Base32 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).
BaseEncoding -> Text -> Either String (Digest a)
decodeBase 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
T.unpack 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
T.unpack 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 a. Show a => a -> String
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 a. Show a => a -> String
show [Int
base16Len, Int
base32Len, Int
base64Len]
where
size :: Int
size = Text -> Int
T.length Text
h
hsize :: Int
hsize = NamedAlgo a => Int
forall (a :: HashAlgorithm). NamedAlgo a => Int
hashSize @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;
hash :: forall a.ValidAlgo a => BS.ByteString -> Digest a
hash :: ByteString -> Digest a
hash ByteString
bs =
AlgoCtx a -> Digest a
forall (a :: HashAlgorithm). ValidAlgo a => AlgoCtx a -> Digest a
finalize (AlgoCtx a -> Digest a) -> AlgoCtx a -> Digest a
forall a b. (a -> b) -> a -> b
$ AlgoCtx a -> ByteString -> AlgoCtx a
forall (a :: HashAlgorithm).
ValidAlgo a =>
AlgoCtx a -> ByteString -> AlgoCtx a
update @a (ValidAlgo a => AlgoCtx a
forall (a :: HashAlgorithm). ValidAlgo a => AlgoCtx a
initialize @a) ByteString
bs
hashLazy :: forall a.ValidAlgo a => BSL.ByteString -> Digest a
hashLazy :: ByteString -> Digest a
hashLazy ByteString
bsl =
AlgoCtx a -> Digest a
forall (a :: HashAlgorithm). ValidAlgo a => AlgoCtx a -> Digest a
finalize (AlgoCtx a -> Digest a) -> AlgoCtx a -> Digest a
forall a b. (a -> b) -> a -> b
$ (AlgoCtx a -> ByteString -> AlgoCtx a)
-> AlgoCtx a -> [ByteString] -> AlgoCtx a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (ValidAlgo a => AlgoCtx a -> ByteString -> AlgoCtx a
forall (a :: HashAlgorithm).
ValidAlgo a =>
AlgoCtx a -> ByteString -> AlgoCtx a
update @a) (ValidAlgo a => AlgoCtx a
forall (a :: HashAlgorithm). ValidAlgo a => AlgoCtx a
initialize @a) (ByteString -> [ByteString]
BSL.toChunks ByteString
bsl)
encodeInBase :: BaseEncoding -> Digest a -> T.Text
encodeInBase :: BaseEncoding -> Digest a -> Text
encodeInBase BaseEncoding
Base16 = ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (Digest a -> ByteString) -> Digest a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode (ByteString -> ByteString)
-> (Digest a -> ByteString) -> Digest a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest a -> ByteString
coerce
encodeInBase BaseEncoding
Base32 = ByteString -> Text
Base32.encode (ByteString -> Text)
-> (Digest a -> ByteString) -> Digest a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest a -> ByteString
coerce
encodeInBase BaseEncoding
Base64 = ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (Digest a -> ByteString) -> Digest a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base64.encode (ByteString -> ByteString)
-> (Digest a -> ByteString) -> Digest a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest a -> ByteString
coerce
decodeBase :: BaseEncoding -> T.Text -> Either String (Digest a)
#if MIN_VERSION_base16_bytestring(1,0,0)
decodeBase :: BaseEncoding -> Text -> Either String (Digest a)
decodeBase BaseEncoding
Base16 = (ByteString -> Digest a)
-> Either String ByteString -> Either String (Digest a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Digest a
forall (a :: HashAlgorithm). ByteString -> Digest a
Digest (Either String ByteString -> Either String (Digest a))
-> (Text -> Either String ByteString)
-> Text
-> Either String (Digest a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
Base16.decode (ByteString -> Either String ByteString)
-> (Text -> ByteString) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
#else
decodeBase Base16 = lDecode
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 BaseEncoding
Base32 = (ByteString -> Digest a)
-> Either String ByteString -> Either String (Digest a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Digest a
forall (a :: HashAlgorithm). ByteString -> Digest a
Digest (Either String ByteString -> Either String (Digest a))
-> (Text -> Either String ByteString)
-> Text
-> Either String (Digest a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String ByteString
Base32.decode
decodeBase BaseEncoding
Base64 = (ByteString -> Digest a)
-> Either String ByteString -> Either String (Digest a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Digest a
forall (a :: HashAlgorithm). ByteString -> Digest a
Digest (Either String ByteString -> Either String (Digest a))
-> (Text -> Either String ByteString)
-> Text
-> Either String (Digest a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
Base64.decode (ByteString -> Either String ByteString)
-> (Text -> ByteString) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
instance ValidAlgo 'MD5 where
type AlgoCtx 'MD5 = MD5.Ctx
initialize :: AlgoCtx 'MD5
initialize = Ctx
AlgoCtx 'MD5
MD5.init
update :: AlgoCtx 'MD5 -> ByteString -> AlgoCtx 'MD5
update = Ctx -> ByteString -> Ctx
AlgoCtx 'MD5 -> ByteString -> AlgoCtx 'MD5
MD5.update
finalize :: AlgoCtx 'MD5 -> Digest 'MD5
finalize = ByteString -> Digest 'MD5
forall (a :: HashAlgorithm). ByteString -> Digest a
Digest (ByteString -> Digest 'MD5)
-> (Ctx -> ByteString) -> Ctx -> Digest 'MD5
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> ByteString
MD5.finalize
instance ValidAlgo 'SHA1 where
type AlgoCtx 'SHA1 = SHA1.Ctx
initialize :: AlgoCtx 'SHA1
initialize = Ctx
AlgoCtx 'SHA1
SHA1.init
update :: AlgoCtx 'SHA1 -> ByteString -> AlgoCtx 'SHA1
update = Ctx -> ByteString -> Ctx
AlgoCtx 'SHA1 -> ByteString -> AlgoCtx 'SHA1
SHA1.update
finalize :: AlgoCtx 'SHA1 -> Digest 'SHA1
finalize = ByteString -> Digest 'SHA1
forall (a :: HashAlgorithm). ByteString -> Digest a
Digest (ByteString -> Digest 'SHA1)
-> (Ctx -> ByteString) -> Ctx -> Digest 'SHA1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> ByteString
SHA1.finalize
instance ValidAlgo 'SHA256 where
type AlgoCtx 'SHA256 = SHA256.Ctx
initialize :: AlgoCtx 'SHA256
initialize = Ctx
AlgoCtx 'SHA256
SHA256.init
update :: AlgoCtx 'SHA256 -> ByteString -> AlgoCtx 'SHA256
update = Ctx -> ByteString -> Ctx
AlgoCtx 'SHA256 -> ByteString -> AlgoCtx 'SHA256
SHA256.update
finalize :: AlgoCtx 'SHA256 -> Digest 'SHA256
finalize = ByteString -> Digest 'SHA256
forall (a :: HashAlgorithm). ByteString -> Digest a
Digest (ByteString -> Digest 'SHA256)
-> (Ctx -> ByteString) -> Ctx -> Digest 'SHA256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> ByteString
SHA256.finalize
instance ValidAlgo 'SHA512 where
type AlgoCtx 'SHA512 = SHA512.Ctx
initialize :: AlgoCtx 'SHA512
initialize = Ctx
AlgoCtx 'SHA512
SHA512.init
update :: AlgoCtx 'SHA512 -> ByteString -> AlgoCtx 'SHA512
update = Ctx -> ByteString -> Ctx
AlgoCtx 'SHA512 -> ByteString -> AlgoCtx 'SHA512
SHA512.update
finalize :: AlgoCtx 'SHA512 -> Digest 'SHA512
finalize = ByteString -> Digest 'SHA512
forall (a :: HashAlgorithm). ByteString -> Digest a
Digest (ByteString -> Digest 'SHA512)
-> (Ctx -> ByteString) -> Ctx -> Digest 'SHA512
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> ByteString
SHA512.finalize
instance (ValidAlgo a, KnownNat n) => ValidAlgo ('Truncated n a) where
type AlgoCtx ('Truncated n a) = AlgoCtx a
initialize :: AlgoCtx ('Truncated n a)
initialize = ValidAlgo a => AlgoCtx a
forall (a :: HashAlgorithm). ValidAlgo a => AlgoCtx a
initialize @a
update :: AlgoCtx ('Truncated n a) -> ByteString -> AlgoCtx ('Truncated n a)
update = ValidAlgo a => AlgoCtx a -> ByteString -> AlgoCtx a
forall (a :: HashAlgorithm).
ValidAlgo a =>
AlgoCtx a -> ByteString -> AlgoCtx a
update @a
finalize :: AlgoCtx ('Truncated n a) -> Digest ('Truncated n a)
finalize = forall (n :: Nat) (a :: HashAlgorithm).
KnownNat n =>
Digest a -> Digest ('Truncated n a)
forall (a :: HashAlgorithm).
KnownNat n =>
Digest a -> Digest ('Truncated n a)
truncateDigest @n (Digest a -> Digest ('Truncated n a))
-> (AlgoCtx a -> Digest a) -> AlgoCtx a -> Digest ('Truncated n a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidAlgo a => AlgoCtx a -> Digest a
forall (a :: HashAlgorithm). ValidAlgo a => AlgoCtx a -> Digest a
finalize @a
truncateDigest
:: forall n a.(KnownNat n) => Digest a -> Digest ('Truncated n a)
truncateDigest :: Digest a -> Digest ('Truncated n a)
truncateDigest (Digest ByteString
c) =
ByteString -> Digest ('Truncated n a)
forall (a :: HashAlgorithm). ByteString -> Digest a
Digest (ByteString -> Digest ('Truncated n a))
-> ByteString -> Digest ('Truncated n a)
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Int -> Word8) -> [Int] -> [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Word8
truncOutputByte [Int
0.. Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
where
n :: Int
n = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy @n)
truncOutputByte :: Int -> Word8
truncOutputByte :: Int -> Word8
truncOutputByte Int
i = (Word8 -> Int -> Word8) -> Word8 -> [Int] -> Word8
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int -> Word8 -> Int -> Word8
aux Int
i) Word8
0 [Int
0 .. ByteString -> Int
BS.length ByteString
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
inputByte :: Int -> Word8
inputByte :: Int -> Word8
inputByte Int
j = ByteString -> Int -> Word8
BS.index ByteString
c (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
j)
aux :: Int -> Word8 -> Int -> Word8
aux :: Int -> Word8 -> Int -> Word8
aux Int
i Word8
x Int
j = if Int
j Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
then Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor Word8
x (Int -> Word8
inputByte (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
j)
else Word8
x