htalkat-0.1.1: Certificate.hs

-- This file is part of htalkat
-- Copyright (C) 2021 Martin Bays <mbays@sdf.org>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of version 3 of the GNU General Public License as
-- published by the Free Software Foundation, or any later version.
--
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see http://www.gnu.org/licenses/.

module Certificate where

import           Crypto.Hash
import           Data.ASN1.BinaryEncoding (DER (..))
import           Data.ASN1.Encoding       (encodeASN1')
import           Data.ASN1.Types          (ASN1Object (..))
import           Data.ByteArray           (convert)

import qualified Data.ByteString          as BS
import qualified Data.Text                as TS
import qualified Data.Text.Encoding       as TS
import qualified Data.X509                as X

import           Fingerprint

newtype Certificate = Certificate X.SignedCertificate
    deriving (Eq, Show)

takeTailCert :: X.CertificateChain -> Maybe Certificate
takeTailCert (X.CertificateChain (c:_)) = Just $ Certificate c
takeTailCert _                          = Nothing

-- |First 16 bytes of sha256 hash of DER encoding of SPKI field
-- (as suggested by RFC7469).
spkiFingerprint :: Certificate -> Fingerprint
spkiFingerprint (Certificate signed) = truncateFP 16 . Fingerprint . convert . hashWith SHA256 .
        encodeDER . X.certPubKey . X.signedObject $ X.getSigned signed
    where
    truncateFP :: Int -> Fingerprint -> Fingerprint
    truncateFP n (Fingerprint fp) = Fingerprint $ BS.take n fp
    encodeDER :: ASN1Object o => o -> BS.ByteString
    encodeDER = encodeASN1' DER . (`toASN1` [])

certCN :: Certificate -> String
certCN (Certificate signed) = maybe "" (TS.unpack . TS.decodeUtf8 . X.getCharacterStringRawData)
    . X.getDnElement X.DnCommonName . X.certIssuerDN $ X.getCertificate signed