botan-low-0.0.1.0: src/Botan/Low/X509/Store.hs
module Botan.Low.X509.Store where
import Data.Bool
import Foreign.Marshal.Utils
import Botan.Low.Error
import Botan.Low.Make
import Botan.Low.Prelude
import Botan.Low.PubKey
import Botan.Low.RNG
import Botan.Low.X509
import Botan.Bindings.PubKey
import Botan.Bindings.X509
import Botan.Bindings.X509.Store
newtype X509CertStore = MkX509CertStore { getX509CertStoreForeignPtr :: ForeignPtr X509CertStoreStruct }
withX509CertStorePtr :: X509CertStore -> (X509CertStorePtr -> IO a) -> IO a
withX509CertStorePtr = withForeignPtr . getX509CertStoreForeignPtr
x509CertStoreDestroy :: X509CertStore -> IO ()
x509CertStoreDestroy ca = finalizeForeignPtr (getX509CertStoreForeignPtr ca)
-- NOTE: mkInit cannot handle Maybes (checking for nullPtr), need a mkInitMaybe or to use maybePeek
x509CertStoreFindCert :: X509CertStore -> ByteString -> ByteString -> IO (Maybe X509Cert)
x509CertStoreFindCert store subject_dn key_id = withX509CertStorePtr store $ \ store_ptr -> do
asBytesLen subject_dn $ \ subject_dn_ptr subject_dn_len -> do
asBytesLen key_id $ \ key_id_ptr key_id_len -> do
alloca $ \ outPtr -> do
throwBotanIfNegative_ $ botan_x509_cert_store_find_cert
outPtr
store_ptr
subject_dn_ptr
subject_dn_len
key_id_ptr
key_id_len
out <- peek outPtr
if out == nullPtr
then return Nothing
else do
foreignPtr <- newForeignPtr botan_x509_cert_destroy out
return $ Just $ MkX509Cert foreignPtr
-- NOTE: Untested
-- TODO: Need some sort of allocArrayQuerying, or a mkArrayInit
x509CertStoreFindAllCerts :: X509CertStore -> ByteString -> ByteString -> IO [X509Cert]
x509CertStoreFindAllCerts store subject_dn key_id = withX509CertStorePtr store $ \ store_ptr -> do
asBytesLen subject_dn $ \ subject_dn_ptr subject_dn_len -> do
asBytesLen key_id $ \ key_id_ptr key_id_len -> do
let fn arrPtr szPtr = botan_x509_cert_store_find_all_certs arrPtr szPtr store_ptr subject_dn_ptr subject_dn_len key_id_ptr key_id_len
alloca $ \ szPtr -> do
code <- fn nullPtr szPtr
case code of
InsufficientBufferSpace -> do
sz <- fromIntegral <$> peek szPtr
allocaArray sz $ \ arrPtr -> do
throwBotanIfNegative_ $ fn arrPtr szPtr
certPtrs <- peekArray sz arrPtr
-- NOTE: Cannot use mkInit because that performs an alloca and a peek,
-- whereas we have already performed that work here
forM certPtrs $ \ certPtr -> do
foreignPtr <- newForeignPtr botan_x509_cert_destroy certPtr
return $ MkX509Cert foreignPtr
_ -> throwBotanError code
-- TODO: Use mkInitMaybe
x509CertStoreFindCertByPubkeySHA1 :: X509CertStore -> ByteString -> IO (Maybe X509Cert)
x509CertStoreFindCertByPubkeySHA1 store digest = withX509CertStorePtr store $ \ store_ptr -> do
asBytesLen digest $ \ digest_ptr _ -> do
alloca $ \ outPtr -> do
throwBotanIfNegative_ $ botan_x509_cert_store_find_cert_by_pubkey_sha1
outPtr
store_ptr
digest_ptr
out <- peek outPtr
if out == nullPtr
then return Nothing
else do
foreignPtr <- newForeignPtr botan_x509_cert_destroy out
return $ Just $ MkX509Cert foreignPtr
-- TODO: Use mkInitMaybe
x509CertStoreFindCertByRawSubjectDNSHA256 :: X509CertStore -> ByteString -> IO (Maybe X509Cert)
x509CertStoreFindCertByRawSubjectDNSHA256 store digest = withX509CertStorePtr store $ \ store_ptr -> do
asBytesLen digest $ \ digest_ptr _ -> do
alloca $ \ outPtr -> do
throwBotanIfNegative_ $ botan_x509_cert_store_find_cert_by_raw_subject_dn_sha256
outPtr
store_ptr
digest_ptr
out <- peek outPtr
if out == nullPtr
then return Nothing
else do
foreignPtr <- newForeignPtr botan_x509_cert_destroy out
return $ Just $ MkX509Cert foreignPtr
-- TODO: Use mkInitMaybe
x509CertStoreFindCRLFor :: X509CertStore -> X509Cert -> IO (Maybe X509CRL)
x509CertStoreFindCRLFor store cert = withX509CertStorePtr store $ \ store_ptr -> do
withX509Cert cert $ \ cert_ptr -> do
alloca $ \ outPtr -> do
throwBotanIfNegative_ $ botan_x509_cert_store_find_crl_for
outPtr
store_ptr
cert_ptr
out <- peek outPtr
if out == nullPtr
then return Nothing
else do
foreignPtr <- newForeignPtr botan_x509_crl_destroy out
return $ Just $ MkX509CRL foreignPtr
x509CertStoreCertificateKnown :: X509CertStore -> X509Cert -> IO Bool
x509CertStoreCertificateKnown store cert = withX509CertStorePtr store $ \ store_ptr -> do
withX509Cert cert $ \ cert_ptr -> do
throwBotanCatchingSuccess $ botan_x509_cert_store_certificate_known store_ptr cert_ptr
-- {-
-- In-memory cert store
-- -}
-- TODO: Get rid of bytestring paths
x509CertStoreInMemoryLoadDir :: ByteString -> IO X509CertStore
x509CertStoreInMemoryLoadDir path = asCString path $ \ path_ptr -> mkInit
MkX509CertStore
(\ ptr -> botan_x509_cert_store_in_memory_load_dir
ptr
path_ptr
)
botan_x509_cert_store_destroy
x509CertStoreInMemoryLoadCert :: X509Cert -> IO X509CertStore
x509CertStoreInMemoryLoadCert cert = withX509Cert cert $ \ cert_ptr -> mkInit
MkX509CertStore
(\ ptr -> botan_x509_cert_store_in_memory_load_cert
ptr
cert_ptr
)
botan_x509_cert_store_destroy
x509CertStoreInMemoryCreate :: IO X509CertStore
x509CertStoreInMemoryCreate = mkInit
MkX509CertStore
botan_x509_cert_store_in_memory_create
botan_x509_cert_store_destroy
x509CertStoreInMemoryAddCertificate :: X509CertStore -> X509Cert -> IO ()
x509CertStoreInMemoryAddCertificate store cert = withX509CertStorePtr store $ \ store_ptr -> do
withX509Cert cert $ \ cert_ptr -> do
throwBotanIfNegative_ $ botan_x509_cert_store_in_memory_add_certificate
store_ptr
cert_ptr
x509CertStoreInMemoryAddCRL :: X509CertStore -> X509CRL -> IO ()
x509CertStoreInMemoryAddCRL store crl = withX509CertStorePtr store $ \ store_ptr -> do
withX509CRL crl $ \ crl_ptr -> do
throwBotanIfNegative_ $ botan_x509_cert_store_in_memory_add_crl
store_ptr
crl_ptr
-- {-
-- Flatfile cert store
-- -}
x509CertStoreFlatfileCreate :: ByteString -> Bool -> IO X509CertStore
x509CertStoreFlatfileCreate path ignore_non_ca = asCString path $ \ path_ptr -> mkInit
MkX509CertStore
(\ ptr -> botan_x509_cert_store_flatfile_create
ptr
path_ptr
(fromBool ignore_non_ca)
)
botan_x509_cert_store_destroy
{-
SQL cert store
-}
x509CertStoreSQLInsertCert :: X509CertStore -> X509Cert -> IO Bool
x509CertStoreSQLInsertCert store cert = withX509CertStorePtr store $ \ store_ptr -> do
withX509Cert cert $ \ cert_ptr -> do
throwBotanCatchingSuccess $ botan_x509_cert_store_sql_insert_cert
store_ptr
cert_ptr
x509CertStoreSQLRemoveCert :: X509CertStore -> X509Cert -> IO Bool
x509CertStoreSQLRemoveCert store cert = withX509CertStorePtr store $ \ store_ptr -> do
withX509Cert cert $ \ cert_ptr -> do
throwBotanCatchingSuccess $ botan_x509_cert_store_sql_remove_cert
store_ptr
cert_ptr
-- TODO: Use mkInitMaybe
x509CertStoreSQLFindKey :: X509CertStore -> X509Cert -> IO (Maybe PrivKey)
x509CertStoreSQLFindKey store cert = withX509CertStorePtr store $ \ store_ptr -> do
withX509Cert cert $ \ cert_ptr -> do
alloca $ \ outPtr -> do
throwBotanIfNegative_ $ botan_x509_cert_store_sql_find_key
outPtr
store_ptr
cert_ptr
out <- peek outPtr
if out == nullPtr
then return Nothing
else do
foreignPtr <- newForeignPtr botan_privkey_destroy out
return $ Just $ MkPrivKey foreignPtr
-- NOTE: See notes about returning arrays of things, improper return pointer type
-- TODO: Need some sort of allocArrayQuerying, or a mkArrayInit
x509CertStoreSQLFindCertsForKey :: X509CertStore -> PrivKey -> IO [X509Cert]
x509CertStoreSQLFindCertsForKey store privkey = withX509CertStorePtr store $ \ store_ptr -> do
withPrivKey privkey $ \ privkey_ptr -> do
let fn arrPtr szPtr = botan_x509_cert_store_sql_find_certs_for_key arrPtr szPtr store_ptr privkey_ptr
alloca $ \ szPtr -> do
code <- fn nullPtr szPtr
case code of
InsufficientBufferSpace -> do
sz <- fromIntegral <$> peek szPtr
allocaArray sz $ \ arrPtr -> do
throwBotanIfNegative_ $ fn arrPtr szPtr
certPtrs <- peekArray sz arrPtr
-- NOTE: Cannot use mkInit because that performs an alloca and a peek,
-- whereas we have already performed that work here
forM certPtrs $ \ certPtr -> do
foreignPtr <- newForeignPtr botan_x509_cert_destroy certPtr
return $ MkX509Cert foreignPtr
_ -> throwBotanError code
x509CertStoreSQLInsertKey :: X509CertStore -> X509Cert -> PrivKey -> IO Bool
x509CertStoreSQLInsertKey store cert privkey = withX509CertStorePtr store $ \ store_ptr -> do
withX509Cert cert $ \ cert_ptr -> do
withPrivKey privkey $ \ privkey_ptr -> do
throwBotanCatchingSuccess $ botan_x509_cert_store_sql_insert_key
store_ptr
cert_ptr
privkey_ptr
x509CertStoreSQLRemoveKey :: X509CertStore -> PrivKey -> IO ()
x509CertStoreSQLRemoveKey store privkey = withX509CertStorePtr store $ \ store_ptr -> do
withPrivKey privkey $ \ privkey_ptr -> do
throwBotanIfNegative_ $ botan_x509_cert_store_sql_remove_key
store_ptr
privkey_ptr
x509CertStoreSQLRevokeCert :: X509CertStore -> X509Cert -> Word32 -> Word64 -> IO ()
x509CertStoreSQLRevokeCert store cert crl_code time = withX509CertStorePtr store $ \ store_ptr -> do
withX509Cert cert $ \ cert_ptr -> do
throwBotanIfNegative_ $ botan_x509_cert_store_sql_revoke_cert
store_ptr
cert_ptr
crl_code
time
x509CertStoreSQLAffirmCert :: X509CertStore -> X509Cert -> IO ()
x509CertStoreSQLAffirmCert store cert = withX509CertStorePtr store $ \ store_ptr -> do
withX509Cert cert $ \ cert_ptr -> do
throwBotanIfNegative_ $ botan_x509_cert_store_sql_affirm_cert
store_ptr
cert_ptr
-- -- NOTE: See notes about returning arrays of things, improper return pointer type
-- TODO: Need some sort of allocArrayQuerying, or a mkArrayInit
x509CertStoreSQLGenerateCRLs :: X509CertStore -> IO [X509CRL]
x509CertStoreSQLGenerateCRLs store = withX509CertStorePtr store $ \ store_ptr -> do
let fn arrPtr szPtr = botan_x509_cert_store_sql_generate_crls arrPtr szPtr store_ptr
alloca $ \ szPtr -> do
code <- fn nullPtr szPtr
case code of
InsufficientBufferSpace -> do
sz <- fromIntegral <$> peek szPtr
allocaArray sz $ \ arrPtr -> do
throwBotanIfNegative_ $ fn arrPtr szPtr
crlPtrs <- peekArray sz arrPtr
-- NOTE: Cannot use mkInit because that performs an alloca and a peek,
-- whereas we have already performed that work here
forM crlPtrs $ \ crlPtr -> do
foreignPtr <- newForeignPtr botan_x509_crl_destroy crlPtr
return $ MkX509CRL foreignPtr
_ -> throwBotanError code
{-
SQLite3 cert store
NOTE: Not confirmed to be implemented correctly C++-side
-}
x509CertStoreSqlite3Create :: ByteString -> ByteString -> RNG -> ByteString -> IO X509CertStore
x509CertStoreSqlite3Create db_path passwd rng table_prefix = asCString db_path $ \ db_path_ptr -> do
asCString passwd $ \ passwd_ptr -> do
withRNG rng $ \ botanRNG -> do
asCString table_prefix $ \ table_prefix_ptr -> mkInit
MkX509CertStore
(\ ptr -> botan_x509_cert_store_sqlite3_create
ptr
db_path_ptr
passwd_ptr botanRNG
table_prefix_ptr
)
botan_x509_cert_store_destroy
{-
System cert store
-}
x509CertStoreSystemCreate :: IO X509CertStore
x509CertStoreSystemCreate = mkInit MkX509CertStore botan_x509_cert_store_system_create botan_x509_cert_store_destroy
{-
MacOS cert store
NOTE: OS-specific, covered by System certificate store type?
-}
-- foreign import ccall unsafe botan_x509_cert_store_macos_create
-- :: Ptr X509CertStorePtr
-- -> IO BotanErrorCode
{-
Windows cert store
NOTE: OS-specific, covered by System certificate store type?
-}
-- foreign import ccall unsafe botan_x509_cert_store_windows_create
-- :: Ptr X509CertStorePtr
-- -> IO BotanErrorCode