summaryrefslogtreecommitdiff
path: root/Data/OpenPGP/Util/Fingerprint.hs
blob: 422beac9c885f8cf13a5d0add8cc935d40dd9144 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
{-# LANGUAGE CPP #-}
module Data.OpenPGP.Util.Fingerprint (fingerprint,fingerprintv,Fingerprint(..),hex) where

import qualified Data.OpenPGP as OpenPGP
import Data.OpenPGP.Internal
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LZ
import Data.Char (toUpper)
import Data.Word (Word8)
import GHC.Stack
import Numeric (showHex)

#if defined(VERSION_cryptonite)
import Crypto.Hash.Algorithms
import Crypto.Hash
import qualified Data.ByteArray as Bytes
#else
import Crypto.Hash.MD5 as MD5
import Crypto.Hash.SHA1 as SHA1
#endif

oo :: (b -> c) -> (a -> a1 -> b) -> a -> a1 -> c
oo = (.) . (.)

newtype Fingerprint = Fingerprint BS.ByteString
 deriving (Eq,Ord)

instance Show Fingerprint where
   show fp = hex fp

hex :: Fingerprint -> String
hex (Fingerprint bs) = hexify bs

-- | Generate a key fingerprint from a PublicKeyPacket or SecretKeyPacket
-- <http://tools.ietf.org/html/rfc4880#section-12.2>
fingerprint :: HasCallStack => OpenPGP.Packet -> Fingerprint
fingerprint p = fingerprintv (OpenPGP.auto_fp_version p) p

fingerprintv :: HasCallStack => Word8 -> OpenPGP.Packet -> Fingerprint
fingerprintv v p = case v of
    5 -> Fingerprint $ sha256 material
    4 -> Fingerprint $ sha1 material
    3 -> Fingerprint $ md5 material
    _ -> error "Unsupported Packet version or type in fingerprint"
    where

#if defined(VERSION_cryptonite)
    sha256 x = Bytes.convert (hashlazy x :: Digest SHA256)
    sha1 x = Bytes.convert (hashlazy x :: Digest SHA1)
    md5 x = Bytes.convert (hashlazy x :: Digest MD5)
#else
    -- TODO: SHA256 (or drop support for non-cryptonite)
    sha1 = SHA1.hashlazy
    md5 = MD5.hashlazy
#endif

    material = LZ.concat $ OpenPGP.fingerprint_materialv v p