{-|
Module      : Botan.Low.X509
Description : X.509 Certificates and CRLs
Copyright   : (c) Leo D, 2023
License     : BSD-3-Clause
Maintainer  : 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(..)
, pattern NoConstraints
, pattern DigitalSignature
, pattern NonRepudiation
, pattern KeyEncipherment
, pattern DataEncipherment
, pattern KeyAgreement
, pattern KeyCertSign
, pattern CRLSign
, pattern EncipherOnly
, pattern DecipherOnly

-- * X509 Certificate revocation list

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

-- * Convenience
, DistinguishedName(..)

) where

import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Char8 as Char8

import Botan.Bindings.PubKey
import Botan.Bindings.X509

import Botan.Low.Hash (HashName(..))

import Botan.Low.Error
import Botan.Low.Make
import Botan.Low.Prelude
import Botan.Low.PubKey
import Botan.Low.Remake
import Data.Maybe (fromMaybe)
import Data.ByteString (packCString)
import qualified Foreign.C.String as String (withCString)
import Botan.Low.Remake (mkCreateObjectCBytesLen)
import Botan.Low.PubKey (createPubKey)

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

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

type DistinguishedName = ByteString

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

newX509Cert      :: BotanX509Cert -> IO X509Cert
withX509Cert     :: X509Cert -> (BotanX509Cert -> IO a) -> IO a
-- | Destroy an x509 cert object immediately
x509CertDestroy  :: X509Cert -> IO ()
createX509Cert   :: (Ptr BotanX509Cert -> IO CInt) -> IO X509Cert
(BotanX509Cert -> IO X509Cert
newX509Cert, X509Cert -> (BotanX509Cert -> IO a) -> IO a
withX509Cert, X509Cert -> IO ()
x509CertDestroy, (Ptr BotanX509Cert -> IO CInt) -> IO X509Cert
createX509Cert, (Ptr BotanX509Cert -> Ptr CSize -> IO CInt) -> IO [X509Cert]
_)
    = (Ptr BotanX509CertStruct -> BotanX509Cert)
-> (BotanX509Cert -> Ptr BotanX509CertStruct)
-> (ForeignPtr BotanX509CertStruct -> X509Cert)
-> (X509Cert -> ForeignPtr BotanX509CertStruct)
-> FinalizerPtr BotanX509CertStruct
-> (BotanX509Cert -> IO X509Cert,
    X509Cert -> (BotanX509Cert -> IO a) -> IO a, X509Cert -> IO (),
    (Ptr BotanX509Cert -> IO CInt) -> IO X509Cert,
    (Ptr BotanX509Cert -> Ptr CSize -> 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
-> (botan -> IO object, object -> (botan -> IO a) -> IO a,
    object -> IO (), (Ptr botan -> IO CInt) -> IO object,
    (Ptr botan -> Ptr CSize -> IO CInt) -> IO [object])
mkBindings Ptr BotanX509CertStruct -> BotanX509Cert
MkBotanX509Cert BotanX509Cert -> Ptr BotanX509CertStruct
runBotanX509Cert ForeignPtr BotanX509CertStruct -> X509Cert
MkX509Cert X509Cert -> ForeignPtr BotanX509CertStruct
getX509CertForeignPtr 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
        BotanX509Cert -> Ptr Word64 -> IO CInt
botan_x509_cert_not_before
            BotanX509Cert
certPtr
            Ptr Word64
timePtr
        Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64) -> IO Word64 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
        BotanX509Cert -> Ptr Word64 -> IO CInt
botan_x509_cert_not_after
            BotanX509Cert
certPtr
            Ptr Word64
timePtr
        Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64) -> IO Word64 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
asCString ByteString
algo ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
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
            (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
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 -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
asCString ByteString
key ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
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
            (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
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 -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
asCString ByteString
key ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
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
            (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
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.
-- pattern NoConstraints = BOTAN_X509_CERT_KEY_CONSTRAINTS_NO_CONSTRAINTS
-- pattern DigitalSignature = BOTAN_X509_CERT_KEY_CONSTRAINTS_DIGITAL_SIGNATURE
-- pattern NonRepudiation = BOTAN_X509_CERT_KEY_CONSTRAINTS_NON_REPUDIATION
-- pattern KeyEncipherment = BOTAN_X509_CERT_KEY_CONSTRAINTS_KEY_ENCIPHERMENT
-- pattern DataEncipherment = BOTAN_X509_CERT_KEY_CONSTRAINTS_DATA_ENCIPHERMENT
-- pattern KeyAgreement = BOTAN_X509_CERT_KEY_CONSTRAINTS_KEY_AGREEMENT
-- pattern KeyCertSign = BOTAN_X509_CERT_KEY_CONSTRAINTS_KEY_CERT_SIGN
-- pattern CRLSign = BOTAN_X509_CERT_KEY_CONSTRAINTS_CRL_SIGN
-- pattern EncipherOnly = BOTAN_X509_CERT_KEY_CONSTRAINTS_ENCIPHER_ONLY
-- pattern DecipherOnly = BOTAN_X509_CERT_KEY_CONSTRAINTS_DECIPHER_ONLY
type X509KeyConstraints = CUInt

pattern NoConstraints
    ,   DigitalSignature
    ,   NonRepudiation
    ,   KeyEncipherment
    ,   DataEncipherment
    ,   KeyAgreement
    ,   KeyCertSign
    ,   CRLSign
    ,   EncipherOnly
    ,   DecipherOnly
    ::  X509KeyConstraints
pattern $mNoConstraints :: forall {r}. X509KeyConstraints -> ((# #) -> r) -> ((# #) -> r) -> r
$bNoConstraints :: X509KeyConstraints
NoConstraints = NO_CONSTRAINTS
pattern $mDigitalSignature :: forall {r}. X509KeyConstraints -> ((# #) -> r) -> ((# #) -> r) -> r
$bDigitalSignature :: X509KeyConstraints
DigitalSignature = DIGITAL_SIGNATURE
pattern $mNonRepudiation :: forall {r}. X509KeyConstraints -> ((# #) -> r) -> ((# #) -> r) -> r
$bNonRepudiation :: X509KeyConstraints
NonRepudiation = NON_REPUDIATION
pattern $mKeyEncipherment :: forall {r}. X509KeyConstraints -> ((# #) -> r) -> ((# #) -> r) -> r
$bKeyEncipherment :: X509KeyConstraints
KeyEncipherment = KEY_ENCIPHERMENT
pattern $mDataEncipherment :: forall {r}. X509KeyConstraints -> ((# #) -> r) -> ((# #) -> r) -> r
$bDataEncipherment :: X509KeyConstraints
DataEncipherment = DATA_ENCIPHERMENT
pattern $mKeyAgreement :: forall {r}. X509KeyConstraints -> ((# #) -> r) -> ((# #) -> r) -> r
$bKeyAgreement :: X509KeyConstraints
KeyAgreement = KEY_AGREEMENT
pattern $mKeyCertSign :: forall {r}. X509KeyConstraints -> ((# #) -> r) -> ((# #) -> r) -> r
$bKeyCertSign :: X509KeyConstraints
KeyCertSign = KEY_CERT_SIGN
pattern $mCRLSign :: forall {r}. X509KeyConstraints -> ((# #) -> r) -> ((# #) -> r) -> r
$bCRLSign :: X509KeyConstraints
CRLSign = CRL_SIGN
pattern $mEncipherOnly :: forall {r}. X509KeyConstraints -> ((# #) -> r) -> ((# #) -> r) -> r
$bEncipherOnly :: X509KeyConstraints
EncipherOnly = ENCIPHER_ONLY
pattern $mDecipherOnly :: forall {r}. X509KeyConstraints -> ((# #) -> r) -> ((# #) -> r) -> r
$bDecipherOnly :: X509KeyConstraints
DecipherOnly = DECIPHER_ONLY

{-# WARNING x509CertAllowedUsage "Unexplained function, best-guess implementation" #-}
-- 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
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 -> do
    HasCallStack => IO CInt -> IO Bool
IO CInt -> IO Bool
throwBotanCatchingSuccess (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$ BotanX509Cert -> X509KeyConstraints -> IO CInt
botan_x509_cert_allowed_usage BotanX509Cert
certPtr X509KeyConstraints
usage

{-# WARNING x509CertHostnameMatch "Unexplained function, best-guess implementation" #-}
{- |
Check if the certificate matches the specified hostname via alternative name or CN match.
RFC 5280 wildcards also supported.
-}
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 -> do
    ByteString -> (Ptr CChar -> IO Bool) -> IO Bool
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
asCString ByteString
hostname ((Ptr CChar -> IO Bool) -> IO Bool)
-> (Ptr CChar -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
hostnamePtr -> do
        HasCallStack => IO CInt -> IO Bool
IO CInt -> IO Bool
throwBotanCatchingSuccess (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
            (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
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 = do
    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 -> do
        (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 -> do
            (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 -> do
                ((Ptr CChar -> IO (Bool, Int)) -> IO (Bool, Int))
-> (FilePath -> (Ptr CChar -> IO (Bool, Int)) -> IO (Bool, Int))
-> Maybe FilePath
-> (Ptr CChar -> IO (Bool, Int))
-> IO (Bool, Int)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((Ptr CChar -> IO (Bool, Int)) -> Ptr CChar -> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ Ptr CChar
forall a. Ptr a
nullPtr) FilePath -> (Ptr CChar -> IO (Bool, Int)) -> IO (Bool, Int)
forall a. FilePath -> (Ptr CChar -> IO a) -> IO a
String.withCString Maybe FilePath
tpath ((Ptr CChar -> IO (Bool, Int)) -> IO (Bool, Int))
-> (Ptr CChar -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
tpathPtr -> do
                    ByteString -> (Ptr CChar -> IO (Bool, Int)) -> IO (Bool, Int)
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
asCString ByteString
hostname ((Ptr CChar -> IO (Bool, Int)) -> IO (Bool, Int))
-> (Ptr CChar -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
hostnamePtr -> do
                        (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
throwBotanCatchingSuccess (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)
                                (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
tpathPtr)
                                (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
strength)
                                (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
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
== Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
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
<$> Ptr CChar -> IO ByteString
packCString (ConstPtr CChar -> Ptr CChar
forall a. ConstPtr a -> Ptr a
unConstPtr ConstPtr CChar
status)

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

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

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

newX509CRL      :: BotanX509CRL -> IO X509CRL
withX509CRL     :: X509CRL -> (BotanX509CRL -> IO a) -> IO a
x509CRLDestroy  :: X509CRL -> IO ()
createX509CRL   :: (Ptr BotanX509CRL -> IO CInt) -> IO X509CRL
(BotanX509CRL -> IO X509CRL
newX509CRL, X509CRL -> (BotanX509CRL -> IO a) -> IO a
withX509CRL, X509CRL -> IO ()
x509CRLDestroy, (Ptr BotanX509CRL -> IO CInt) -> IO X509CRL
createX509CRL, (Ptr BotanX509CRL -> Ptr CSize -> IO CInt) -> IO [X509CRL]
_)
    = (Ptr BotanX509CRLStruct -> BotanX509CRL)
-> (BotanX509CRL -> Ptr BotanX509CRLStruct)
-> (ForeignPtr BotanX509CRLStruct -> X509CRL)
-> (X509CRL -> ForeignPtr BotanX509CRLStruct)
-> FinalizerPtr BotanX509CRLStruct
-> (BotanX509CRL -> IO X509CRL,
    X509CRL -> (BotanX509CRL -> IO a) -> IO a, X509CRL -> IO (),
    (Ptr BotanX509CRL -> IO CInt) -> IO X509CRL,
    (Ptr BotanX509CRL -> Ptr CSize -> 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
-> (botan -> IO object, object -> (botan -> IO a) -> IO a,
    object -> IO (), (Ptr botan -> IO CInt) -> IO object,
    (Ptr botan -> Ptr CSize -> IO CInt) -> IO [object])
mkBindings Ptr BotanX509CRLStruct -> BotanX509CRL
MkBotanX509CRL BotanX509CRL -> Ptr BotanX509CRLStruct
runBotanX509CRL ForeignPtr BotanX509CRLStruct -> X509CRL
MkX509CRL X509CRL -> ForeignPtr BotanX509CRLStruct
getX509CRLForeignPtr 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 -> do
    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 -> do
        HasCallStack => IO CInt -> IO Bool
IO CInt -> IO Bool
throwBotanCatchingSuccess (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 = do
    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 -> do
        (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 -> do
            (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 -> do
                (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 -> do
                    ((Ptr CChar -> IO (Bool, Int)) -> IO (Bool, Int))
-> (FilePath -> (Ptr CChar -> IO (Bool, Int)) -> IO (Bool, Int))
-> Maybe FilePath
-> (Ptr CChar -> IO (Bool, Int))
-> IO (Bool, Int)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((Ptr CChar -> IO (Bool, Int)) -> Ptr CChar -> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ Ptr CChar
forall a. Ptr a
nullPtr) FilePath -> (Ptr CChar -> IO (Bool, Int)) -> IO (Bool, Int)
forall a. FilePath -> (Ptr CChar -> IO a) -> IO a
String.withCString Maybe FilePath
tpath ((Ptr CChar -> IO (Bool, Int)) -> IO (Bool, Int))
-> (Ptr CChar -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
tpathPtr -> do
                        ByteString -> (Ptr CChar -> IO (Bool, Int)) -> IO (Bool, Int)
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
asCString ByteString
hostname ((Ptr CChar -> IO (Bool, Int)) -> IO (Bool, Int))
-> (Ptr CChar -> IO (Bool, Int)) -> IO (Bool, Int)
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
hostnamePtr -> do
                            (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
throwBotanCatchingSuccess (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)
                                    (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
tpathPtr)
                                    (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
strength)
                                    (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
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)