{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.X509.Validation.Fingerprint
( Fingerprint(..)
, getFingerprint
) where
import Crypto.Hash
import Data.X509
import Data.ASN1.Types
import Data.ByteArray (convert, ByteArrayAccess)
import Data.ByteString (ByteString)
newtype Fingerprint = Fingerprint ByteString
deriving (Int -> Fingerprint -> ShowS
[Fingerprint] -> ShowS
Fingerprint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fingerprint] -> ShowS
$cshowList :: [Fingerprint] -> ShowS
show :: Fingerprint -> String
$cshow :: Fingerprint -> String
showsPrec :: Int -> Fingerprint -> ShowS
$cshowsPrec :: Int -> Fingerprint -> ShowS
Show,Fingerprint -> Fingerprint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fingerprint -> Fingerprint -> Bool
$c/= :: Fingerprint -> Fingerprint -> Bool
== :: Fingerprint -> Fingerprint -> Bool
$c== :: Fingerprint -> Fingerprint -> Bool
Eq,Fingerprint -> Int
forall p. Fingerprint -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall p a. Fingerprint -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: forall p. Fingerprint -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall p. Fingerprint -> Ptr p -> IO ()
withByteArray :: forall p a. Fingerprint -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall p a. Fingerprint -> (Ptr p -> IO a) -> IO a
length :: Fingerprint -> Int
$clength :: Fingerprint -> Int
ByteArrayAccess)
getFingerprint :: (Show a, Eq a, ASN1Object a)
=> SignedExact a
-> HashALG
-> Fingerprint
getFingerprint :: forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> HashALG -> Fingerprint
getFingerprint SignedExact a
sobj HashALG
halg = ByteString -> Fingerprint
Fingerprint forall a b. (a -> b) -> a -> b
$ forall {c} {a}.
(ByteArray c, ByteArrayAccess a) =>
HashALG -> a -> c
mkHash HashALG
halg forall a b. (a -> b) -> a -> b
$ forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> ByteString
encodeSignedObject SignedExact a
sobj
where
mkHash :: HashALG -> a -> c
mkHash HashALG
HashMD2 = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith MD2
MD2
mkHash HashALG
HashMD5 = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith MD5
MD5
mkHash HashALG
HashSHA1 = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA1
SHA1
mkHash HashALG
HashSHA224 = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA224
SHA224
mkHash HashALG
HashSHA256 = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA256
SHA256
mkHash HashALG
HashSHA384 = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA384
SHA384
mkHash HashALG
HashSHA512 = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA512
SHA512