{-# LANGUAGE CPP #-}

{-|
Module      : Botan.Low.X509
Description : X.509 Certificates and CRLs
Copyright   : (c) 2023-2024, Apotheca Labs
              (c) 2024-2025, Haskell Foundation
License     : BSD-3-Clause
Maintainer  : joris@well-typed.com, leo@apotheca.io
Stability   : experimental
Portability : POSIX

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.
-}

module Botan.Low.X509 (

  -- * X509 Certificates

    X509Cert(..)
  , withX509Cert
  , x509CertLoad
  , x509CertLoadFile
  , x509CertDestroy
  , x509CertDup
  , x509CertGetTimeStarts
  , x509CertGetTimeExpires
  , x509CertNotBefore
  , x509CertNotAfter
  , x509CertGetPubKeyFingerprint
  , x509CertGetSerialNumber
  , x509CertGetAuthorityKeyId
  , x509CertGetSubjectKeyId
  , x509CertGetPublicKeyBits
  , x509CertGetPublicKey
  , x509CertGetIssuerDN
  , x509CertGetSubjectDN
  , x509CertToString
  , x509CertAllowedUsage
  , x509CertHostnameMatch
  , x509CertVerify
  , x509CertValidationStatus

  -- * X509 Key constraints

  , X509KeyConstraints (..)
  , x509KeyConstraints
  , x509KeyConstraintsList

  -- * X509 Certificate revocation list

  , X509CRL(..)
  , withX509CRL
  , x509CRLLoad
  , x509CRLLoadFile
  , x509CRLDestroy
  , x509IsRevoked
  , x509CertVerifyWithCLR

  -- * Convenience
  , DistinguishedName

  ) where

import           Botan.Bindings.ConstPtr (ConstPtr (..))
import           Botan.Bindings.X509
import           Botan.Low.Error.Internal
import           Botan.Low.Hash (HashName)
import           Botan.Low.Internal.ByteString
import           Botan.Low.Make
import           Botan.Low.PubKey
import           Botan.Low.Remake
import           Control.Monad
import           Data.Bits
import           Data.ByteString (ByteString, packCString)
import qualified Data.ByteString.Char8 as Char8
import           Data.Word
import qualified Foreign.C.String as String (withCString)
import           Foreign.C.Types
import           Foreign.ForeignPtr
import           Foreign.Marshal.Alloc
import           Foreign.Marshal.Array
import           Foreign.Ptr
import           Foreign.Storable

-- TODO: Use *.Make module to ensure consistency

-- /*
-- * X.509 certificates
-- **************************/

type DistinguishedName = ByteString

newtype X509Cert = MkX509Cert { X509Cert -> ForeignPtr BotanX509CertStruct
foreignPtr :: ForeignPtr BotanX509CertStruct }

withX509Cert     :: X509Cert -> (BotanX509Cert -> IO a) -> IO a
-- | Destroy an x509 cert object immediately
x509CertDestroy  :: X509Cert -> IO ()
createX509Cert   :: (Ptr BotanX509Cert -> IO CInt) -> IO X509Cert
(X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert, X509Cert -> IO ()
x509CertDestroy, (Ptr BotanX509Cert -> IO CInt) -> IO X509Cert
createX509Cert)
    = (Ptr BotanX509CertStruct -> BotanX509Cert)
-> (BotanX509Cert -> Ptr BotanX509CertStruct)
-> (ForeignPtr BotanX509CertStruct -> X509Cert)
-> (X509Cert -> ForeignPtr BotanX509CertStruct)
-> FinalizerPtr BotanX509CertStruct
-> (X509Cert -> (BotanX509Cert -> IO a) -> IO a, X509Cert -> IO (),
    (Ptr BotanX509Cert -> IO CInt) -> IO X509Cert)
forall botan struct object a.
Storable botan =>
(Ptr struct -> botan)
-> (botan -> Ptr struct)
-> (ForeignPtr struct -> object)
-> (object -> ForeignPtr struct)
-> FinalizerPtr struct
-> (object -> (botan -> IO a) -> IO a, object -> IO (),
    (Ptr botan -> IO CInt) -> IO object)
mkBindings Ptr BotanX509CertStruct -> BotanX509Cert
MkBotanX509Cert (.ptr) ForeignPtr BotanX509CertStruct -> X509Cert
MkX509Cert (.foreignPtr) FinalizerPtr BotanX509CertStruct
botan_x509_cert_destroy

x509CertLoad
    :: ByteString   -- ^ __cert[]__
    -> IO X509Cert  -- ^ __cert_obj__
x509CertLoad :: ByteString -> IO X509Cert
x509CertLoad = ((Ptr BotanX509Cert -> IO CInt) -> IO X509Cert)
-> (Ptr BotanX509Cert -> ConstPtr Word8 -> CSize -> IO CInt)
-> ByteString
-> IO X509Cert
forall botan object.
((Ptr botan -> IO CInt) -> IO object)
-> (Ptr botan -> ConstPtr Word8 -> CSize -> IO CInt)
-> ByteString
-> IO object
mkCreateObjectCBytesLen (Ptr BotanX509Cert -> IO CInt) -> IO X509Cert
createX509Cert Ptr BotanX509Cert -> ConstPtr Word8 -> CSize -> IO CInt
botan_x509_cert_load

x509CertLoadFile
    :: FilePath     -- ^ __filename__
    -> IO X509Cert  -- ^ __cert_obj__
x509CertLoadFile :: FilePath -> IO X509Cert
x509CertLoadFile = ((Ptr BotanX509Cert -> IO CInt) -> IO X509Cert)
-> (Ptr BotanX509Cert -> ConstPtr CChar -> IO CInt)
-> ByteString
-> IO X509Cert
forall botan object.
((Ptr botan -> IO CInt) -> IO object)
-> (Ptr botan -> ConstPtr CChar -> IO CInt)
-> ByteString
-> IO object
mkCreateObjectCString (Ptr BotanX509Cert -> IO CInt) -> IO X509Cert
createX509Cert Ptr BotanX509Cert -> ConstPtr CChar -> IO CInt
botan_x509_cert_load_file (ByteString -> IO X509Cert)
-> (FilePath -> ByteString) -> FilePath -> IO X509Cert
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
Char8.pack

x509CertDup
    :: X509Cert     -- ^ __new_cert__
    -> IO X509Cert  -- ^ __cert__
x509CertDup :: X509Cert -> IO X509Cert
x509CertDup = ((Ptr BotanX509Cert -> IO CInt) -> IO X509Cert)
-> (X509Cert -> (BotanX509Cert -> IO X509Cert) -> IO X509Cert)
-> (Ptr BotanX509Cert -> BotanX509Cert -> IO CInt)
-> X509Cert
-> IO X509Cert
forall botan object arg carg.
((Ptr botan -> IO CInt) -> IO object)
-> (arg -> (carg -> IO object) -> IO object)
-> (Ptr botan -> carg -> IO CInt)
-> arg
-> IO object
mkCreateObjectWith (Ptr BotanX509Cert -> IO CInt) -> IO X509Cert
createX509Cert X509Cert -> (BotanX509Cert -> IO X509Cert) -> IO X509Cert
forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert Ptr BotanX509Cert -> BotanX509Cert -> IO CInt
botan_x509_cert_dup

x509CertGetTimeStarts
    :: X509Cert         -- ^ __cert__
    -> IO ByteString    -- ^ __out[]__
x509CertGetTimeStarts :: X509Cert -> IO ByteString
x509CertGetTimeStarts = (forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a)
-> GetBytes BotanX509Cert CChar -> X509Cert -> IO ByteString
forall typ ptr byte.
WithPtr typ ptr -> GetBytes ptr byte -> typ -> IO ByteString
mkGetBytes X509Cert -> (BotanX509Cert -> IO a) -> IO a
forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert GetBytes BotanX509Cert CChar
botan_x509_cert_get_time_starts

x509CertGetTimeExpires
    :: X509Cert         -- ^ __cert__
    -> IO ByteString    -- ^ __out[]__
x509CertGetTimeExpires :: X509Cert -> IO ByteString
x509CertGetTimeExpires = (forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a)
-> GetBytes BotanX509Cert CChar -> X509Cert -> IO ByteString
forall typ ptr byte.
WithPtr typ ptr -> GetBytes ptr byte -> typ -> IO ByteString
mkGetBytes X509Cert -> (BotanX509Cert -> IO a) -> IO a
forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert GetBytes BotanX509Cert CChar
botan_x509_cert_get_time_expires

-- TODO: mkGetIntegral
x509CertNotBefore
    :: X509Cert     -- ^ __cert__
    -> IO Word64    -- ^ __time_since_epoch__
x509CertNotBefore :: X509Cert -> IO Word64
x509CertNotBefore X509Cert
cert = X509Cert -> (BotanX509Cert -> IO Word64) -> IO Word64
forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert X509Cert
cert ((BotanX509Cert -> IO Word64) -> IO Word64)
-> (BotanX509Cert -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \ BotanX509Cert
certPtr -> do
    (Ptr Word64 -> IO Word64) -> IO Word64
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word64 -> IO Word64) -> IO Word64)
-> (Ptr Word64 -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \ Ptr Word64
timePtr -> do
        IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ BotanX509Cert -> Ptr Word64 -> IO CInt
botan_x509_cert_not_before
            BotanX509Cert
certPtr
            Ptr Word64
timePtr
        Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
timePtr

-- TODO: mkGetIntegral
x509CertNotAfter
    :: X509Cert     -- ^ __cert__
    -> IO Word64    -- ^ __time_since_epoch__
x509CertNotAfter :: X509Cert -> IO Word64
x509CertNotAfter X509Cert
cert = X509Cert -> (BotanX509Cert -> IO Word64) -> IO Word64
forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert X509Cert
cert ((BotanX509Cert -> IO Word64) -> IO Word64)
-> (BotanX509Cert -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \ BotanX509Cert
certPtr -> do
    (Ptr Word64 -> IO Word64) -> IO Word64
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word64 -> IO Word64) -> IO Word64)
-> (Ptr Word64 -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \ Ptr Word64
timePtr -> do
        IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ BotanX509Cert -> Ptr Word64 -> IO CInt
botan_x509_cert_not_after
            BotanX509Cert
certPtr
            Ptr Word64
timePtr
        Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
timePtr


x509CertGetPubKeyFingerprint
    :: X509Cert         -- ^ __cert__
    -> HashName         -- ^ __hash__
    -> IO ByteString    -- ^ __out[]__
x509CertGetPubKeyFingerprint :: X509Cert -> ByteString -> IO ByteString
x509CertGetPubKeyFingerprint X509Cert
cert ByteString
algo = X509Cert -> (BotanX509Cert -> IO ByteString) -> IO ByteString
forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert X509Cert
cert ((BotanX509Cert -> IO ByteString) -> IO ByteString)
-> (BotanX509Cert -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ BotanX509Cert
certPtr -> do
    ByteString -> (CString -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CString -> IO a) -> IO a
asCString ByteString
algo ((CString -> IO ByteString) -> IO ByteString)
-> (CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ CString
algoPtr -> do
        (Ptr Word8 -> Ptr CSize -> IO CInt) -> IO ByteString
forall byte. (Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString
allocBytesQuerying ((Ptr Word8 -> Ptr CSize -> IO CInt) -> IO ByteString)
-> (Ptr Word8 -> Ptr CSize -> IO CInt) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
outPtr Ptr CSize
outLen -> BotanX509Cert
-> ConstPtr CChar -> Ptr Word8 -> Ptr CSize -> IO CInt
botan_x509_cert_get_fingerprint
            BotanX509Cert
certPtr
            (CString -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr CString
algoPtr)
            Ptr Word8
outPtr
            Ptr CSize
outLen

x509CertGetSerialNumber
    :: X509Cert         -- ^ __cert__
    -> IO ByteString    -- ^ __out[]__
x509CertGetSerialNumber :: X509Cert -> IO ByteString
x509CertGetSerialNumber = (forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a)
-> GetBytes BotanX509Cert Word8 -> X509Cert -> IO ByteString
forall typ ptr byte.
WithPtr typ ptr -> GetBytes ptr byte -> typ -> IO ByteString
mkGetBytes X509Cert -> (BotanX509Cert -> IO a) -> IO a
forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert GetBytes BotanX509Cert Word8
botan_x509_cert_get_serial_number

x509CertGetAuthorityKeyId
    :: X509Cert         -- ^ __cert__
    -> IO ByteString    -- ^ __out[]__
x509CertGetAuthorityKeyId :: X509Cert -> IO ByteString
x509CertGetAuthorityKeyId = (forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a)
-> GetBytes BotanX509Cert Word8 -> X509Cert -> IO ByteString
forall typ ptr byte.
WithPtr typ ptr -> GetBytes ptr byte -> typ -> IO ByteString
mkGetBytes X509Cert -> (BotanX509Cert -> IO a) -> IO a
forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert GetBytes BotanX509Cert Word8
botan_x509_cert_get_authority_key_id

x509CertGetSubjectKeyId
    :: X509Cert         -- ^ __cert__
    -> IO ByteString    -- ^ __out[]__
x509CertGetSubjectKeyId :: X509Cert -> IO ByteString
x509CertGetSubjectKeyId = (forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a)
-> GetBytes BotanX509Cert Word8 -> X509Cert -> IO ByteString
forall typ ptr byte.
WithPtr typ ptr -> GetBytes ptr byte -> typ -> IO ByteString
mkGetBytes X509Cert -> (BotanX509Cert -> IO a) -> IO a
forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert GetBytes BotanX509Cert Word8
botan_x509_cert_get_subject_key_id

x509CertGetPublicKeyBits
    :: X509Cert         -- ^ __cert__
    -> IO ByteString    -- ^ __out[]__
x509CertGetPublicKeyBits :: X509Cert -> IO ByteString
x509CertGetPublicKeyBits = (forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a)
-> GetBytes BotanX509Cert Word8 -> X509Cert -> IO ByteString
forall typ ptr byte.
WithPtr typ ptr -> GetBytes ptr byte -> typ -> IO ByteString
mkGetBytes X509Cert -> (BotanX509Cert -> IO a) -> IO a
forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert GetBytes BotanX509Cert Word8
botan_x509_cert_get_public_key_bits

-- NOTE: Unique / quirk - the return value is the second argument?
--  This necessitates the use of `flip`
x509CertGetPublicKey
    :: X509Cert     -- ^ __cert__
    -> IO PubKey    -- ^ __key__
x509CertGetPublicKey :: X509Cert -> IO PubKey
x509CertGetPublicKey = ((Ptr BotanPubKey -> IO CInt) -> IO PubKey)
-> (X509Cert -> (BotanX509Cert -> IO PubKey) -> IO PubKey)
-> (Ptr BotanPubKey -> BotanX509Cert -> IO CInt)
-> X509Cert
-> IO PubKey
forall botan object arg carg.
((Ptr botan -> IO CInt) -> IO object)
-> (arg -> (carg -> IO object) -> IO object)
-> (Ptr botan -> carg -> IO CInt)
-> arg
-> IO object
mkCreateObjectWith (Ptr BotanPubKey -> IO CInt) -> IO PubKey
createPubKey X509Cert -> (BotanX509Cert -> IO PubKey) -> IO PubKey
forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert ((BotanX509Cert -> Ptr BotanPubKey -> IO CInt)
-> Ptr BotanPubKey -> BotanX509Cert -> IO CInt
forall a b c. (a -> b -> c) -> b -> a -> c
flip BotanX509Cert -> Ptr BotanPubKey -> IO CInt
botan_x509_cert_get_public_key)

-- Distinguished Names
--  SEE: https://www.ibm.com/docs/en/ibm-mq/7.5?topic=certificates-distinguished-names
x509CertGetIssuerDN
    :: X509Cert         -- ^ __cert__
    -> ByteString       -- ^ __key__
    -> Int              -- ^ __index__
    -> IO ByteString    -- ^ __out[]__
x509CertGetIssuerDN :: X509Cert -> ByteString -> Int -> IO ByteString
x509CertGetIssuerDN X509Cert
cert ByteString
key Int
index = X509Cert -> (BotanX509Cert -> IO ByteString) -> IO ByteString
forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert X509Cert
cert ((BotanX509Cert -> IO ByteString) -> IO ByteString)
-> (BotanX509Cert -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ BotanX509Cert
certPtr -> do
    ByteString -> (CString -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CString -> IO a) -> IO a
asCString ByteString
key ((CString -> IO ByteString) -> IO ByteString)
-> (CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ CString
keyPtr -> do
        (Ptr Word8 -> Ptr CSize -> IO CInt) -> IO ByteString
forall byte. (Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString
allocBytesQuerying ((Ptr Word8 -> Ptr CSize -> IO CInt) -> IO ByteString)
-> (Ptr Word8 -> Ptr CSize -> IO CInt) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
outPtr Ptr CSize
outLen -> BotanX509Cert
-> ConstPtr CChar -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt
botan_x509_cert_get_issuer_dn
            BotanX509Cert
certPtr
            (CString -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr CString
keyPtr)
            (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index)
            Ptr Word8
outPtr
            Ptr CSize
outLen

-- Distinguished Names
--  SEE: https://www.ibm.com/docs/en/ibm-mq/7.5?topic=certificates-distinguished-names
x509CertGetSubjectDN
    :: X509Cert         -- ^ __cert__
    -> ByteString       -- ^ __key__
    -> Int              -- ^ __index__
    -> IO ByteString    -- ^ __out[]__
x509CertGetSubjectDN :: X509Cert -> ByteString -> Int -> IO ByteString
x509CertGetSubjectDN X509Cert
cert ByteString
key Int
index = X509Cert -> (BotanX509Cert -> IO ByteString) -> IO ByteString
forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert X509Cert
cert ((BotanX509Cert -> IO ByteString) -> IO ByteString)
-> (BotanX509Cert -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ BotanX509Cert
certPtr -> do
    ByteString -> (CString -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CString -> IO a) -> IO a
asCString ByteString
key ((CString -> IO ByteString) -> IO ByteString)
-> (CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ CString
keyPtr -> do
        (Ptr Word8 -> Ptr CSize -> IO CInt) -> IO ByteString
forall byte. (Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString
allocBytesQuerying ((Ptr Word8 -> Ptr CSize -> IO CInt) -> IO ByteString)
-> (Ptr Word8 -> Ptr CSize -> IO CInt) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
outPtr Ptr CSize
outLen -> BotanX509Cert
-> ConstPtr CChar -> CSize -> Ptr Word8 -> Ptr CSize -> IO CInt
botan_x509_cert_get_issuer_dn
            BotanX509Cert
certPtr
            (CString -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr CString
keyPtr)
            (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
index)
            Ptr Word8
outPtr
            Ptr CSize
outLen

x509CertToString
    :: X509Cert         -- ^ __cert__
    -> IO ByteString    -- ^ __out[]__
x509CertToString :: X509Cert -> IO ByteString
x509CertToString = (forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a)
-> GetBytes BotanX509Cert CChar -> X509Cert -> IO ByteString
forall typ ptr byte.
WithPtr typ ptr -> GetBytes ptr byte -> typ -> IO ByteString
mkGetCString X509Cert -> (BotanX509Cert -> IO a) -> IO a
forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert GetBytes BotanX509Cert CChar
botan_x509_cert_to_string

-- NOTE: Per X509 key usage extension, the extension should
--  only be present if at least one of the bits is set, and
--  usage is unrestricted if the extension is not present.
--  That is, it is an optional restriction.
data X509KeyConstraints =
    NoConstraints
  | DigitalSignature
  | NonRepudiation
  | KeyEncipherment
  | DataEncipherment
  | KeyAgreement
  | KeyCertSign
  | CRLSign
  | EncipherOnly
  | DecipherOnly

x509KeyConstraints :: X509KeyConstraints -> CUInt
x509KeyConstraints :: X509KeyConstraints -> CUInt
x509KeyConstraints X509KeyConstraints
NoConstraints    = CUInt
forall a. (Eq a, Num a) => a
NO_CONSTRAINTS
x509KeyConstraints X509KeyConstraints
DigitalSignature = CUInt
forall a. (Eq a, Num a) => a
DIGITAL_SIGNATURE
x509KeyConstraints X509KeyConstraints
NonRepudiation   = CUInt
forall a. (Eq a, Num a) => a
NON_REPUDIATION
x509KeyConstraints X509KeyConstraints
KeyEncipherment  = CUInt
forall a. (Eq a, Num a) => a
KEY_ENCIPHERMENT
x509KeyConstraints X509KeyConstraints
DataEncipherment = CUInt
forall a. (Eq a, Num a) => a
DATA_ENCIPHERMENT
x509KeyConstraints X509KeyConstraints
KeyAgreement     = CUInt
forall a. (Eq a, Num a) => a
KEY_AGREEMENT
x509KeyConstraints X509KeyConstraints
KeyCertSign      = CUInt
forall a. (Eq a, Num a) => a
KEY_CERT_SIGN
x509KeyConstraints X509KeyConstraints
CRLSign          = CUInt
forall a. (Eq a, Num a) => a
CRL_SIGN
x509KeyConstraints X509KeyConstraints
EncipherOnly     = CUInt
forall a. (Eq a, Num a) => a
ENCIPHER_ONLY
x509KeyConstraints X509KeyConstraints
DecipherOnly     = CUInt
forall a. (Eq a, Num a) => a
DECIPHER_ONLY

x509KeyConstraintsList :: [X509KeyConstraints] -> CUInt
x509KeyConstraintsList :: [X509KeyConstraints] -> CUInt
x509KeyConstraintsList [] = X509KeyConstraints -> CUInt
x509KeyConstraints X509KeyConstraints
NoConstraints
x509KeyConstraintsList (X509KeyConstraints
kc:[X509KeyConstraints]
kcs) = X509KeyConstraints -> CUInt
x509KeyConstraints X509KeyConstraints
kc CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.|. [X509KeyConstraints] -> CUInt
x509KeyConstraintsList [X509KeyConstraints]
kcs

-- |
--
-- NOTE: This function lacks documentation, and it is unknown whether this is
-- setting a value (as implied by Z-botan), or whether it is using either
-- a negative error or INVALID_IDENTIFIER to return a bool.
--
-- Note: unexplained function, best-guess implementation
x509CertAllowedUsage ::
     X509Cert             -- ^ __cert__
  -> [X509KeyConstraints] -- ^ __key_usage__
  -> IO Bool
x509CertAllowedUsage :: X509Cert -> [X509KeyConstraints] -> IO Bool
x509CertAllowedUsage X509Cert
cert [X509KeyConstraints]
usage =
    X509Cert -> (BotanX509Cert -> IO Bool) -> IO Bool
forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert X509Cert
cert ((BotanX509Cert -> IO Bool) -> IO Bool)
-> (BotanX509Cert -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ BotanX509Cert
certPtr ->
    HasCallStack => IO CInt -> IO Bool
IO CInt -> IO Bool
throwBotanCatchingInvalidVerifier (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$ BotanX509Cert -> CUInt -> IO CInt
botan_x509_cert_allowed_usage BotanX509Cert
certPtr ([X509KeyConstraints] -> CUInt
x509KeyConstraintsList [X509KeyConstraints]
usage)

{- |
Check if the certificate matches the specified hostname via alternative name or CN match.
RFC 5280 wildcards also supported.

Note: unexplained function, best-guess implementation
-}
x509CertHostnameMatch ::
     X509Cert     -- ^ __cert__
  -> ByteString   -- ^ __hostname__
  -> IO Bool
x509CertHostnameMatch :: X509Cert -> ByteString -> IO Bool
x509CertHostnameMatch X509Cert
cert ByteString
hostname =
    X509Cert -> (BotanX509Cert -> IO Bool) -> IO Bool
forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert X509Cert
cert ((BotanX509Cert -> IO Bool) -> IO Bool)
-> (BotanX509Cert -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ BotanX509Cert
certPtr ->
    ByteString -> (CString -> IO Bool) -> IO Bool
forall a. ByteString -> (CString -> IO a) -> IO a
asCString ByteString
hostname ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ CString
hostnamePtr ->
    HasCallStack => IO CInt -> IO Bool
IO CInt -> IO Bool
throwBotanCatchingInvalidInput (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$ BotanX509Cert -> ConstPtr CChar -> IO CInt
botan_x509_cert_hostname_match
      BotanX509Cert
certPtr
      (CString -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr CString
hostnamePtr)

{- |
Returns 0 if the validation was successful, 1 if validation failed,
and negative on error. A status code with details is written to
*validation_result

Intermediates or trusted lists can be null
Trusted path can be null
-}
x509CertVerify ::
     X509Cert         -- ^ __cert__
  -> [X509Cert]       -- ^ __intermediates__
  -> [X509Cert]       -- ^ __trusted__
  -> Maybe FilePath   -- ^ __trusted_path__
  -> Int              -- ^ __required_strength__
  -> ByteString       -- ^ __hostname__
  -> Word64           -- ^ __reference_time__
  -> IO (Bool, Int)   -- ^ __(valid,validation_result)__
x509CertVerify :: X509Cert
-> [X509Cert]
-> [X509Cert]
-> Maybe FilePath
-> Int
-> ByteString
-> Word64
-> IO (Bool, Int)
x509CertVerify X509Cert
cert [X509Cert]
icerts [X509Cert]
tcerts Maybe FilePath
tpath Int
strength ByteString
hostname Word64
time =
    X509Cert -> (BotanX509Cert -> IO (Bool, Int)) -> IO (Bool, Int)
forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert X509Cert
cert ((BotanX509Cert -> IO (Bool, Int)) -> IO (Bool, Int))
-> (BotanX509Cert -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ \ BotanX509Cert
certPtr ->
    (forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a)
-> [X509Cert]
-> ([BotanX509Cert] -> IO (Bool, Int))
-> IO (Bool, Int)
forall typ ptr b.
(forall a. typ -> (ptr -> IO a) -> IO a)
-> [typ] -> ([ptr] -> IO b) -> IO b
withPtrs X509Cert -> (BotanX509Cert -> IO a) -> IO a
forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert [X509Cert]
icerts (([BotanX509Cert] -> IO (Bool, Int)) -> IO (Bool, Int))
-> ([BotanX509Cert] -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ ([BotanX509Cert]
 -> (Int -> Ptr BotanX509Cert -> IO (Bool, Int)) -> IO (Bool, Int))
-> (Int -> Ptr BotanX509Cert -> IO (Bool, Int))
-> [BotanX509Cert]
-> IO (Bool, Int)
forall a b c. (a -> b -> c) -> b -> a -> c
flip [BotanX509Cert]
-> (Int -> Ptr BotanX509Cert -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen ((Int -> Ptr BotanX509Cert -> IO (Bool, Int))
 -> [BotanX509Cert] -> IO (Bool, Int))
-> (Int -> Ptr BotanX509Cert -> IO (Bool, Int))
-> [BotanX509Cert]
-> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ \ Int
icertsLen Ptr BotanX509Cert
icertsPtr ->
    (forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a)
-> [X509Cert]
-> ([BotanX509Cert] -> IO (Bool, Int))
-> IO (Bool, Int)
forall typ ptr b.
(forall a. typ -> (ptr -> IO a) -> IO a)
-> [typ] -> ([ptr] -> IO b) -> IO b
withPtrs X509Cert -> (BotanX509Cert -> IO a) -> IO a
forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert [X509Cert]
tcerts (([BotanX509Cert] -> IO (Bool, Int)) -> IO (Bool, Int))
-> ([BotanX509Cert] -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ ([BotanX509Cert]
 -> (Int -> Ptr BotanX509Cert -> IO (Bool, Int)) -> IO (Bool, Int))
-> (Int -> Ptr BotanX509Cert -> IO (Bool, Int))
-> [BotanX509Cert]
-> IO (Bool, Int)
forall a b c. (a -> b -> c) -> b -> a -> c
flip [BotanX509Cert]
-> (Int -> Ptr BotanX509Cert -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen ((Int -> Ptr BotanX509Cert -> IO (Bool, Int))
 -> [BotanX509Cert] -> IO (Bool, Int))
-> (Int -> Ptr BotanX509Cert -> IO (Bool, Int))
-> [BotanX509Cert]
-> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ \ Int
tcertsLen Ptr BotanX509Cert
tcertsPtr ->
    ((CString -> IO (Bool, Int)) -> IO (Bool, Int))
-> (FilePath -> (CString -> IO (Bool, Int)) -> IO (Bool, Int))
-> Maybe FilePath
-> (CString -> IO (Bool, Int))
-> IO (Bool, Int)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((CString -> IO (Bool, Int)) -> CString -> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ CString
forall a. Ptr a
nullPtr) FilePath -> (CString -> IO (Bool, Int)) -> IO (Bool, Int)
forall a. FilePath -> (CString -> IO a) -> IO a
String.withCString Maybe FilePath
tpath ((CString -> IO (Bool, Int)) -> IO (Bool, Int))
-> (CString -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ \ CString
tpathPtr ->
    ByteString -> (CString -> IO (Bool, Int)) -> IO (Bool, Int)
forall a. ByteString -> (CString -> IO a) -> IO a
asCString ByteString
hostname ((CString -> IO (Bool, Int)) -> IO (Bool, Int))
-> (CString -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ \ CString
hostnamePtr ->
    (Ptr CInt -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Bool, Int)) -> IO (Bool, Int))
-> (Ptr CInt -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ \ Ptr CInt
statusPtr -> do
      Bool
success <- HasCallStack => IO CInt -> IO Bool
IO CInt -> IO Bool
throwBotanCatchingInvalidVerifier (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$ Ptr CInt
-> BotanX509Cert
-> ConstPtr BotanX509Cert
-> CSize
-> ConstPtr BotanX509Cert
-> CSize
-> ConstPtr CChar
-> CSize
-> ConstPtr CChar
-> Word64
-> IO CInt
botan_x509_cert_verify
          Ptr CInt
statusPtr
          BotanX509Cert
certPtr
          (Ptr BotanX509Cert -> ConstPtr BotanX509Cert
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr BotanX509Cert
icertsPtr)
          (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
icertsLen)
          (Ptr BotanX509Cert -> ConstPtr BotanX509Cert
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr BotanX509Cert
tcertsPtr)
          (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tcertsLen)
          (CString -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr CString
tpathPtr)
          (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
strength)
          (CString -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr CString
hostnamePtr)
          Word64
time
      Int
code <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
statusPtr
      (Bool, Int) -> IO (Bool, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
success, Int
code)
    -- TODO: The above works, but there's more to it
    --  Need to allow null pointer for empty lists too, something like:
    --      where
    --          withNullPtr withPtr m = if m == mempty then ($ nullPtr) else withPtr m
    --  but we'll need to fiddle with this function (and x509CertVerifyWithCLR)

x509CertValidationStatus
    :: Int  -- ^ __code__
    -> IO (Maybe ByteString)
x509CertValidationStatus :: Int -> IO (Maybe ByteString)
x509CertValidationStatus Int
code = do
    ConstPtr CChar
status <- CInt -> IO (ConstPtr CChar)
botan_x509_cert_validation_status (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
code)
    if ConstPtr CChar
status ConstPtr CChar -> ConstPtr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== CString -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr CString
forall a. Ptr a
nullPtr
        then Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
        else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> IO ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO ByteString
packCString ConstPtr CChar
status.unConstPtr

-- /*
-- * X.509 CRL
-- **************************/

-- TODO: Move to Botan.Low.X509.CRL after merging extended FFI

newtype X509CRL = MkX509CRL { X509CRL -> ForeignPtr BotanX509CRLStruct
foreignPtr :: ForeignPtr BotanX509CRLStruct }

withX509CRL     :: X509CRL -> (BotanX509CRL -> IO a) -> IO a
x509CRLDestroy  :: X509CRL -> IO ()
createX509CRL   :: (Ptr BotanX509CRL -> IO CInt) -> IO X509CRL
(X509CRL -> (BotanX509CRL -> IO a) -> IO a
withX509CRL, X509CRL -> IO ()
x509CRLDestroy, (Ptr BotanX509CRL -> IO CInt) -> IO X509CRL
createX509CRL)
    = (Ptr BotanX509CRLStruct -> BotanX509CRL)
-> (BotanX509CRL -> Ptr BotanX509CRLStruct)
-> (ForeignPtr BotanX509CRLStruct -> X509CRL)
-> (X509CRL -> ForeignPtr BotanX509CRLStruct)
-> FinalizerPtr BotanX509CRLStruct
-> (X509CRL -> (BotanX509CRL -> IO a) -> IO a, X509CRL -> IO (),
    (Ptr BotanX509CRL -> IO CInt) -> IO X509CRL)
forall botan struct object a.
Storable botan =>
(Ptr struct -> botan)
-> (botan -> Ptr struct)
-> (ForeignPtr struct -> object)
-> (object -> ForeignPtr struct)
-> FinalizerPtr struct
-> (object -> (botan -> IO a) -> IO a, object -> IO (),
    (Ptr botan -> IO CInt) -> IO object)
mkBindings Ptr BotanX509CRLStruct -> BotanX509CRL
MkBotanX509CRL (.ptr) ForeignPtr BotanX509CRLStruct -> X509CRL
MkX509CRL (.foreignPtr) FinalizerPtr BotanX509CRLStruct
botan_x509_crl_destroy

x509CRLLoad
    :: ByteString   -- ^ __crl_bits[]__
    -> IO X509CRL   -- ^ __crl_obj__
x509CRLLoad :: ByteString -> IO X509CRL
x509CRLLoad = ((Ptr BotanX509CRL -> IO CInt) -> IO X509CRL)
-> (Ptr BotanX509CRL -> ConstPtr Word8 -> CSize -> IO CInt)
-> ByteString
-> IO X509CRL
forall botan object.
((Ptr botan -> IO CInt) -> IO object)
-> (Ptr botan -> ConstPtr Word8 -> CSize -> IO CInt)
-> ByteString
-> IO object
mkCreateObjectCBytesLen (Ptr BotanX509CRL -> IO CInt) -> IO X509CRL
createX509CRL Ptr BotanX509CRL -> ConstPtr Word8 -> CSize -> IO CInt
botan_x509_crl_load

x509CRLLoadFile
    :: FilePath     -- ^ __crl_path__
    -> IO X509CRL   -- ^ __crl_obj__
x509CRLLoadFile :: FilePath -> IO X509CRL
x509CRLLoadFile = ((Ptr BotanX509CRL -> IO CInt) -> IO X509CRL)
-> (Ptr BotanX509CRL -> ConstPtr CChar -> IO CInt)
-> ByteString
-> IO X509CRL
forall botan object.
((Ptr botan -> IO CInt) -> IO object)
-> (Ptr botan -> ConstPtr CChar -> IO CInt)
-> ByteString
-> IO object
mkCreateObjectCString (Ptr BotanX509CRL -> IO CInt) -> IO X509CRL
createX509CRL Ptr BotanX509CRL -> ConstPtr CChar -> IO CInt
botan_x509_crl_load_file (ByteString -> IO X509CRL)
-> (FilePath -> ByteString) -> FilePath -> IO X509CRL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
Char8.pack

{- |
Given a CRL and a certificate,
check if the certificate is revoked on that particular CRL
-}
x509IsRevoked ::
     X509CRL  -- ^ __crl__
  -> X509Cert -- ^ __cert__
  -> IO Bool
x509IsRevoked :: X509CRL -> X509Cert -> IO Bool
x509IsRevoked X509CRL
crl X509Cert
cert =
    X509CRL -> (BotanX509CRL -> IO Bool) -> IO Bool
forall a. X509CRL -> (BotanX509CRL -> IO a) -> IO a
withX509CRL X509CRL
crl ((BotanX509CRL -> IO Bool) -> IO Bool)
-> (BotanX509CRL -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ BotanX509CRL
crlPtr ->
    X509Cert -> (BotanX509Cert -> IO Bool) -> IO Bool
forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert X509Cert
cert ((BotanX509Cert -> IO Bool) -> IO Bool)
-> (BotanX509Cert -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ BotanX509Cert
certPtr ->
    HasCallStack => IO CInt -> IO Bool
IO CInt -> IO Bool
throwBotanCatchingInvalidInput (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$ BotanX509CRL -> BotanX509Cert -> IO CInt
botan_x509_is_revoked BotanX509CRL
crlPtr BotanX509Cert
certPtr

{- |
Different flavor of `botan_x509_cert_verify`, supports revocation lists.
CRLs are passed as an array, same as intermediates and trusted CAs
-}
x509CertVerifyWithCLR ::
     X509Cert         -- ^ __cert__
  -> [X509Cert]       -- ^ __intermediates__
  -> [X509Cert]       -- ^ __trusted__
  -> [X509CRL]        -- ^ __crls__
  -> Maybe FilePath   -- ^ __trusted_path__
  -> Int              -- ^ __required_strength__
  -> ByteString       -- ^ __hostname__
  -> Word64           -- ^ __reference_time__
  -> IO (Bool, Int)   -- ^ __(valid,validation_result)__
x509CertVerifyWithCLR :: X509Cert
-> [X509Cert]
-> [X509Cert]
-> [X509CRL]
-> Maybe FilePath
-> Int
-> ByteString
-> Word64
-> IO (Bool, Int)
x509CertVerifyWithCLR X509Cert
cert [X509Cert]
icerts [X509Cert]
tcerts [X509CRL]
crls Maybe FilePath
tpath Int
strength ByteString
hostname Word64
time =
    X509Cert -> (BotanX509Cert -> IO (Bool, Int)) -> IO (Bool, Int)
forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert X509Cert
cert ((BotanX509Cert -> IO (Bool, Int)) -> IO (Bool, Int))
-> (BotanX509Cert -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ \ BotanX509Cert
certPtr ->
    (forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a)
-> [X509Cert]
-> ([BotanX509Cert] -> IO (Bool, Int))
-> IO (Bool, Int)
forall typ ptr b.
(forall a. typ -> (ptr -> IO a) -> IO a)
-> [typ] -> ([ptr] -> IO b) -> IO b
withPtrs X509Cert -> (BotanX509Cert -> IO a) -> IO a
forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert [X509Cert]
icerts (([BotanX509Cert] -> IO (Bool, Int)) -> IO (Bool, Int))
-> ([BotanX509Cert] -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ ([BotanX509Cert]
 -> (Int -> Ptr BotanX509Cert -> IO (Bool, Int)) -> IO (Bool, Int))
-> (Int -> Ptr BotanX509Cert -> IO (Bool, Int))
-> [BotanX509Cert]
-> IO (Bool, Int)
forall a b c. (a -> b -> c) -> b -> a -> c
flip [BotanX509Cert]
-> (Int -> Ptr BotanX509Cert -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen ((Int -> Ptr BotanX509Cert -> IO (Bool, Int))
 -> [BotanX509Cert] -> IO (Bool, Int))
-> (Int -> Ptr BotanX509Cert -> IO (Bool, Int))
-> [BotanX509Cert]
-> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ \ Int
icertsLen Ptr BotanX509Cert
icertsPtr ->
    (forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a)
-> [X509Cert]
-> ([BotanX509Cert] -> IO (Bool, Int))
-> IO (Bool, Int)
forall typ ptr b.
(forall a. typ -> (ptr -> IO a) -> IO a)
-> [typ] -> ([ptr] -> IO b) -> IO b
withPtrs X509Cert -> (BotanX509Cert -> IO a) -> IO a
forall a. X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert [X509Cert]
tcerts (([BotanX509Cert] -> IO (Bool, Int)) -> IO (Bool, Int))
-> ([BotanX509Cert] -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ ([BotanX509Cert]
 -> (Int -> Ptr BotanX509Cert -> IO (Bool, Int)) -> IO (Bool, Int))
-> (Int -> Ptr BotanX509Cert -> IO (Bool, Int))
-> [BotanX509Cert]
-> IO (Bool, Int)
forall a b c. (a -> b -> c) -> b -> a -> c
flip [BotanX509Cert]
-> (Int -> Ptr BotanX509Cert -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen ((Int -> Ptr BotanX509Cert -> IO (Bool, Int))
 -> [BotanX509Cert] -> IO (Bool, Int))
-> (Int -> Ptr BotanX509Cert -> IO (Bool, Int))
-> [BotanX509Cert]
-> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ \ Int
tcertsLen Ptr BotanX509Cert
tcertsPtr ->
    (forall a. X509CRL -> (BotanX509CRL -> IO a) -> IO a)
-> [X509CRL]
-> ([BotanX509CRL] -> IO (Bool, Int))
-> IO (Bool, Int)
forall typ ptr b.
(forall a. typ -> (ptr -> IO a) -> IO a)
-> [typ] -> ([ptr] -> IO b) -> IO b
withPtrs X509CRL -> (BotanX509CRL -> IO a) -> IO a
forall a. X509CRL -> (BotanX509CRL -> IO a) -> IO a
withX509CRL [X509CRL]
crls (([BotanX509CRL] -> IO (Bool, Int)) -> IO (Bool, Int))
-> ([BotanX509CRL] -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ ([BotanX509CRL]
 -> (Int -> Ptr BotanX509CRL -> IO (Bool, Int)) -> IO (Bool, Int))
-> (Int -> Ptr BotanX509CRL -> IO (Bool, Int))
-> [BotanX509CRL]
-> IO (Bool, Int)
forall a b c. (a -> b -> c) -> b -> a -> c
flip [BotanX509CRL]
-> (Int -> Ptr BotanX509CRL -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen ((Int -> Ptr BotanX509CRL -> IO (Bool, Int))
 -> [BotanX509CRL] -> IO (Bool, Int))
-> (Int -> Ptr BotanX509CRL -> IO (Bool, Int))
-> [BotanX509CRL]
-> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ \ Int
crlsLen Ptr BotanX509CRL
crlsPtr ->
    ((CString -> IO (Bool, Int)) -> IO (Bool, Int))
-> (FilePath -> (CString -> IO (Bool, Int)) -> IO (Bool, Int))
-> Maybe FilePath
-> (CString -> IO (Bool, Int))
-> IO (Bool, Int)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((CString -> IO (Bool, Int)) -> CString -> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ CString
forall a. Ptr a
nullPtr) FilePath -> (CString -> IO (Bool, Int)) -> IO (Bool, Int)
forall a. FilePath -> (CString -> IO a) -> IO a
String.withCString Maybe FilePath
tpath ((CString -> IO (Bool, Int)) -> IO (Bool, Int))
-> (CString -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ \ CString
tpathPtr ->
    ByteString -> (CString -> IO (Bool, Int)) -> IO (Bool, Int)
forall a. ByteString -> (CString -> IO a) -> IO a
asCString ByteString
hostname ((CString -> IO (Bool, Int)) -> IO (Bool, Int))
-> (CString -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ \ CString
hostnamePtr ->
    (Ptr CInt -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Bool, Int)) -> IO (Bool, Int))
-> (Ptr CInt -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ \ Ptr CInt
statusPtr -> do
      Bool
success <- HasCallStack => IO CInt -> IO Bool
IO CInt -> IO Bool
throwBotanCatchingInvalidVerifier (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$ Ptr CInt
-> BotanX509Cert
-> ConstPtr BotanX509Cert
-> CSize
-> ConstPtr BotanX509Cert
-> CSize
-> ConstPtr BotanX509CRL
-> CSize
-> ConstPtr CChar
-> CSize
-> ConstPtr CChar
-> Word64
-> IO CInt
botan_x509_cert_verify_with_crl
          Ptr CInt
statusPtr
          BotanX509Cert
certPtr
          (Ptr BotanX509Cert -> ConstPtr BotanX509Cert
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr BotanX509Cert
icertsPtr)
          (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
icertsLen)
          (Ptr BotanX509Cert -> ConstPtr BotanX509Cert
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr BotanX509Cert
tcertsPtr)
          (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tcertsLen)
          (Ptr BotanX509CRL -> ConstPtr BotanX509CRL
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr BotanX509CRL
crlsPtr)
          (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
crlsLen)
          (CString -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr CString
tpathPtr)
          (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
strength)
          (CString -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr CString
hostnamePtr)
          Word64
time
      Int
code <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
statusPtr
      (Bool, Int) -> IO (Bool, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
success, Int
code)