{-|
Module      : Z.Crypto.X509
Description : X.509 Certificates and CRLs
Copyright   : Dong Han, 2021
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

X.509 Certificates read, write and verification.

-}
module Z.Crypto.X509 (
  -- * X509 Certificates
    Cert, withCert, loadCert, loadCertFile, dupCert
  -- * read X509 field
  , certStart, certExpire
  , certStart', certExpire'
  , certStartText, certExpireText
  , certFingerPrint
  , certSerial
  , certIDAuthority
  , certIDSubject
  , certPubBits
  , certPubKey
  , certDNIssuer
  , certDNSubject
  , certToText
  , certUsage
  -- * verify certificate
  , verifyCert
  , verifyCertCRL
  , verifyCertCRL'
  -- * CRL
  , CRL
  , withCRL, loadCRL, loadCRLFile, isRevokedX509
  -- * CertStore
  , CertStore, withCertStore, loadCertStoreFile
  , mozillaCertStore
  , systemCertStore
  -- * constants
  , KeyUsageConstraint
  , pattern NO_CONSTRAINTS
  , pattern DIGITAL_SIGNATURE
  , pattern NON_REPUDIATION
  , pattern KEY_ENCIPHERMENT
  , pattern DATA_ENCIPHERMENT
  , pattern KEY_AGREEMENT
  , pattern KEY_CERT_SIGN
  , pattern CRL_SIGN
  , pattern ENCIPHER_ONLY
  , pattern DECIPHER_ONLY
  ) where

import           Data.Time.Clock.System (SystemTime (..))
import           Data.Word
import           GHC.Generics
import           Z.Botan.Exception
import           Z.Botan.FFI
import           Z.Crypto.Hash          (HashType, hashTypeToCBytes)
import           Z.Crypto.PubKey        (PubKey, botanStructToPubKey)
import qualified Z.Data.Text            as T
import qualified Z.Data.Text.Base       as T
import qualified Z.Data.Vector          as V
import qualified Z.Data.Vector.Extra    as V
import           Z.Data.CBytes          (CBytes)
import qualified Z.Data.CBytes          as CB
import           Z.Foreign
import           Z.Foreign.CPtr
import           System.IO.Unsafe
import           Paths_Z_Botan           (getDataFileName)

------------------------
-- X.509 Certificates --
------------------------

-- | An opaque newtype wrapper for an X.509 certificate.
--
-- A certificate is a binding between some identifying information (called a subject) and a public key.
-- This binding is asserted by a signature on the certificate, which is placed there by some authority (the issuer) that at least claims that it knows the subject named in the certificate really “owns” the private key corresponding to the public key in the certificate.
--
-- The major certificate format in use today is X.509v3, used for instance in the Transport Layer Security (TLS) protocol. A X.509 certificate is represented by the type 'Cert'.
newtype Cert = Cert { Cert -> BotanStruct
certStruct :: BotanStruct }
    deriving (Int -> Cert -> ShowS
[Cert] -> ShowS
Cert -> String
(Int -> Cert -> ShowS)
-> (Cert -> String) -> ([Cert] -> ShowS) -> Show Cert
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cert] -> ShowS
$cshowList :: [Cert] -> ShowS
show :: Cert -> String
$cshow :: Cert -> String
showsPrec :: Int -> Cert -> ShowS
$cshowsPrec :: Int -> Cert -> ShowS
Show, (forall x. Cert -> Rep Cert x)
-> (forall x. Rep Cert x -> Cert) -> Generic Cert
forall x. Rep Cert x -> Cert
forall x. Cert -> Rep Cert x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cert x -> Cert
$cfrom :: forall x. Cert -> Rep Cert x
Generic)
    deriving anyclass Int -> Cert -> Builder ()
(Int -> Cert -> Builder ()) -> Print Cert
forall a. (Int -> a -> Builder ()) -> Print a
toUTF8BuilderP :: Int -> Cert -> Builder ()
$ctoUTF8BuilderP :: Int -> Cert -> Builder ()
T.Print

-- | Use 'Cert' as a `botan_cert_t`.
withCert :: Cert -> (BotanStructT -> IO r) -> IO r
{-# INLINABLE withCert #-}
withCert :: Cert -> (BotanStructT -> IO r) -> IO r
withCert (Cert BotanStruct
cert) = BotanStruct -> (BotanStructT -> IO r) -> IO r
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
cert

-- | Load a certificate from the DER or PEM representation.
loadCert :: HasCallStack => V.Bytes -> IO Cert
{-# INLINABLE loadCert #-}
loadCert :: Bytes -> IO Cert
loadCert Bytes
cert = do
    Bytes -> (BA# Word8 -> Int -> Int -> IO Cert) -> IO Cert
forall a b.
Prim a =>
PrimVector a -> (BA# Word8 -> Int -> Int -> IO b) -> IO b
withPrimVectorUnsafe Bytes
cert ((BA# Word8 -> Int -> Int -> IO Cert) -> IO Cert)
-> (BA# Word8 -> Int -> Int -> IO Cert) -> IO Cert
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
cert' Int
off Int
len ->
        BotanStruct -> Cert
Cert (BotanStruct -> Cert) -> IO BotanStruct -> IO Cert
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO ()) -> IO BotanStruct
forall a.
HasCallStack =>
(MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO a) -> IO BotanStruct
newBotanStruct
            (\ MBA# BotanStructT
ret -> MBA# BotanStructT -> BA# Word8 -> Int -> Int -> IO CInt
hs_botan_x509_cert_load MBA# BotanStructT
ret BA# Word8
cert' Int
off Int
len)
            FunPtr (BotanStructT -> IO ())
botan_x509_cert_destroy

-- | Load a certificate from a file.
loadCertFile :: HasCallStack => CBytes -> IO Cert
{-# INLINABLE loadCertFile #-}
loadCertFile :: CBytes -> IO Cert
loadCertFile CBytes
name = do
    CBytes -> (BA# Word8 -> IO Cert) -> IO Cert
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
CB.withCBytesUnsafe CBytes
name ((BA# Word8 -> IO Cert) -> IO Cert)
-> (BA# Word8 -> IO Cert) -> IO Cert
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
name' ->
        BotanStruct -> Cert
Cert (BotanStruct -> Cert) -> IO BotanStruct -> IO Cert
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO ()) -> IO BotanStruct
forall a.
HasCallStack =>
(MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO a) -> IO BotanStruct
newBotanStruct
            (MBA# BotanStructT -> BA# Word8 -> IO CInt
`botan_x509_cert_load_file` BA# Word8
name')
            FunPtr (BotanStructT -> IO ())
botan_x509_cert_destroy

-- | Create a new object that refers to the same certificate.
dupCert :: HasCallStack => Cert -> IO Cert
{-# INLINABLE dupCert #-}
dupCert :: Cert -> IO Cert
dupCert Cert
cert = do
    Cert -> (BotanStructT -> IO Cert) -> IO Cert
forall r. Cert -> (BotanStructT -> IO r) -> IO r
withCert Cert
cert ((BotanStructT -> IO Cert) -> IO Cert)
-> (BotanStructT -> IO Cert) -> IO Cert
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
cert' ->
        BotanStruct -> Cert
Cert (BotanStruct -> Cert) -> IO BotanStruct -> IO Cert
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO ()) -> IO BotanStruct
forall a.
HasCallStack =>
(MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO a) -> IO BotanStruct
newBotanStruct
            (MBA# BotanStructT -> BotanStructT -> IO CInt
`botan_x509_cert_dup` BotanStructT
cert')
            FunPtr (BotanStructT -> IO ())
botan_x509_cert_destroy

{- NO IMPLEMENTED IN BOTAN
-- | Create a new self-signed X.509 certificate.
-- Generating a new self-signed certificate can often be useful, for example when setting up a new root CA, or for use in specialized protocols.
newCertSelfsigned ::
  -- | the private key you wish to use (the public key, used in the certificate itself is extracted from the private key)
  PrivKey ->
  RNG ->
  -- | common name
  CBytes ->
  -- | org name
  CBytes ->
  IO Cert
newCertSelfsigned (PrivKey key) rng common org =
    withBotanStruct key $ \ key' ->
    withRNG rng $ \ rng' ->
    CB.withCBytesUnsafe common $ \ common' ->
    CB.withCBytesUnsafe org $ \ org' ->
        Cert <$> newBotanStruct
            (\ ret -> botan_x509_cert_gen_selfsigned ret key' rng' common' org')
            botan_x509_cert_destroy
-}

-- | Return the time the certificate becomes valid, as a 'T.Text' in form “YYYYMMDDHHMMSSZ” where Z is a literal character reflecting that this time is relative to UTC.
certStartText :: Cert -> IO T.Text
{-# INLINABLE certStartText #-}
certStartText :: Cert -> IO Text
certStartText Cert
cert =
    Cert -> (BotanStructT -> IO Text) -> IO Text
forall r. Cert -> (BotanStructT -> IO r) -> IO r
withCert Cert
cert ((BotanStructT -> IO Text) -> IO Text)
-> (BotanStructT -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
cert' ->
    Int
-> (MBA# BotanStructT -> MBA# BotanStructT -> IO CInt) -> IO Text
forall r.
(HasCallStack, Integral r) =>
Int -> (MBA# BotanStructT -> MBA# BotanStructT -> IO r) -> IO Text
allocBotanBufferUTF8Unsafe Int
16 (BotanStructT -> MBA# BotanStructT -> MBA# BotanStructT -> IO CInt
botan_x509_cert_get_time_starts BotanStructT
cert')

-- | Return the time the certificate expires, as a 'T.Text' in form “YYYYMMDDHHMMSSZ” where Z is a literal character reflecting that this time is relative to UTC.
certExpireText :: Cert -> IO T.Text
{-# INLINABLE certExpireText #-}
certExpireText :: Cert -> IO Text
certExpireText Cert
cert =
    Cert -> (BotanStructT -> IO Text) -> IO Text
forall r. Cert -> (BotanStructT -> IO r) -> IO r
withCert Cert
cert ((BotanStructT -> IO Text) -> IO Text)
-> (BotanStructT -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
cert' ->
    Int
-> (MBA# BotanStructT -> MBA# BotanStructT -> IO CInt) -> IO Text
forall r.
(HasCallStack, Integral r) =>
Int -> (MBA# BotanStructT -> MBA# BotanStructT -> IO r) -> IO Text
allocBotanBufferUTF8Unsafe Int
16 (BotanStructT -> MBA# BotanStructT -> MBA# BotanStructT -> IO CInt
botan_x509_cert_get_time_expires BotanStructT
cert')

-- | Return the time the certificate becomes valid, as seconds since epoch.
certStart :: Cert -> IO Word64
{-# INLINABLE certStart #-}
certStart :: Cert -> IO Word64
certStart Cert
cert =
    Cert -> (BotanStructT -> IO Word64) -> IO Word64
forall r. Cert -> (BotanStructT -> IO r) -> IO r
withCert Cert
cert ((BotanStructT -> IO Word64) -> IO Word64)
-> (BotanStructT -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
cert' -> do
        (Word64
a, CInt
_) <- forall b.
Prim Word64 =>
(MBA# BotanStructT -> IO b) -> IO (Word64, b)
forall a b. Prim a => (MBA# BotanStructT -> IO b) -> IO (a, b)
allocPrimUnsafe @Word64 ((MBA# BotanStructT -> IO CInt) -> IO (Word64, CInt))
-> (MBA# BotanStructT -> IO CInt) -> IO (Word64, CInt)
forall a b. (a -> b) -> a -> b
$ BotanStructT -> MBA# BotanStructT -> IO CInt
botan_x509_cert_not_before BotanStructT
cert'
        Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
a

-- | Return the time the certificate becomes valid.
certStart' :: Cert -> IO SystemTime
{-# INLINABLE certStart' #-}
certStart' :: Cert -> IO SystemTime
certStart' Cert
cert = do
    !Int64
r <- Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> IO Word64 -> IO Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cert -> IO Word64
certStart Cert
cert
    SystemTime -> IO SystemTime
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Word32 -> SystemTime
MkSystemTime Int64
r Word32
0)

-- | Return the time the certificate expires, as 'SystemTime'.
certExpire :: Cert -> IO Word64
{-# INLINABLE certExpire #-}
certExpire :: Cert -> IO Word64
certExpire Cert
cert =
    Cert -> (BotanStructT -> IO Word64) -> IO Word64
forall r. Cert -> (BotanStructT -> IO r) -> IO r
withCert Cert
cert ((BotanStructT -> IO Word64) -> IO Word64)
-> (BotanStructT -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
cert' -> do
        (Word64
a, CInt
_) <- forall b.
Prim Word64 =>
(MBA# BotanStructT -> IO b) -> IO (Word64, b)
forall a b. Prim a => (MBA# BotanStructT -> IO b) -> IO (a, b)
allocPrimUnsafe @Word64 ((MBA# BotanStructT -> IO CInt) -> IO (Word64, CInt))
-> (MBA# BotanStructT -> IO CInt) -> IO (Word64, CInt)
forall a b. (a -> b) -> a -> b
$ BotanStructT -> MBA# BotanStructT -> IO CInt
botan_x509_cert_not_after BotanStructT
cert'
        Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
a

-- | Return the time the certificate expires, as 'SystemTime'.
certExpire' :: Cert -> IO SystemTime
{-# INLINABLE certExpire' #-}
certExpire' :: Cert -> IO SystemTime
certExpire' Cert
cert = do
    !Int64
r <- Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> IO Word64 -> IO Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cert -> IO Word64
certExpire Cert
cert
    SystemTime -> IO SystemTime
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Word32 -> SystemTime
MkSystemTime Int64
r Word32
0)

-- | Return the finger print of the certificate.
certFingerPrint :: Cert -> HashType -> IO T.Text
{-# INLINABLE certFingerPrint #-}
certFingerPrint :: Cert -> HashType -> IO Text
certFingerPrint Cert
cert HashType
ht =
    Cert -> (BotanStructT -> IO Text) -> IO Text
forall r. Cert -> (BotanStructT -> IO r) -> IO r
withCert Cert
cert ((BotanStructT -> IO Text) -> IO Text)
-> (BotanStructT -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
cert' ->
    CBytes -> (BA# Word8 -> IO Text) -> IO Text
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
CB.withCBytesUnsafe (HashType -> CBytes
hashTypeToCBytes HashType
ht) ((BA# Word8 -> IO Text) -> IO Text)
-> (BA# Word8 -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
ht' ->
    Int
-> (MBA# BotanStructT -> MBA# BotanStructT -> IO CInt) -> IO Text
forall r.
(HasCallStack, Integral r) =>
Int -> (MBA# BotanStructT -> MBA# BotanStructT -> IO r) -> IO Text
allocBotanBufferUTF8Unsafe Int
V.smallChunkSize ((MBA# BotanStructT -> MBA# BotanStructT -> IO CInt) -> IO Text)
-> (MBA# BotanStructT -> MBA# BotanStructT -> IO CInt) -> IO Text
forall a b. (a -> b) -> a -> b
$
        BotanStructT
-> BA# Word8 -> MBA# BotanStructT -> MBA# BotanStructT -> IO CInt
botan_x509_cert_get_fingerprint BotanStructT
cert' BA# Word8
ht'

-- | Return the serial number of the certificate.
certSerial :: Cert -> IO V.Bytes
{-# INLINABLE certSerial #-}
certSerial :: Cert -> IO Bytes
certSerial Cert
cert =
    Cert -> (BotanStructT -> IO Bytes) -> IO Bytes
forall r. Cert -> (BotanStructT -> IO r) -> IO r
withCert Cert
cert ((BotanStructT -> IO Bytes) -> IO Bytes)
-> (BotanStructT -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
cert' ->
    Int
-> (MBA# BotanStructT -> MBA# BotanStructT -> IO CInt) -> IO Bytes
forall r.
(HasCallStack, Integral r) =>
Int -> (MBA# BotanStructT -> MBA# BotanStructT -> IO r) -> IO Bytes
allocBotanBufferUnsafe Int
64 ((MBA# BotanStructT -> MBA# BotanStructT -> IO CInt) -> IO Bytes)
-> (MBA# BotanStructT -> MBA# BotanStructT -> IO CInt) -> IO Bytes
forall a b. (a -> b) -> a -> b
$
        BotanStructT -> MBA# BotanStructT -> MBA# BotanStructT -> IO CInt
botan_x509_cert_get_serial_number BotanStructT
cert'

-- | Return the authority key ID set in the certificate, which may be empty.
certIDAuthority :: Cert -> IO V.Bytes
{-# INLINABLE certIDAuthority #-}
certIDAuthority :: Cert -> IO Bytes
certIDAuthority Cert
cert =
    Cert -> (BotanStructT -> IO Bytes) -> IO Bytes
forall r. Cert -> (BotanStructT -> IO r) -> IO r
withCert Cert
cert ((BotanStructT -> IO Bytes) -> IO Bytes)
-> (BotanStructT -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
cert' ->
    Int
-> (MBA# BotanStructT -> MBA# BotanStructT -> IO CInt) -> IO Bytes
forall r.
(HasCallStack, Integral r) =>
Int -> (MBA# BotanStructT -> MBA# BotanStructT -> IO r) -> IO Bytes
allocBotanBufferUnsafe Int
64 ((MBA# BotanStructT -> MBA# BotanStructT -> IO CInt) -> IO Bytes)
-> (MBA# BotanStructT -> MBA# BotanStructT -> IO CInt) -> IO Bytes
forall a b. (a -> b) -> a -> b
$
        BotanStructT -> MBA# BotanStructT -> MBA# BotanStructT -> IO CInt
botan_x509_cert_get_authority_key_id BotanStructT
cert'

-- | Return the subject key ID set in the certificate, which may be empty.
certIDSubject :: Cert -> IO V.Bytes
{-# INLINABLE certIDSubject #-}
certIDSubject :: Cert -> IO Bytes
certIDSubject Cert
cert =
    Cert -> (BotanStructT -> IO Bytes) -> IO Bytes
forall r. Cert -> (BotanStructT -> IO r) -> IO r
withCert Cert
cert ((BotanStructT -> IO Bytes) -> IO Bytes)
-> (BotanStructT -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
cert' ->
    Int
-> (MBA# BotanStructT -> MBA# BotanStructT -> IO CInt) -> IO Bytes
forall r.
(HasCallStack, Integral r) =>
Int -> (MBA# BotanStructT -> MBA# BotanStructT -> IO r) -> IO Bytes
allocBotanBufferUnsafe Int
64 ((MBA# BotanStructT -> MBA# BotanStructT -> IO CInt) -> IO Bytes)
-> (MBA# BotanStructT -> MBA# BotanStructT -> IO CInt) -> IO Bytes
forall a b. (a -> b) -> a -> b
$
        BotanStructT -> MBA# BotanStructT -> MBA# BotanStructT -> IO CInt
botan_x509_cert_get_subject_key_id BotanStructT
cert'

-- | Get the serialized representation of the public key included in this certificate.
certPubBits :: Cert -> IO V.Bytes
{-# INLINABLE certPubBits #-}
certPubBits :: Cert -> IO Bytes
certPubBits Cert
cert =
    Cert -> (BotanStructT -> IO Bytes) -> IO Bytes
forall r. Cert -> (BotanStructT -> IO r) -> IO r
withCert Cert
cert ((BotanStructT -> IO Bytes) -> IO Bytes)
-> (BotanStructT -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
cert' ->
    Int
-> (MBA# BotanStructT -> MBA# BotanStructT -> IO CInt) -> IO Bytes
forall r.
(HasCallStack, Integral r) =>
Int -> (MBA# BotanStructT -> MBA# BotanStructT -> IO r) -> IO Bytes
allocBotanBufferUnsafe Int
V.smallChunkSize ((MBA# BotanStructT -> MBA# BotanStructT -> IO CInt) -> IO Bytes)
-> (MBA# BotanStructT -> MBA# BotanStructT -> IO CInt) -> IO Bytes
forall a b. (a -> b) -> a -> b
$
        BotanStructT -> MBA# BotanStructT -> MBA# BotanStructT -> IO CInt
botan_x509_cert_get_public_key_bits BotanStructT
cert'

-- | Get the public key included in this certificate.
certPubKey :: Cert -> IO PubKey
{-# INLINABLE certPubKey #-}
certPubKey :: Cert -> IO PubKey
certPubKey Cert
cert = do
    Cert -> (BotanStructT -> IO PubKey) -> IO PubKey
forall r. Cert -> (BotanStructT -> IO r) -> IO r
withCert Cert
cert ((BotanStructT -> IO PubKey) -> IO PubKey)
-> (BotanStructT -> IO PubKey) -> IO PubKey
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
cert' ->
        BotanStruct -> PubKey
botanStructToPubKey (BotanStruct -> PubKey) -> IO BotanStruct -> IO PubKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO ()) -> IO BotanStruct
forall a.
HasCallStack =>
(MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO a) -> IO BotanStruct
newBotanStruct
            (BotanStructT
cert' BotanStructT -> MBA# BotanStructT -> IO CInt
`botan_x509_cert_get_public_key`)
            FunPtr (BotanStructT -> IO ())
botan_pubkey_destroy

-- | Get a value from the issuer DN field, throw exception if not exists.
certDNIssuer ::
    HasCallStack =>
    Cert ->
    -- | key
    CBytes ->
    -- | index
    Int ->
    IO T.Text
{-# INLINABLE  certDNIssuer #-}
certDNIssuer :: Cert -> CBytes -> Int -> IO Text
certDNIssuer Cert
cert CBytes
key Int
ix =
    Cert -> (BotanStructT -> IO Text) -> IO Text
forall r. Cert -> (BotanStructT -> IO r) -> IO r
withCert Cert
cert ((BotanStructT -> IO Text) -> IO Text)
-> (BotanStructT -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
cert' ->
    CBytes -> (BA# Word8 -> IO Text) -> IO Text
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
CB.withCBytesUnsafe CBytes
key ((BA# Word8 -> IO Text) -> IO Text)
-> (BA# Word8 -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
key' -> do
    Int
-> (MBA# BotanStructT -> MBA# BotanStructT -> IO CInt) -> IO Text
forall r.
(HasCallStack, Integral r) =>
Int -> (MBA# BotanStructT -> MBA# BotanStructT -> IO r) -> IO Text
allocBotanBufferUTF8Unsafe Int
64 ((MBA# BotanStructT -> MBA# BotanStructT -> IO CInt) -> IO Text)
-> (MBA# BotanStructT -> MBA# BotanStructT -> IO CInt) -> IO Text
forall a b. (a -> b) -> a -> b
$
        BotanStructT
-> BA# Word8
-> Int
-> MBA# BotanStructT
-> MBA# BotanStructT
-> IO CInt
botan_x509_cert_get_issuer_dn BotanStructT
cert' BA# Word8
key' Int
ix

-- | Get a value from the subject DN field, throw exception if not exists.
certDNSubject ::
    HasCallStack =>
    Cert ->
    -- | key
    CBytes ->
    -- | index
    Int ->
    IO T.Text
{-# INLINABLE  certDNSubject #-}
certDNSubject :: Cert -> CBytes -> Int -> IO Text
certDNSubject Cert
cert CBytes
key Int
ix =
    Cert -> (BotanStructT -> IO Text) -> IO Text
forall r. Cert -> (BotanStructT -> IO r) -> IO r
withCert Cert
cert ((BotanStructT -> IO Text) -> IO Text)
-> (BotanStructT -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
cert' ->
    CBytes -> (BA# Word8 -> IO Text) -> IO Text
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
CB.withCBytesUnsafe CBytes
key ((BA# Word8 -> IO Text) -> IO Text)
-> (BA# Word8 -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
key' ->
    Int
-> (MBA# BotanStructT -> MBA# BotanStructT -> IO CInt) -> IO Text
forall r.
(HasCallStack, Integral r) =>
Int -> (MBA# BotanStructT -> MBA# BotanStructT -> IO r) -> IO Text
allocBotanBufferUTF8Unsafe Int
64 ((MBA# BotanStructT -> MBA# BotanStructT -> IO CInt) -> IO Text)
-> (MBA# BotanStructT -> MBA# BotanStructT -> IO CInt) -> IO Text
forall a b. (a -> b) -> a -> b
$
        BotanStructT
-> BA# Word8
-> Int
-> MBA# BotanStructT
-> MBA# BotanStructT
-> IO CInt
botan_x509_cert_get_subject_dn BotanStructT
cert' BA# Word8
key' Int
ix

-- | Format the certificate as a free-form string.
certToText :: HasCallStack => Cert -> IO T.Text
{-# INLINABLE certToText #-}
certToText :: Cert -> IO Text
certToText Cert
cert =
    Cert -> (BotanStructT -> IO Text) -> IO Text
forall r. Cert -> (BotanStructT -> IO r) -> IO r
withCert Cert
cert ((BotanStructT -> IO Text) -> IO Text)
-> (BotanStructT -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
cert' ->
    Bytes -> Text
T.Text (Bytes -> Text) -> (Bytes -> Bytes) -> Bytes -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Bytes
forall (v :: * -> *) a. Vec v a => v a -> v a
V.unsafeInit (Bytes -> Text) -> IO Bytes -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Int
-> (MBA# BotanStructT -> MBA# BotanStructT -> IO CInt) -> IO Bytes
forall r.
(HasCallStack, Integral r) =>
Int -> (MBA# BotanStructT -> MBA# BotanStructT -> IO r) -> IO Bytes
allocBotanBufferUnsafe Int
V.smallChunkSize (BotanStructT -> MBA# BotanStructT -> MBA# BotanStructT -> IO CInt
botan_x509_cert_to_string BotanStructT
cert')

-- | Change cert's 'KeyUsageConstraint'.
certUsage :: HasCallStack => Cert -> KeyUsageConstraint -> IO ()
{-# INLINABLE certUsage #-}
certUsage :: Cert -> KeyUsageConstraint -> IO ()
certUsage Cert
cert KeyUsageConstraint
usage =
    Cert -> (BotanStructT -> IO ()) -> IO ()
forall r. Cert -> (BotanStructT -> IO r) -> IO r
withCert Cert
cert ((BotanStructT -> IO ()) -> IO ())
-> (BotanStructT -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
cert' ->
    IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ BotanStructT -> KeyUsageConstraint -> IO CInt
botan_x509_cert_allowed_usage BotanStructT
cert' KeyUsageConstraint
usage

-- Verify a certificate. Returns 'Nothing' if validation was successful, 'Just reason' if unsuccessful.
--
verifyCert ::
    HasCallStack =>
    -- | Intermediate certificates, set to @[]@ if not needed.
    [Cert] ->
    -- | Trusted certificates, set to @[]@ if not needed.
    [Cert] ->
    -- | Set required strength to indicate the minimum key and hash strength that is allowed, set to zero to use default(110).
    Int ->
    -- | Hostname.
    CBytes ->
    -- | Set reference time(seconds since epoch) to be the time which the certificate chain is validated against. Use zero to use the current system clock.
    Word64 ->
    -- | The certificate to be verified.
    Cert ->
    IO (Maybe CBytes)
{-# INLINABLE verifyCert #-}
verifyCert :: [Cert]
-> [Cert] -> Int -> CBytes -> Word64 -> Cert -> IO (Maybe CBytes)
verifyCert [Cert]
intermediates [Cert]
trusted Int
strength CBytes
hostname Word64
refTime Cert
cert =
    Cert -> (BotanStructT -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall r. Cert -> (BotanStructT -> IO r) -> IO r
withCert Cert
cert ((BotanStructT -> IO (Maybe CBytes)) -> IO (Maybe CBytes))
-> (BotanStructT -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
cert' ->
    [BotanStruct]
-> (BA# Word8 -> Int -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall a b. [CPtr a] -> (BA# Word8 -> Int -> IO b) -> IO b
withCPtrsUnsafe ((Cert -> BotanStruct) -> [Cert] -> [BotanStruct]
forall a b. (a -> b) -> [a] -> [b]
map Cert -> BotanStruct
certStruct [Cert]
intermediates) ((BA# Word8 -> Int -> IO (Maybe CBytes)) -> IO (Maybe CBytes))
-> (BA# Word8 -> Int -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
intermediates' Int
intermediatesLen ->
    [BotanStruct]
-> (BA# Word8 -> Int -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall a b. [CPtr a] -> (BA# Word8 -> Int -> IO b) -> IO b
withCPtrsUnsafe ((Cert -> BotanStruct) -> [Cert] -> [BotanStruct]
forall a b. (a -> b) -> [a] -> [b]
map Cert -> BotanStruct
certStruct [Cert]
trusted) ((BA# Word8 -> Int -> IO (Maybe CBytes)) -> IO (Maybe CBytes))
-> (BA# Word8 -> Int -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
trusted' Int
trustedLen ->
    CBytes -> (BA# Word8 -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
CB.withCBytesUnsafe CBytes
hostname ((BA# Word8 -> IO (Maybe CBytes)) -> IO (Maybe CBytes))
-> (BA# Word8 -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
hostname' -> do
        CInt
a <- IO CInt -> IO CInt
forall a. (HasCallStack, Integral a) => IO a -> IO a
throwBotanIfMinus (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
            BotanStructT
-> BA# Word8
-> Int
-> BA# Word8
-> Int
-> Int
-> BA# Word8
-> Word64
-> IO CInt
hs_botan_x509_cert_verify BotanStructT
cert'
                BA# Word8
intermediates' Int
intermediatesLen
                BA# Word8
trusted' Int
trustedLen
                Int
strength BA# Word8
hostname' Word64
refTime
        if CInt
a CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
        then Maybe CBytes -> IO (Maybe CBytes)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CBytes
forall a. Maybe a
Nothing
        else let !reason :: CBytes
reason = CInt -> CBytes
certValidateStatus CInt
a in Maybe CBytes -> IO (Maybe CBytes)
forall (m :: * -> *) a. Monad m => a -> m a
return (CBytes -> Maybe CBytes
forall a. a -> Maybe a
Just CBytes
reason)

-- | Return a (statically allocated) CString associated with the verification result.
certValidateStatus :: CInt -> CBytes
{-# INLINABLE certValidateStatus #-}
certValidateStatus :: CInt -> CBytes
certValidateStatus CInt
r =
    IO CBytes -> CBytes
forall a. IO a -> a
unsafeDupablePerformIO (IO CBytes -> CBytes) -> IO CBytes -> CBytes
forall a b. (a -> b) -> a -> b
$ CString -> IO CBytes
CB.fromCString (CString -> IO CBytes) -> IO CString -> IO CBytes
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CInt -> IO CString
botan_x509_cert_validation_status CInt
r

-- | Certificate path validation supporting Certificate Revocation Lists.
--
-- Verify a certificate. Returns 'Nothing' if validation was successful, 'Just reason' if unsuccessful.
--
verifyCertCRL ::
    HasCallStack =>
    -- | Intermediate certificates, set to @[]@ if not needed.
    [Cert] ->
    -- | Trusted certificates, set to @[]@ if not needed.
    [Cert] ->
    -- | Certificate Revocation Lists, set to @[]@ if not needed.
    [CRL] ->
    -- | Set required strength to indicate the minimum key and hash strength that is allowed, set to zero to use default(110).
    Int ->
    -- | Hostname.
    CBytes ->
    -- | Set reference time(seconds since epoch) to be the time which the certificate chain is validated against. Use zero to use the current system clock.
    Word64 ->
    -- | The certificate to be verified.
    Cert ->
    IO (Maybe CBytes)
{-# INLINABLE verifyCertCRL #-}
verifyCertCRL :: [Cert]
-> [Cert]
-> [CRL]
-> Int
-> CBytes
-> Word64
-> Cert
-> IO (Maybe CBytes)
verifyCertCRL [Cert]
intermediates [Cert]
trusted [CRL]
crls Int
strength CBytes
hostname Word64
refTime Cert
cert =
    Cert -> (BotanStructT -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall r. Cert -> (BotanStructT -> IO r) -> IO r
withCert Cert
cert ((BotanStructT -> IO (Maybe CBytes)) -> IO (Maybe CBytes))
-> (BotanStructT -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
cert' ->
    [BotanStruct]
-> (BA# Word8 -> Int -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall a b. [CPtr a] -> (BA# Word8 -> Int -> IO b) -> IO b
withCPtrsUnsafe ((Cert -> BotanStruct) -> [Cert] -> [BotanStruct]
forall a b. (a -> b) -> [a] -> [b]
map Cert -> BotanStruct
certStruct [Cert]
intermediates) ((BA# Word8 -> Int -> IO (Maybe CBytes)) -> IO (Maybe CBytes))
-> (BA# Word8 -> Int -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
intermediates' Int
intermediatesLen ->
    [BotanStruct]
-> (BA# Word8 -> Int -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall a b. [CPtr a] -> (BA# Word8 -> Int -> IO b) -> IO b
withCPtrsUnsafe ((Cert -> BotanStruct) -> [Cert] -> [BotanStruct]
forall a b. (a -> b) -> [a] -> [b]
map Cert -> BotanStruct
certStruct [Cert]
trusted) ((BA# Word8 -> Int -> IO (Maybe CBytes)) -> IO (Maybe CBytes))
-> (BA# Word8 -> Int -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
trusted' Int
trustedLen ->
    [BotanStruct]
-> (BA# Word8 -> Int -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall a b. [CPtr a] -> (BA# Word8 -> Int -> IO b) -> IO b
withCPtrsUnsafe ((CRL -> BotanStruct) -> [CRL] -> [BotanStruct]
forall a b. (a -> b) -> [a] -> [b]
map CRL -> BotanStruct
crlStruct [CRL]
crls) ((BA# Word8 -> Int -> IO (Maybe CBytes)) -> IO (Maybe CBytes))
-> (BA# Word8 -> Int -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
crls' Int
crlsLen ->
    CBytes -> (BA# Word8 -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
CB.withCBytesUnsafe CBytes
hostname ((BA# Word8 -> IO (Maybe CBytes)) -> IO (Maybe CBytes))
-> (BA# Word8 -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
hostname' -> do
        CInt
a <- IO CInt -> IO CInt
forall a. (HasCallStack, Integral a) => IO a -> IO a
throwBotanIfMinus (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
            BotanStructT
-> BA# Word8
-> Int
-> BA# Word8
-> Int
-> BA# Word8
-> Int
-> Int
-> BA# Word8
-> Word64
-> IO CInt
hs_botan_x509_cert_verify_with_crl BotanStructT
cert'
                BA# Word8
intermediates' Int
intermediatesLen
                BA# Word8
trusted' Int
trustedLen
                BA# Word8
crls' Int
crlsLen
                Int
strength BA# Word8
hostname' Word64
refTime
        if CInt
a CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
        then Maybe CBytes -> IO (Maybe CBytes)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CBytes
forall a. Maybe a
Nothing
        else let !reason :: CBytes
reason = CInt -> CBytes
certValidateStatus CInt
a in Maybe CBytes -> IO (Maybe CBytes)
forall (m :: * -> *) a. Monad m => a -> m a
return (CBytes -> Maybe CBytes
forall a. a -> Maybe a
Just CBytes
reason)

-- | Certificate path validation supporting Certificate Revocation Lists with a 'CertStore'.
--
-- Verify a certificate. Returns 'Nothing' if validation was successful, 'Just reason' if unsuccessful.
--
verifyCertCRL' ::
    HasCallStack =>
    -- | Intermediate certificates, set to @[]@ if not needed.
    [Cert] ->
    -- | Trusted certificates in 'CertStore'
    CertStore ->
    -- | Certificate Revocation Lists, set to @[]@ if not needed.
    [CRL] ->
    -- | Set required strength to indicate the minimum key and hash strength that is allowed, set to zero to use default(110).
    Int ->
    -- | Hostname.
    CBytes ->
    -- | Set reference time(seconds since epoch) to be the time which the certificate chain is validated against. Use zero to use the current system clock.
    Word64 ->
    -- | The certificate to be verified.
    Cert ->
    IO (Maybe CBytes)
{-# INLINABLE verifyCertCRL' #-}
verifyCertCRL' :: [Cert]
-> CertStore
-> [CRL]
-> Int
-> CBytes
-> Word64
-> Cert
-> IO (Maybe CBytes)
verifyCertCRL' [Cert]
intermediates CertStore
store [CRL]
crls Int
strength CBytes
hostname Word64
refTime Cert
cert =
    Cert -> (BotanStructT -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall r. Cert -> (BotanStructT -> IO r) -> IO r
withCert Cert
cert ((BotanStructT -> IO (Maybe CBytes)) -> IO (Maybe CBytes))
-> (BotanStructT -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
cert' ->
    CertStore
-> (BotanStructT -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall r. CertStore -> (BotanStructT -> IO r) -> IO r
withCertStore CertStore
store ((BotanStructT -> IO (Maybe CBytes)) -> IO (Maybe CBytes))
-> (BotanStructT -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
store' ->
    [BotanStruct]
-> (BA# Word8 -> Int -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall a b. [CPtr a] -> (BA# Word8 -> Int -> IO b) -> IO b
withCPtrsUnsafe ((Cert -> BotanStruct) -> [Cert] -> [BotanStruct]
forall a b. (a -> b) -> [a] -> [b]
map Cert -> BotanStruct
certStruct [Cert]
intermediates) ((BA# Word8 -> Int -> IO (Maybe CBytes)) -> IO (Maybe CBytes))
-> (BA# Word8 -> Int -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
intermediates' Int
intermediatesLen ->
    [BotanStruct]
-> (BA# Word8 -> Int -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall a b. [CPtr a] -> (BA# Word8 -> Int -> IO b) -> IO b
withCPtrsUnsafe ((CRL -> BotanStruct) -> [CRL] -> [BotanStruct]
forall a b. (a -> b) -> [a] -> [b]
map CRL -> BotanStruct
crlStruct [CRL]
crls) ((BA# Word8 -> Int -> IO (Maybe CBytes)) -> IO (Maybe CBytes))
-> (BA# Word8 -> Int -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
crls' Int
crlsLen ->
    CBytes -> (BA# Word8 -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
CB.withCBytesUnsafe CBytes
hostname ((BA# Word8 -> IO (Maybe CBytes)) -> IO (Maybe CBytes))
-> (BA# Word8 -> IO (Maybe CBytes)) -> IO (Maybe CBytes)
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
hostname' -> do
        CInt
a <- IO CInt -> IO CInt
forall a. (HasCallStack, Integral a) => IO a -> IO a
throwBotanIfMinus (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$
            BotanStructT
-> BA# Word8
-> Int
-> BotanStructT
-> BA# Word8
-> Int
-> Int
-> BA# Word8
-> Word64
-> IO CInt
hs_botan_x509_cert_verify_with_certstore_crl BotanStructT
cert'
                BA# Word8
intermediates' Int
intermediatesLen
                BotanStructT
store'
                BA# Word8
crls' Int
crlsLen
                Int
strength BA# Word8
hostname' Word64
refTime
        if CInt
a CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
        then Maybe CBytes -> IO (Maybe CBytes)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CBytes
forall a. Maybe a
Nothing
        else let !reason :: CBytes
reason = CInt -> CBytes
certValidateStatus CInt
a in Maybe CBytes -> IO (Maybe CBytes)
forall (m :: * -> *) a. Monad m => a -> m a
return (CBytes -> Maybe CBytes
forall a. a -> Maybe a
Just CBytes
reason)

----------------------------------------
-- X.509 Certificate Revocation Lists --
----------------------------------------

-- | An opaque newtype wrapper for an X.509 Certificate Revocation Lists.
--
-- It will occasionally happen that a certificate must be revoked before its expiration date.
-- Examples of this happening include the private key being compromised, or the user to which it has been assigned leaving an organization.
-- Certificate revocation lists are an answer to this problem (though online certificate validation techniques are starting to become somewhat more popular).
-- Every once in a while the CA will release a new CRL, listing all certificates that have been revoked.
-- Also included is various pieces of information like what time a particular certificate was revoked, and for what reason.
-- In most systems, it is wise to support some form of certificate revocation, and CRLs handle this easily.
newtype CRL = CRL { CRL -> BotanStruct
crlStruct :: BotanStruct }
    deriving (Int -> CRL -> ShowS
[CRL] -> ShowS
CRL -> String
(Int -> CRL -> ShowS)
-> (CRL -> String) -> ([CRL] -> ShowS) -> Show CRL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CRL] -> ShowS
$cshowList :: [CRL] -> ShowS
show :: CRL -> String
$cshow :: CRL -> String
showsPrec :: Int -> CRL -> ShowS
$cshowsPrec :: Int -> CRL -> ShowS
Show, (forall x. CRL -> Rep CRL x)
-> (forall x. Rep CRL x -> CRL) -> Generic CRL
forall x. Rep CRL x -> CRL
forall x. CRL -> Rep CRL x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CRL x -> CRL
$cfrom :: forall x. CRL -> Rep CRL x
Generic)
    deriving anyclass Int -> CRL -> Builder ()
(Int -> CRL -> Builder ()) -> Print CRL
forall a. (Int -> a -> Builder ()) -> Print a
toUTF8BuilderP :: Int -> CRL -> Builder ()
$ctoUTF8BuilderP :: Int -> CRL -> Builder ()
T.Print

-- | Use 'CRL' as a `botan_crl_t`.
withCRL :: CRL -> (BotanStructT -> IO r) -> IO r
{-# INLINABLE withCRL #-}
withCRL :: CRL -> (BotanStructT -> IO r) -> IO r
withCRL (CRL BotanStruct
crl) = BotanStruct -> (BotanStructT -> IO r) -> IO r
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
crl

-- | Load a CRL from the DER or PEM representation.
loadCRL :: HasCallStack => V.Bytes -> IO CRL
{-# INLINABLE loadCRL #-}
loadCRL :: Bytes -> IO CRL
loadCRL Bytes
src =
    Bytes -> (BA# Word8 -> Int -> Int -> IO CRL) -> IO CRL
forall a b.
Prim a =>
PrimVector a -> (BA# Word8 -> Int -> Int -> IO b) -> IO b
withPrimVectorUnsafe Bytes
src ((BA# Word8 -> Int -> Int -> IO CRL) -> IO CRL)
-> (BA# Word8 -> Int -> Int -> IO CRL) -> IO CRL
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
src' Int
off Int
len ->
    BotanStruct -> CRL
CRL (BotanStruct -> CRL) -> IO BotanStruct -> IO CRL
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO ()) -> IO BotanStruct
forall a.
HasCallStack =>
(MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO a) -> IO BotanStruct
newBotanStruct
        (\ MBA# BotanStructT
ret -> MBA# BotanStructT -> BA# Word8 -> Int -> Int -> IO CInt
hs_botan_x509_crl_load MBA# BotanStructT
ret BA# Word8
src' Int
off Int
len)
        FunPtr (BotanStructT -> IO ())
botan_x509_crl_destroy

-- | Load a CRL from a file.
loadCRLFile :: HasCallStack => CBytes -> IO CRL
{-# INLINABLE loadCRLFile #-}
loadCRLFile :: CBytes -> IO CRL
loadCRLFile CBytes
src =
    CBytes -> (BA# Word8 -> IO CRL) -> IO CRL
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
CB.withCBytesUnsafe CBytes
src ((BA# Word8 -> IO CRL) -> IO CRL)
-> (BA# Word8 -> IO CRL) -> IO CRL
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
src' ->
    BotanStruct -> CRL
CRL (BotanStruct -> CRL) -> IO BotanStruct -> IO CRL
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO ()) -> IO BotanStruct
forall a.
HasCallStack =>
(MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO a) -> IO BotanStruct
newBotanStruct
        (MBA# BotanStructT -> BA# Word8 -> IO CInt
`botan_x509_crl_load_file` BA# Word8
src')
        FunPtr (BotanStructT -> IO ())
botan_x509_crl_destroy

-- | Check whether a given crl contains a given cert. Return True when the certificate is revoked, False otherwise.
isRevokedX509 :: HasCallStack => CRL -> Cert -> IO Bool
{-# INLINABLE isRevokedX509 #-}
isRevokedX509 :: CRL -> Cert -> IO Bool
isRevokedX509 CRL
crl Cert
cert =
    CRL -> (BotanStructT -> IO Bool) -> IO Bool
forall r. CRL -> (BotanStructT -> IO r) -> IO r
withCRL CRL
crl ((BotanStructT -> IO Bool) -> IO Bool)
-> (BotanStructT -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
crl' ->
    Cert -> (BotanStructT -> IO Bool) -> IO Bool
forall r. Cert -> (BotanStructT -> IO r) -> IO r
withCert Cert
cert ((BotanStructT -> IO Bool) -> IO Bool)
-> (BotanStructT -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
cert' -> do
        CInt
ret <- BotanStructT -> BotanStructT -> IO CInt
botan_x509_is_revoked BotanStructT
crl' BotanStructT
cert'
        if CInt
ret CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
        then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        else if CInt
ret CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== -CInt
1
            then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            else CInt -> IO Bool
forall x. HasCallStack => CInt -> IO x
throwBotanError CInt
ret

----------------------------------------
-- X.509 Certificate Store            --
----------------------------------------

-- | An opaque newtype wrapper for an X.509 Certificate Store based on botan's 'FlatFile_Certificate_Store'.
newtype CertStore = CertStore { CertStore -> BotanStruct
certStoreStruct :: BotanStruct }
    deriving (Int -> CertStore -> ShowS
[CertStore] -> ShowS
CertStore -> String
(Int -> CertStore -> ShowS)
-> (CertStore -> String)
-> ([CertStore] -> ShowS)
-> Show CertStore
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CertStore] -> ShowS
$cshowList :: [CertStore] -> ShowS
show :: CertStore -> String
$cshow :: CertStore -> String
showsPrec :: Int -> CertStore -> ShowS
$cshowsPrec :: Int -> CertStore -> ShowS
Show, (forall x. CertStore -> Rep CertStore x)
-> (forall x. Rep CertStore x -> CertStore) -> Generic CertStore
forall x. Rep CertStore x -> CertStore
forall x. CertStore -> Rep CertStore x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CertStore x -> CertStore
$cfrom :: forall x. CertStore -> Rep CertStore x
Generic)
    deriving anyclass Int -> CertStore -> Builder ()
(Int -> CertStore -> Builder ()) -> Print CertStore
forall a. (Int -> a -> Builder ()) -> Print a
toUTF8BuilderP :: Int -> CertStore -> Builder ()
$ctoUTF8BuilderP :: Int -> CertStore -> Builder ()
T.Print

-- | Use 'CertStore' as a 'botan_x509_certstore_t'.
withCertStore :: CertStore -> (BotanStructT -> IO r) -> IO r
{-# INLINABLE withCertStore #-}
withCertStore :: CertStore -> (BotanStructT -> IO r) -> IO r
withCertStore (CertStore BotanStruct
c) = BotanStruct -> (BotanStructT -> IO r) -> IO r
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
c

-- | Load a CertStore from a file.
loadCertStoreFile :: HasCallStack => CBytes -> IO CertStore
{-# INLINABLE loadCertStoreFile #-}
loadCertStoreFile :: CBytes -> IO CertStore
loadCertStoreFile CBytes
src =
    CBytes -> (BA# Word8 -> IO CertStore) -> IO CertStore
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
CB.withCBytesUnsafe CBytes
src ((BA# Word8 -> IO CertStore) -> IO CertStore)
-> (BA# Word8 -> IO CertStore) -> IO CertStore
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
src' ->
    BotanStruct -> CertStore
CertStore (BotanStruct -> CertStore) -> IO BotanStruct -> IO CertStore
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO ()) -> IO BotanStruct
forall a.
HasCallStack =>
(MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO a) -> IO BotanStruct
newBotanStruct
        (MBA# BotanStructT -> BA# Word8 -> IO CInt
`botan_x509_certstore_load_file` BA# Word8
src')
        FunPtr (BotanStructT -> IO ())
botan_x509_certstore_destroy

-- | The built-in mozilla CA 'CertStore'.
--
-- This is a certstore extracted from Mozilla, see <https://curl.se/docs/caextract.html>.
mozillaCertStore :: CertStore
{-# NOINLINE mozillaCertStore #-}
mozillaCertStore :: CertStore
mozillaCertStore = IO CertStore -> CertStore
forall a. IO a -> a
unsafePerformIO (IO CertStore -> CertStore) -> IO CertStore -> CertStore
forall a b. (a -> b) -> a -> b
$ do
    String
f <- String -> IO String
getDataFileName String
"third_party/cacert.pem"
    HasCallStack => CBytes -> IO CertStore
CBytes -> IO CertStore
loadCertStoreFile (String -> CBytes
CB.pack String
f)

-- | The CA 'CertStore' on your system.
--
systemCertStore :: CertStore
{-# NOINLINE systemCertStore #-}
systemCertStore :: CertStore
systemCertStore = IO CertStore -> CertStore
forall a. IO a -> a
unsafePerformIO (IO CertStore -> CertStore) -> IO CertStore -> CertStore
forall a b. (a -> b) -> a -> b
$ do
    BotanStruct -> CertStore
CertStore (BotanStruct -> CertStore) -> IO BotanStruct -> IO CertStore
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO ()) -> IO BotanStruct
forall a.
HasCallStack =>
(MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO a) -> IO BotanStruct
newBotanStruct
        MBA# BotanStructT -> IO CInt
botan_x509_certstore_load_system
        FunPtr (BotanStructT -> IO ())
botan_x509_certstore_destroy