{-# LANGUAGE PatternSynonyms, ViewPatterns, LambdaCase #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.X509.OCSP
-- Copyright   :  (c) Alexey Radkov 2024
-- 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 (CertId (..)
                      ,encodeOCSPRequestASN1
                      ,encodeOCSPRequest
                      ,OCSPResponse (..)
                      ,OCSPResponseStatus (..)
                      ,OCSPResponsePayload (..)
                      ,OCSPResponseCertData (..)
                      ,OCSPResponseCertStatus (..)
                      ,decodeOCSPResponse
                      ) where

import Data.X509
import Data.ASN1.Types
import Data.ASN1.Encoding
import Data.ASN1.BinaryEncoding
import Data.ASN1.Stream
import Data.ASN1.Error
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as L
import Data.Int
import Data.Word
import Data.Bits
import Crypto.Hash.SHA1
import Control.Arrow

pattern OidAlgorithmSHA1 :: [Integer]
pattern $mOidAlgorithmSHA1 :: forall {r}. [Integer] -> ((# #) -> r) -> ((# #) -> r) -> r
$bOidAlgorithmSHA1 :: [Integer]
OidAlgorithmSHA1 = [1, 3, 14, 3, 2, 26]

pattern OidBasicOCSPResponse :: [Integer]
pattern $mOidBasicOCSPResponse :: forall {r}. [Integer] -> ((# #) -> r) -> ((# #) -> r) -> r
$bOidBasicOCSPResponse :: [Integer]
OidBasicOCSPResponse = [1, 3, 6, 1, 5, 5, 7, 48, 1, 1]

derLWidth :: Word8 -> Int64
derLWidth :: Word8 -> Int64
derLWidth Word8
x | Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
x Int
7 = Int64 -> Int64
forall a. Enum a => a -> a
succ (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int64) -> Word8 -> Int64
forall a b. (a -> b) -> a -> b
$ Word8
x Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7f
            | Bool
otherwise = Int64
1

issuerDNHash :: Certificate -> ByteString
issuerDNHash :: Certificate -> ByteString
issuerDNHash Certificate
cert = ByteString -> ByteString
hashlazy (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ DER -> [ASN1] -> ByteString
forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
encodeASN1 DER
DER [ASN1]
dn
    where dn :: [ASN1]
dn = DistinguishedName -> ASN1S
forall a. ASN1Object a => a -> ASN1S
toASN1 (Certificate -> DistinguishedName
certIssuerDN Certificate
cert) []

pubKeyHash :: Certificate -> ByteString
pubKeyHash :: Certificate -> ByteString
pubKeyHash Certificate
cert = ByteString -> ByteString
hashlazy (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
L.drop (Int64 -> Int64
forall a. Enum a => a -> a
succ (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ Word8 -> Int64
derLWidth (Word8 -> Int64) -> Word8 -> Int64
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> Word8
ByteString -> Word8
L.head ByteString
pk) ByteString
pk
    where pk :: ByteString
pk = case PubKey -> ASN1S
forall a. ASN1Object a => a -> ASN1S
toASN1 (Certificate -> PubKey
certPubKey Certificate
cert) [] of
                   Start ASN1ConstructionType
Sequence
                     : Start ASN1ConstructionType
Sequence
                     : OID [Integer]
_
                     : ASN1
_
                     : End ASN1ConstructionType
Sequence
                     : v :: ASN1
v@(BitString BitArray
_)
                     : [ASN1]
_ -> Int64 -> ByteString -> ByteString
L.drop Int64
1 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ DER -> [ASN1] -> ByteString
forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
encodeASN1 DER
DER ([ASN1] -> ByteString) -> [ASN1] -> ByteString
forall a b. (a -> b) -> a -> b
$ ASN1 -> [ASN1]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ASN1
v
                   [ASN1]
_ -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"bad pubkey sequence"

-- | Certificate Id.
--
-- This data is used when building OCSP requests and parsing OCSP responses.
data CertId = CertId { CertId -> ByteString
certIdIssuerNameHash :: ByteString
                       -- ^ Value of /issuerNameHash/ as defined in /rfc6960/
                     , CertId -> ByteString
certIdIssuerKeyHash :: ByteString
                       -- ^ Value of /issuerKeyHash/ as defined in /rfc6960/
                     , CertId -> Integer
certIdSerialNumber :: Integer
                       -- ^ Certificate serial number
                     } deriving (Int -> CertId -> ShowS
[CertId] -> ShowS
CertId -> [Char]
(Int -> CertId -> ShowS)
-> (CertId -> [Char]) -> ([CertId] -> ShowS) -> Show CertId
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CertId -> ShowS
showsPrec :: Int -> CertId -> ShowS
$cshow :: CertId -> [Char]
show :: CertId -> [Char]
$cshowList :: [CertId] -> ShowS
showList :: [CertId] -> ShowS
Show, CertId -> CertId -> Bool
(CertId -> CertId -> Bool)
-> (CertId -> CertId -> Bool) -> Eq CertId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CertId -> CertId -> Bool
== :: CertId -> CertId -> Bool
$c/= :: CertId -> CertId -> Bool
/= :: CertId -> CertId -> Bool
Eq)

-- | Build and encode OCSP request in ASN.1 format.
--
-- The returned value contains the encoded request and an object of type
-- 'CertId' with hashes calculated by the SHA1 algorithm.
encodeOCSPRequestASN1
    :: Certificate              -- ^ Certificate
    -> Certificate              -- ^ Issuer certificate
    -> ([ASN1], CertId)
encodeOCSPRequestASN1 :: Certificate -> Certificate -> ([ASN1], CertId)
encodeOCSPRequestASN1 Certificate
cert Certificate
issuerCert =
    let h1 :: ByteString
h1 = Certificate -> ByteString
issuerDNHash Certificate
cert
        h2 :: ByteString
h2 = Certificate -> ByteString
pubKeyHash Certificate
issuerCert
        sn :: Integer
sn = Certificate -> Integer
certSerial Certificate
cert
    in ( [ ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence
         , ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence
         , ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence
         , ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence
         , ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence
         , ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence
         , [Integer] -> ASN1
OID [Integer]
OidAlgorithmSHA1
         , ASN1
Null
         , ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence
         , ByteString -> ASN1
OctetString ByteString
h1
         , ByteString -> ASN1
OctetString ByteString
h2
         , Integer -> ASN1
IntVal Integer
sn
         , ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence
         , ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence
         , ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence
         , ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence
         , ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence
         ]
       , ByteString -> ByteString -> Integer -> CertId
CertId ByteString
h1 ByteString
h2 Integer
sn
       )

-- | Build and encode OCSP request in ASN.1\/DER format.
--
-- The returned value contains the encoded request and an object of type
-- 'CertId' with hashes calculated by the SHA1 algorithm.
encodeOCSPRequest
    :: Certificate              -- ^ Certificate
    -> Certificate              -- ^ Issuer certificate
    -> (L.ByteString, CertId)
encodeOCSPRequest :: Certificate -> Certificate -> (ByteString, CertId)
encodeOCSPRequest = (([ASN1] -> ByteString) -> ([ASN1], CertId) -> (ByteString, CertId)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (DER -> [ASN1] -> ByteString
forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
encodeASN1 DER
DER) (([ASN1], CertId) -> (ByteString, CertId))
-> (Certificate -> ([ASN1], CertId))
-> Certificate
-> (ByteString, CertId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Certificate -> ([ASN1], CertId))
 -> Certificate -> (ByteString, CertId))
-> (Certificate -> Certificate -> ([ASN1], CertId))
-> Certificate
-> Certificate
-> (ByteString, CertId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Certificate -> Certificate -> ([ASN1], CertId)
encodeOCSPRequestASN1

-- | OCSP response data.
data OCSPResponse =
    OCSPResponse { OCSPResponse -> OCSPResponseStatus
ocspRespStatus :: OCSPResponseStatus
                   -- ^ Response status
                 , OCSPResponse -> Maybe OCSPResponsePayload
ocspRespPayload :: Maybe OCSPResponsePayload
                   -- ^ Response payload data
                 } deriving (Int -> OCSPResponse -> ShowS
[OCSPResponse] -> ShowS
OCSPResponse -> [Char]
(Int -> OCSPResponse -> ShowS)
-> (OCSPResponse -> [Char])
-> ([OCSPResponse] -> ShowS)
-> Show OCSPResponse
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OCSPResponse -> ShowS
showsPrec :: Int -> OCSPResponse -> ShowS
$cshow :: OCSPResponse -> [Char]
show :: OCSPResponse -> [Char]
$cshowList :: [OCSPResponse] -> ShowS
showList :: [OCSPResponse] -> ShowS
Show, OCSPResponse -> OCSPResponse -> Bool
(OCSPResponse -> OCSPResponse -> Bool)
-> (OCSPResponse -> OCSPResponse -> Bool) -> Eq OCSPResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OCSPResponse -> OCSPResponse -> Bool
== :: OCSPResponse -> OCSPResponse -> Bool
$c/= :: OCSPResponse -> OCSPResponse -> Bool
/= :: OCSPResponse -> OCSPResponse -> Bool
Eq)

-- | Status of OCSP response as defined in /rfc6960/.
data OCSPResponseStatus = OCSPRespSuccessful
                        | OCSPRespMalformedRequest
                        | OCSPRespInternalError
                        | OCSPRespUnused1
                        | OCSPRespTryLater
                        | OCSPRespSigRequired
                        | OCSPRespUnauthorized
                        deriving (Int -> OCSPResponseStatus -> ShowS
[OCSPResponseStatus] -> ShowS
OCSPResponseStatus -> [Char]
(Int -> OCSPResponseStatus -> ShowS)
-> (OCSPResponseStatus -> [Char])
-> ([OCSPResponseStatus] -> ShowS)
-> Show OCSPResponseStatus
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OCSPResponseStatus -> ShowS
showsPrec :: Int -> OCSPResponseStatus -> ShowS
$cshow :: OCSPResponseStatus -> [Char]
show :: OCSPResponseStatus -> [Char]
$cshowList :: [OCSPResponseStatus] -> ShowS
showList :: [OCSPResponseStatus] -> ShowS
Show, OCSPResponseStatus -> OCSPResponseStatus -> Bool
(OCSPResponseStatus -> OCSPResponseStatus -> Bool)
-> (OCSPResponseStatus -> OCSPResponseStatus -> Bool)
-> Eq OCSPResponseStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OCSPResponseStatus -> OCSPResponseStatus -> Bool
== :: OCSPResponseStatus -> OCSPResponseStatus -> Bool
$c/= :: OCSPResponseStatus -> OCSPResponseStatus -> Bool
/= :: OCSPResponseStatus -> OCSPResponseStatus -> Bool
Eq, OCSPResponseStatus
OCSPResponseStatus
-> OCSPResponseStatus -> Bounded OCSPResponseStatus
forall a. a -> a -> Bounded a
$cminBound :: OCSPResponseStatus
minBound :: OCSPResponseStatus
$cmaxBound :: OCSPResponseStatus
maxBound :: OCSPResponseStatus
Bounded, Int -> OCSPResponseStatus
OCSPResponseStatus -> Int
OCSPResponseStatus -> [OCSPResponseStatus]
OCSPResponseStatus -> OCSPResponseStatus
OCSPResponseStatus -> OCSPResponseStatus -> [OCSPResponseStatus]
OCSPResponseStatus
-> OCSPResponseStatus -> OCSPResponseStatus -> [OCSPResponseStatus]
(OCSPResponseStatus -> OCSPResponseStatus)
-> (OCSPResponseStatus -> OCSPResponseStatus)
-> (Int -> OCSPResponseStatus)
-> (OCSPResponseStatus -> Int)
-> (OCSPResponseStatus -> [OCSPResponseStatus])
-> (OCSPResponseStatus
    -> OCSPResponseStatus -> [OCSPResponseStatus])
-> (OCSPResponseStatus
    -> OCSPResponseStatus -> [OCSPResponseStatus])
-> (OCSPResponseStatus
    -> OCSPResponseStatus
    -> OCSPResponseStatus
    -> [OCSPResponseStatus])
-> Enum OCSPResponseStatus
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: OCSPResponseStatus -> OCSPResponseStatus
succ :: OCSPResponseStatus -> OCSPResponseStatus
$cpred :: OCSPResponseStatus -> OCSPResponseStatus
pred :: OCSPResponseStatus -> OCSPResponseStatus
$ctoEnum :: Int -> OCSPResponseStatus
toEnum :: Int -> OCSPResponseStatus
$cfromEnum :: OCSPResponseStatus -> Int
fromEnum :: OCSPResponseStatus -> Int
$cenumFrom :: OCSPResponseStatus -> [OCSPResponseStatus]
enumFrom :: OCSPResponseStatus -> [OCSPResponseStatus]
$cenumFromThen :: OCSPResponseStatus -> OCSPResponseStatus -> [OCSPResponseStatus]
enumFromThen :: OCSPResponseStatus -> OCSPResponseStatus -> [OCSPResponseStatus]
$cenumFromTo :: OCSPResponseStatus -> OCSPResponseStatus -> [OCSPResponseStatus]
enumFromTo :: OCSPResponseStatus -> OCSPResponseStatus -> [OCSPResponseStatus]
$cenumFromThenTo :: OCSPResponseStatus
-> OCSPResponseStatus -> OCSPResponseStatus -> [OCSPResponseStatus]
enumFromThenTo :: OCSPResponseStatus
-> OCSPResponseStatus -> OCSPResponseStatus -> [OCSPResponseStatus]
Enum)

-- | Payload data of OCSP response.
data OCSPResponsePayload =
    OCSPResponsePayload { OCSPResponsePayload -> OCSPResponseCertData
ocspRespCertData :: OCSPResponseCertData
                          -- ^ Selected certificate data
                        , OCSPResponsePayload -> [ASN1]
ocspRespData :: [ASN1]
                          -- ^ Whole response payload
                        } deriving (Int -> OCSPResponsePayload -> ShowS
[OCSPResponsePayload] -> ShowS
OCSPResponsePayload -> [Char]
(Int -> OCSPResponsePayload -> ShowS)
-> (OCSPResponsePayload -> [Char])
-> ([OCSPResponsePayload] -> ShowS)
-> Show OCSPResponsePayload
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OCSPResponsePayload -> ShowS
showsPrec :: Int -> OCSPResponsePayload -> ShowS
$cshow :: OCSPResponsePayload -> [Char]
show :: OCSPResponsePayload -> [Char]
$cshowList :: [OCSPResponsePayload] -> ShowS
showList :: [OCSPResponsePayload] -> ShowS
Show, OCSPResponsePayload -> OCSPResponsePayload -> Bool
(OCSPResponsePayload -> OCSPResponsePayload -> Bool)
-> (OCSPResponsePayload -> OCSPResponsePayload -> Bool)
-> Eq OCSPResponsePayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OCSPResponsePayload -> OCSPResponsePayload -> Bool
== :: OCSPResponsePayload -> OCSPResponsePayload -> Bool
$c/= :: OCSPResponsePayload -> OCSPResponsePayload -> Bool
/= :: OCSPResponsePayload -> OCSPResponsePayload -> Bool
Eq)

-- | Selected certificate data of OCSP response.
data OCSPResponseCertData =
    OCSPResponseCertData { OCSPResponseCertData -> OCSPResponseCertStatus
ocspRespCertStatus :: OCSPResponseCertStatus
                           -- ^ Certificate status
                         , OCSPResponseCertData -> ASN1
ocspRespCertThisUpdate :: ASN1
                           -- ^ Value of /thisUpdate/ as defined in /rfc6960/
                         , OCSPResponseCertData -> Maybe ASN1
ocspRespCertNextUpdate :: Maybe ASN1
                           -- ^ Value of /nextUpdate/ as defined in /rfc6960/
                         } deriving (Int -> OCSPResponseCertData -> ShowS
[OCSPResponseCertData] -> ShowS
OCSPResponseCertData -> [Char]
(Int -> OCSPResponseCertData -> ShowS)
-> (OCSPResponseCertData -> [Char])
-> ([OCSPResponseCertData] -> ShowS)
-> Show OCSPResponseCertData
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OCSPResponseCertData -> ShowS
showsPrec :: Int -> OCSPResponseCertData -> ShowS
$cshow :: OCSPResponseCertData -> [Char]
show :: OCSPResponseCertData -> [Char]
$cshowList :: [OCSPResponseCertData] -> ShowS
showList :: [OCSPResponseCertData] -> ShowS
Show, OCSPResponseCertData -> OCSPResponseCertData -> Bool
(OCSPResponseCertData -> OCSPResponseCertData -> Bool)
-> (OCSPResponseCertData -> OCSPResponseCertData -> Bool)
-> Eq OCSPResponseCertData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OCSPResponseCertData -> OCSPResponseCertData -> Bool
== :: OCSPResponseCertData -> OCSPResponseCertData -> Bool
$c/= :: OCSPResponseCertData -> OCSPResponseCertData -> Bool
/= :: OCSPResponseCertData -> OCSPResponseCertData -> Bool
Eq)

-- | Certificate status of OCSP response as defined in /rfc6960/.
data OCSPResponseCertStatus = OCSPRespCertGood
                            | OCSPRespCertRevoked
                            | OCSPRespCertUnknown
                            deriving (Int -> OCSPResponseCertStatus -> ShowS
[OCSPResponseCertStatus] -> ShowS
OCSPResponseCertStatus -> [Char]
(Int -> OCSPResponseCertStatus -> ShowS)
-> (OCSPResponseCertStatus -> [Char])
-> ([OCSPResponseCertStatus] -> ShowS)
-> Show OCSPResponseCertStatus
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OCSPResponseCertStatus -> ShowS
showsPrec :: Int -> OCSPResponseCertStatus -> ShowS
$cshow :: OCSPResponseCertStatus -> [Char]
show :: OCSPResponseCertStatus -> [Char]
$cshowList :: [OCSPResponseCertStatus] -> ShowS
showList :: [OCSPResponseCertStatus] -> ShowS
Show, OCSPResponseCertStatus -> OCSPResponseCertStatus -> Bool
(OCSPResponseCertStatus -> OCSPResponseCertStatus -> Bool)
-> (OCSPResponseCertStatus -> OCSPResponseCertStatus -> Bool)
-> Eq OCSPResponseCertStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OCSPResponseCertStatus -> OCSPResponseCertStatus -> Bool
== :: OCSPResponseCertStatus -> OCSPResponseCertStatus -> Bool
$c/= :: OCSPResponseCertStatus -> OCSPResponseCertStatus -> Bool
/= :: OCSPResponseCertStatus -> OCSPResponseCertStatus -> Bool
Eq, OCSPResponseCertStatus
OCSPResponseCertStatus
-> OCSPResponseCertStatus -> Bounded OCSPResponseCertStatus
forall a. a -> a -> Bounded a
$cminBound :: OCSPResponseCertStatus
minBound :: OCSPResponseCertStatus
$cmaxBound :: OCSPResponseCertStatus
maxBound :: OCSPResponseCertStatus
Bounded, Int -> OCSPResponseCertStatus
OCSPResponseCertStatus -> Int
OCSPResponseCertStatus -> [OCSPResponseCertStatus]
OCSPResponseCertStatus -> OCSPResponseCertStatus
OCSPResponseCertStatus
-> OCSPResponseCertStatus -> [OCSPResponseCertStatus]
OCSPResponseCertStatus
-> OCSPResponseCertStatus
-> OCSPResponseCertStatus
-> [OCSPResponseCertStatus]
(OCSPResponseCertStatus -> OCSPResponseCertStatus)
-> (OCSPResponseCertStatus -> OCSPResponseCertStatus)
-> (Int -> OCSPResponseCertStatus)
-> (OCSPResponseCertStatus -> Int)
-> (OCSPResponseCertStatus -> [OCSPResponseCertStatus])
-> (OCSPResponseCertStatus
    -> OCSPResponseCertStatus -> [OCSPResponseCertStatus])
-> (OCSPResponseCertStatus
    -> OCSPResponseCertStatus -> [OCSPResponseCertStatus])
-> (OCSPResponseCertStatus
    -> OCSPResponseCertStatus
    -> OCSPResponseCertStatus
    -> [OCSPResponseCertStatus])
-> Enum OCSPResponseCertStatus
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: OCSPResponseCertStatus -> OCSPResponseCertStatus
succ :: OCSPResponseCertStatus -> OCSPResponseCertStatus
$cpred :: OCSPResponseCertStatus -> OCSPResponseCertStatus
pred :: OCSPResponseCertStatus -> OCSPResponseCertStatus
$ctoEnum :: Int -> OCSPResponseCertStatus
toEnum :: Int -> OCSPResponseCertStatus
$cfromEnum :: OCSPResponseCertStatus -> Int
fromEnum :: OCSPResponseCertStatus -> Int
$cenumFrom :: OCSPResponseCertStatus -> [OCSPResponseCertStatus]
enumFrom :: OCSPResponseCertStatus -> [OCSPResponseCertStatus]
$cenumFromThen :: OCSPResponseCertStatus
-> OCSPResponseCertStatus -> [OCSPResponseCertStatus]
enumFromThen :: OCSPResponseCertStatus
-> OCSPResponseCertStatus -> [OCSPResponseCertStatus]
$cenumFromTo :: OCSPResponseCertStatus
-> OCSPResponseCertStatus -> [OCSPResponseCertStatus]
enumFromTo :: OCSPResponseCertStatus
-> OCSPResponseCertStatus -> [OCSPResponseCertStatus]
$cenumFromThenTo :: OCSPResponseCertStatus
-> OCSPResponseCertStatus
-> OCSPResponseCertStatus
-> [OCSPResponseCertStatus]
enumFromThenTo :: OCSPResponseCertStatus
-> OCSPResponseCertStatus
-> OCSPResponseCertStatus
-> [OCSPResponseCertStatus]
Enum)

-- | 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             -- ^ OCSP response
    -> Either ASN1Error (Maybe OCSPResponse)
decodeOCSPResponse :: CertId -> ByteString -> Either ASN1Error (Maybe OCSPResponse)
decodeOCSPResponse CertId
certId ByteString
resp = DER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1 DER
DER ByteString
resp Either ASN1Error [ASN1]
-> ([ASN1] -> Either ASN1Error (Maybe OCSPResponse))
-> Either ASN1Error (Maybe OCSPResponse)
forall a b.
Either ASN1Error a
-> (a -> Either ASN1Error b) -> Either ASN1Error b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    [ Start ASN1ConstructionType
Sequence
      , Enumerated (Int -> OCSPResponseStatus
forall a. Enum a => Int -> a
toEnum (Int -> OCSPResponseStatus)
-> (Integer -> Int) -> Integer -> OCSPResponseStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> OCSPResponseStatus
v)
      , End ASN1ConstructionType
Sequence
      ] -> Maybe OCSPResponse -> Either ASN1Error (Maybe OCSPResponse)
forall a b. b -> Either a b
Right (Maybe OCSPResponse -> Either ASN1Error (Maybe OCSPResponse))
-> Maybe OCSPResponse -> Either ASN1Error (Maybe OCSPResponse)
forall a b. (a -> b) -> a -> b
$ OCSPResponse -> Maybe OCSPResponse
forall a. a -> Maybe a
Just (OCSPResponse -> Maybe OCSPResponse)
-> OCSPResponse -> Maybe OCSPResponse
forall a b. (a -> b) -> a -> b
$ OCSPResponseStatus -> Maybe OCSPResponsePayload -> OCSPResponse
OCSPResponse OCSPResponseStatus
v Maybe OCSPResponsePayload
forall a. Maybe a
Nothing
    [ Start ASN1ConstructionType
Sequence
      , Enumerated (Int -> OCSPResponseStatus
forall a. Enum a => Int -> a
toEnum (Int -> OCSPResponseStatus)
-> (Integer -> Int) -> Integer -> OCSPResponseStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> OCSPResponseStatus
v)
      , Start (Container ASN1Class
Context Int
0)
      , Start ASN1ConstructionType
Sequence
      , OID [Integer]
OidBasicOCSPResponse
      , OctetString ByteString
resp'
      , End ASN1ConstructionType
Sequence
      , End (Container ASN1Class
Context Int
0)
      , End ASN1ConstructionType
Sequence
      ] -> do
          [ASN1]
pl <- DER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1 DER
DER (ByteString -> Either ASN1Error [ASN1])
-> ByteString -> Either ASN1Error [ASN1]
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
L.fromStrict ByteString
resp'
          Maybe OCSPResponse -> Either ASN1Error (Maybe OCSPResponse)
forall a b. b -> Either a b
Right (Maybe OCSPResponse -> Either ASN1Error (Maybe OCSPResponse))
-> Maybe OCSPResponse -> Either ASN1Error (Maybe OCSPResponse)
forall a b. (a -> b) -> a -> b
$
              case [ASN1]
pl of
                  Start ASN1ConstructionType
Sequence
                    : Start ASN1ConstructionType
Sequence
                    : Start (Container ASN1Class
Context Int
ctx)
                    : [ASN1]
c1 | Int
ctx Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
0..Int
2] -> do
                        let skipVersion :: ASN1S
skipVersion =
                                if Int
ctx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                                    then Int -> ASN1S
forall a. Int -> [a] -> [a]
drop Int
1 ASN1S -> ASN1S -> ASN1S
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1S
skipCurrentContainer
                                    else ASN1S
forall a. a -> a
id
                        [ASN1] -> Maybe [ASN1]
forall a. a -> Maybe a
Just ([ASN1] -> Maybe [ASN1]) -> [ASN1] -> Maybe [ASN1]
forall a b. (a -> b) -> a -> b
$ ASN1S
getCurrentContainerContents ASN1S -> ASN1S
forall a b. (a -> b) -> a -> b
$
                            Int -> ASN1S
forall a. Int -> [a] -> [a]
drop Int
2 ASN1S -> ASN1S
forall a b. (a -> b) -> a -> b
$ ASN1S
skipCurrentContainer ASN1S -> ASN1S
forall a b. (a -> b) -> a -> b
$ ASN1S
skipVersion [ASN1]
c1
                  [ASN1]
_ -> Maybe [ASN1]
forall a. Maybe a
Nothing
              Maybe [ASN1]
-> ([ASN1] -> Maybe (OCSPResponseCertStatus, [ASN1]))
-> Maybe (OCSPResponseCertStatus, [ASN1])
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                      Start ASN1ConstructionType
Sequence
                        : Start ASN1ConstructionType
Sequence
                        : Start ASN1ConstructionType
Sequence
                        : OID [Integer]
_
                        : ASN1
_
                        : End ASN1ConstructionType
Sequence
                        : OctetString ByteString
h1
                        : OctetString ByteString
h2
                        : IntVal Integer
sn
                        : End ASN1ConstructionType
Sequence
                        : [ASN1]
c2 | ByteString -> ByteString -> Integer -> CertId
CertId ByteString
h1 ByteString
h2 Integer
sn CertId -> CertId -> Bool
forall a. Eq a => a -> a -> Bool
== CertId
certId ->
                            case [ASN1]
c2 of
                                Other ASN1Class
Context (Int -> OCSPResponseCertStatus
forall a. Enum a => Int -> a
toEnum -> OCSPResponseCertStatus
n) ByteString
_
                                  : [ASN1]
c3 -> (OCSPResponseCertStatus, [ASN1])
-> Maybe (OCSPResponseCertStatus, [ASN1])
forall a. a -> Maybe a
Just (OCSPResponseCertStatus
n, [ASN1]
c3)
                                Start (Container ASN1Class
Context (Int -> OCSPResponseCertStatus
forall a. Enum a => Int -> a
toEnum -> OCSPResponseCertStatus
n))
                                  : [ASN1]
c3 -> (OCSPResponseCertStatus, [ASN1])
-> Maybe (OCSPResponseCertStatus, [ASN1])
forall a. a -> Maybe a
Just (OCSPResponseCertStatus
n, ASN1S
skipCurrentContainer [ASN1]
c3)
                                [ASN1]
_ -> Maybe (OCSPResponseCertStatus, [ASN1])
forall a. Maybe a
Nothing
                      [ASN1]
_ -> Maybe (OCSPResponseCertStatus, [ASN1])
forall a. Maybe a
Nothing
              Maybe (OCSPResponseCertStatus, [ASN1])
-> ((OCSPResponseCertStatus, [ASN1]) -> Maybe OCSPResponse)
-> Maybe OCSPResponse
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(OCSPResponseCertStatus
n, [ASN1]
tc1) -> case [ASN1]
tc1 of
                                   tu :: ASN1
tu@(ASN1Time ASN1TimeType
TimeGeneralized DateTime
_ Maybe TimezoneOffset
_)
                                     : [ASN1]
c4 -> (OCSPResponseCertStatus, ASN1, [ASN1])
-> Maybe (OCSPResponseCertStatus, ASN1, [ASN1])
forall a. a -> Maybe a
Just (OCSPResponseCertStatus
n, ASN1
tu, [ASN1]
c4)
                                   [ASN1]
_ -> Maybe (OCSPResponseCertStatus, ASN1, [ASN1])
forall a. Maybe a
Nothing
              Maybe (OCSPResponseCertStatus, ASN1, [ASN1])
-> ((OCSPResponseCertStatus, ASN1, [ASN1]) -> Maybe OCSPResponse)
-> Maybe OCSPResponse
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(OCSPResponseCertStatus
st, ASN1
tu, [ASN1]
tc2) -> do
                  let nu :: Maybe ASN1
nu = case [ASN1]
tc2 of
                               Start (Container ASN1Class
Context Int
0)
                                 : t :: ASN1
t@(ASN1Time ASN1TimeType
TimeGeneralized DateTime
_ Maybe TimezoneOffset
_)
                                 : End (Container ASN1Class
Context Int
0)
                                 : [ASN1]
_ -> ASN1 -> Maybe ASN1
forall a. a -> Maybe a
Just ASN1
t
                               [ASN1]
_ -> Maybe ASN1
forall a. Maybe a
Nothing
                  OCSPResponse -> Maybe OCSPResponse
forall a. a -> Maybe a
Just (OCSPResponse -> Maybe OCSPResponse)
-> OCSPResponse -> Maybe OCSPResponse
forall a b. (a -> b) -> a -> b
$ OCSPResponseStatus -> Maybe OCSPResponsePayload -> OCSPResponse
OCSPResponse OCSPResponseStatus
v (Maybe OCSPResponsePayload -> OCSPResponse)
-> Maybe OCSPResponsePayload -> OCSPResponse
forall a b. (a -> b) -> a -> b
$
                      OCSPResponsePayload -> Maybe OCSPResponsePayload
forall a. a -> Maybe a
Just (OCSPResponsePayload -> Maybe OCSPResponsePayload)
-> OCSPResponsePayload -> Maybe OCSPResponsePayload
forall a b. (a -> b) -> a -> b
$ OCSPResponseCertData -> [ASN1] -> OCSPResponsePayload
OCSPResponsePayload
                          (OCSPResponseCertStatus
-> ASN1 -> Maybe ASN1 -> OCSPResponseCertData
OCSPResponseCertData OCSPResponseCertStatus
st ASN1
tu Maybe ASN1
nu) [ASN1]
pl
    [ASN1]
_ -> Maybe OCSPResponse -> Either ASN1Error (Maybe OCSPResponse)
forall a b. b -> Either a b
Right Maybe OCSPResponse
forall a. Maybe a
Nothing
    where getCurrentContainerContents :: ASN1S
getCurrentContainerContents = ([ASN1], [ASN1]) -> [ASN1]
forall a b. (a, b) -> a
fst (([ASN1], [ASN1]) -> [ASN1])
-> ([ASN1] -> ([ASN1], [ASN1])) -> ASN1S
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [ASN1] -> ([ASN1], [ASN1])
getConstructedEnd Int
0
          skipCurrentContainer :: ASN1S
skipCurrentContainer = ([ASN1], [ASN1]) -> [ASN1]
forall a b. (a, b) -> b
snd (([ASN1], [ASN1]) -> [ASN1])
-> ([ASN1] -> ([ASN1], [ASN1])) -> ASN1S
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [ASN1] -> ([ASN1], [ASN1])
getConstructedEnd Int
0