x509-ocsp-0.5.2.1: Data/X509/OCSP.hs
{-# LANGUAGE PatternSynonyms, ViewPatterns, TypeApplications, LambdaCase #-}
{-# LANGUAGE TupleSections, ImportQualifiedPost #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.X509.OCSP
-- Copyright : (c) Alexey Radkov 2024-2026
-- License : BSD-style
--
-- Maintainer : alexey.radkov@gmail.com
-- Stability : experimental
-- Portability : portable
--
-- Encode and decode X509 OCSP requests and responses.
--
-- This module complies with /rfc6960/.
-----------------------------------------------------------------------------
module Data.X509.OCSP (
-- * Shared data
CertId
-- * OCSP request
,encodeOCSPRequestASN1
,encodeOCSPRequest
-- * OCSP response
,OCSPResponse (..)
,OCSPResponseStatus (..)
,OCSPResponsePayload (..)
,OCSPResponseCertData (..)
,OCSPResponseCertStatus (..)
,decodeOCSPResponse
-- ** OCSP response verification
,OCSPResponseVerificationData (..)
,getOCSPResponseVerificationData
,getOCSPResponseVerificationData'
) where
import Data.X509
import Data.ASN1.Types
import Data.ASN1.Encoding
import Data.ASN1.BinaryEncoding
import Data.ASN1.BitArray
import Data.ASN1.Stream
import Data.ASN1.Error
import Data.ByteString (ByteString)
import Data.ByteString.Lazy qualified as L
import Data.Int
import Data.Word
import Data.Bits
import Data.Bifunctor
import Data.ByteArray qualified as BA
import Crypto.Hash
import Control.Monad
pattern OidAlgorithmSHA1 :: OID
pattern OidAlgorithmSHA1 = [1, 3, 14, 3, 2, 26]
pattern OidBasicOCSPResponse :: OID
pattern OidBasicOCSPResponse = [1, 3, 6, 1, 5, 5, 7, 48, 1, 1]
-- | Certificate Id.
--
-- Corresponds to /CertId/ from /rfc6960/. Contains /hashAlgorithm/,
-- /issuerNameHash/, /issuerKeyHash/, and /serialNumber/.
--
-- This data is used when building OCSP requests and parsing OCSP responses.
data CertId = CertId { certIdHashAlgorithm :: OID
-- ^ Value of /hashAlgorithm/ as defined in /rfc6960/
, certIdIssuerNameHash :: ByteString
-- ^ Value of /issuerNameHash/ as defined in /rfc6960/
, certIdIssuerKeyHash :: ByteString
-- ^ Value of /issuerKeyHash/ as defined in /rfc6960/
, certIdSerialNumber :: Integer
-- ^ Certificate serial number
} deriving (Show, Eq)
pattern Asn1CertId :: OID -> ByteString -> ByteString -> Integer -> ASN1S
pattern Asn1CertId alg h1 h2 sn xs =
Start Sequence
: Start Sequence
: OID alg
: Null
: End Sequence
: OctetString h1
: OctetString h2
: IntVal sn
: End Sequence
: xs
instance ASN1Object CertId where
toASN1 (CertId alg h1 h2 sn) = Asn1CertId alg h1 h2 sn
fromASN1 (Asn1CertId alg h1 h2 sn xs) = Right (CertId alg h1 h2 sn, xs)
fromASN1 _ = Left "fromASN1: CertId: unexpected format"
derLWidth :: Word8 -> Int64
derLWidth x | testBit x 7 = succ $ fromIntegral $ x .&. 0x7f
| otherwise = 1
issuerDNHash :: HashAlgorithm a => Certificate -> Digest a
issuerDNHash cert = hashlazy $ encodeASN1 DER dn
where dn = toASN1 (certIssuerDN cert) []
{-# SPECIALIZE issuerDNHash :: Certificate -> Digest SHA1 #-}
pubKeyHash :: HashAlgorithm a => Certificate -> Digest a
pubKeyHash cert = hashlazy $ L.drop (succ $ derLWidth $ L.head pk) pk
where pk = case toASN1 (certPubKey cert) [] of
Start Sequence
: Start Sequence
: OID _
: (skipCurrentContainer -> v@BitString {} : _) ->
L.drop 1 $ encodeASN1 DER $ pure v
_ -> error "pubKeyHash: bad pubkey sequence"
{-# SPECIALIZE pubKeyHash :: Certificate -> Digest SHA1 #-}
toCertId :: Certificate -> Certificate -> CertId
toCertId cert issuerCert =
let h1 = BA.convert $ issuerDNHash @SHA1 cert
h2 = BA.convert $ pubKeyHash @SHA1 issuerCert
sn = certSerial cert
in CertId OidAlgorithmSHA1 h1 h2 sn
-- | Build and encode OCSP request in ASN.1 format.
--
-- The returned value contains the encoded request and an object of type
-- t'CertId' with hashes calculated by the SHA1 algorithm. The returned
-- /CertId/ must be passed in 'decodeOCSPResponse'.
encodeOCSPRequestASN1
:: Certificate -- ^ Certificate
-> Certificate -- ^ Issuer certificate
-> ([ASN1], CertId)
encodeOCSPRequestASN1 cert issuerCert =
let certId = toCertId cert issuerCert
in ( Start Sequence
: Start Sequence
: Start Sequence
: Start Sequence
: toASN1 certId (replicate 4 $ End Sequence)
, certId
)
-- | Build and encode OCSP request in ASN.1\/DER format.
--
-- The returned value contains the encoded request and an object of type
-- t'CertId' with hashes calculated by the SHA1 algorithm. The returned
-- /CertId/ must be passed in 'decodeOCSPResponse'.
encodeOCSPRequest
:: Certificate -- ^ Certificate
-> Certificate -- ^ Issuer certificate
-> (L.ByteString, CertId)
encodeOCSPRequest = (first (encodeASN1 DER) .) . encodeOCSPRequestASN1
-- | OCSP response data.
data OCSPResponse =
OCSPResponse { ocspRespStatus :: OCSPResponseStatus
-- ^ Response status
, ocspRespPayload :: Maybe OCSPResponsePayload
-- ^ Response payload data
} deriving (Show, Eq)
-- | Status of OCSP response as defined in /rfc6960/.
data OCSPResponseStatus = OCSPRespSuccessful
| OCSPRespMalformedRequest
| OCSPRespInternalError
| OCSPRespUnused1
| OCSPRespTryLater
| OCSPRespSigRequired
| OCSPRespUnauthorized
deriving (Show, Eq, Bounded, Enum)
-- | Payload data of OCSP response.
data OCSPResponsePayload =
OCSPResponsePayload { ocspRespCertData :: OCSPResponseCertData
-- ^ Selected certificate data
, ocspRespASN1 :: [ASN1]
-- ^ Whole response payload
} deriving (Show, Eq)
-- | Selected certificate data of OCSP response.
data OCSPResponseCertData =
OCSPResponseCertData { ocspRespCertStatus :: OCSPResponseCertStatus
-- ^ Certificate status
, ocspRespCertThisUpdate :: ASN1
-- ^ Value of /thisUpdate/ as defined in /rfc6960/
, ocspRespCertNextUpdate :: Maybe ASN1
-- ^ Value of /nextUpdate/ as defined in /rfc6960/
} deriving (Show, Eq)
-- | Certificate status of OCSP response as defined in /rfc6960/.
data OCSPResponseCertStatus = OCSPRespCertGood
| OCSPRespCertRevoked
| OCSPRespCertUnknown
deriving (Show, Eq, Bounded, Enum)
pattern Asn1OCSPResponseEmpty :: OCSPResponseStatus -> [ASN1]
pattern Asn1OCSPResponseEmpty rst <-
[ Start Sequence
, Enumerated (toEnum . fromIntegral -> rst)
, End Sequence
]
pattern Asn1OCSPResponseValue :: OCSPResponseStatus -> ByteString -> [ASN1]
pattern Asn1OCSPResponseValue rst val <-
[ Start Sequence
, Enumerated (toEnum . fromIntegral -> rst)
, Start (Container Context 0)
, Start Sequence
, OID OidBasicOCSPResponse
, OctetString val
, End Sequence
, End (Container Context 0)
, End Sequence
]
-- | Decode OCSP response.
--
-- The value of the /certificate id/ is expected to be equal to what was
-- returned by 'encodeOCSPRequest' as it is used to check the correctness of
-- the response.
--
-- The /Left/ value gets returned on parse errors detected by 'decodeASN1'.
-- The /Right/ value with /Nothing/ gets returned on unexpected ASN.1 contents.
decodeOCSPResponse
:: CertId -- ^ Certificate Id
-> L.ByteString -- ^ Raw encoded OCSP response
-> Either ASN1Error (Maybe OCSPResponse)
decodeOCSPResponse certId resp = decodeASN1 DER resp >>= \case
Asn1OCSPResponseEmpty rst ->
Right $ Just $ OCSPResponse rst Nothing
Asn1OCSPResponseValue rst val -> do
pl <- decodeASN1' DER val
Right $
case pl of
Start Sequence
: Start Sequence
: Start (Container Context ctx)
: c1 | ctx `elem` [0..2] -> do
let skipVersion
| ctx == 0 = drop 1 . skipCurrentContainer
| otherwise = id
Just $ getCurrentContainerContents $
drop 2 $ skipCurrentContainer $ skipVersion c1
_ -> Nothing
>>= \case
Start Sequence
: (fromASN1 -> Right (cId, c2)) | cId == certId ->
case c2 of
Other Context (toEnum -> st) _
: c3 -> Just (st, c3)
Start (Container Context (toEnum -> st))
: c3 -> Just (st, skipCurrentContainer c3)
_ -> Nothing
_ -> Nothing
>>= \(st, tc1) -> case tc1 of
tu@(ASN1Time TimeGeneralized _ _)
: c4 -> Just (st, tu, c4)
_ -> Nothing
>>= \(cst, tu, tc2) -> do
let nu = case tc2 of
Start (Container Context 0)
: t@(ASN1Time TimeGeneralized _ _)
: End (Container Context 0)
: _ -> Just t
_ -> Nothing
Just $ OCSPResponse rst $
Just $ OCSPResponsePayload
(OCSPResponseCertData cst tu nu) pl
_ -> Right Nothing
-- | Verification data from OCSP response payload.
--
-- This data can be used to verify the signature of the OCSP response with
-- 'Data.X509.Validation.verifySignature'. The response is signed with
-- signature /ocspRespSignature/. Binary data /ocspRespDer/ and algorithm
-- /ocspRespSignatureAlg/ are what has been used to sign the response. The
-- verification process may require the public key of the issuer certificate
-- if it's not been attached in /ocspRespCerts/. The latter contains a list of
-- signed certificates augmented by DER-encoded /tbsCertificate/ as defined in
-- /rfc5280/.
--
-- See details of signing and verification of OCSP responses in /rfc6960/.
--
-- Below is a simple implementation of the OCSP response signature verification.
--
-- @
-- {-# LANGUAGE RecordWildCards #-}
--
-- -- ...
--
-- verifySignature\' :: t'OCSPResponse' -> t'Certificate' -> t'Data.X509.Validation.SignatureVerification'
-- verifySignature\' resp v'Certificate' {..}
-- | Just __/OCSPResponseVerificationData/__ {..} <-
-- 'getOCSPResponseVerificationData' resp =
-- 'Data.X509.Validation.verifySignature' __/ocspRespSignatureAlg/__ 'certPubKey' __/ocspRespDer/__
-- __/ocspRespSignature/__
-- | otherwise = 'Data.X509.Validation.SignatureFailed' 'Data.X509.Validation.SignatureInvalid'
-- @
--
-- Note that the issuer certificate gets passed to /verifySignature\'/ rather
-- than looked up in /ocspRespCerts/. The OCSP Signature Authority Delegation
-- is not checked in this simple example.
--
-- To verify update times, check the values of 'ocspRespCertThisUpdate' and
-- 'ocspRespCertNextUpdate' which both must have been constructed as
-- 'TimeGeneralized'.
data OCSPResponseVerificationData =
OCSPResponseVerificationData
{ ocspRespDer :: ByteString
-- ^ Response data (DER-encoded)
, ocspRespSignatureAlg :: SignatureALG
-- ^ Signature algorithm
, ocspRespSignature :: ByteString
-- ^ Signature
, ocspRespCerts :: [(Signed Certificate, ByteString)]
-- ^ List of signed certificates with DER-encoded certificate data
} deriving (Show, Eq)
-- | Get verification data from OCSP response.
--
-- The function returns /Nothing/ on unexpected ASN.1 contents.
getOCSPResponseVerificationData
:: OCSPResponse -- ^ OCSP response
-> Maybe OCSPResponseVerificationData
getOCSPResponseVerificationData =
ocspRespPayload >=> getOCSPResponseVerificationData' . ocspRespASN1
pattern Asn1OCSPResponseCerts :: ASN1S
pattern Asn1OCSPResponseCerts certs <-
Start (Container Context 0)
: Start Sequence
: certs@(Start Sequence : _)
-- | Get verification data from OCSP response payload.
--
-- This is a variant of 'getOCSPResponseVerificationData' that accepts the
-- OCSP response payload in ASN.1 format. The function returns /Nothing/ on
-- unexpected ASN.1 contents.
getOCSPResponseVerificationData'
:: [ASN1] -- ^ OCSP response payload
-> Maybe OCSPResponseVerificationData
getOCSPResponseVerificationData' (Start Sequence : c1@(Start Sequence : _))
| (join bimap $ map fst -> (encodeASN1' DER -> resp, c2)) <-
getConstructedEndRepr $ map (, []) c1
, Right (alg, BitString (bitArrayGetData -> sig) : c3) <-
fromASN1 c2 =
case c3 of
[End Sequence] -> Just []
(getCurrentContainerContents -> Asn1OCSPResponseCerts certs) ->
reverse <$> collectCerts certs []
_ -> Nothing
>>= Just . OCSPResponseVerificationData resp alg sig
where collectCerts (Start Sequence : c4) certs
| (c5@(Start Sequence : c6), next) <- getConstructedEnd 0 c4
, Right (cert, End Sequence : c7) <- fromASN1 c6
, Right (alg, [BitString (bitArrayGetData -> sig)]) <-
fromASN1 c7 =
collectCerts next $
(Signed cert alg sig, encodeASN1' DER c5) : certs
collectCerts [End Sequence, End (Container Context 0)] certs =
Just certs
collectCerts _ _ =
Nothing
getOCSPResponseVerificationData' _ = Nothing
getCurrentContainerContents :: ASN1S
getCurrentContainerContents = fst . getConstructedEnd 0
skipCurrentContainer :: ASN1S
skipCurrentContainer = snd . getConstructedEnd 0