{-# LINE 1 "OpenSSL/X509/Name.hsc" #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE CApiFFI #-} module OpenSSL.X509.Name ( X509_NAME , allocaX509Name , withX509Name , peekX509Name ) where import Control.Exception import Foreign import Foreign.C import OpenSSL.ASN1 import OpenSSL.Utils data {-# CTYPE "openssl/x509.h" "X509_NAME" #-} X509_NAME data {-# CTYPE "openssl/x509.h" "X509_NAME_ENTRY" #-} X509_NAME_ENTRY foreign import capi unsafe "openssl/x509.h X509_NAME_new" _new :: IO (Ptr X509_NAME) foreign import capi unsafe "openssl/x509.h X509_NAME_free" _free :: Ptr X509_NAME -> IO () foreign import capi unsafe "openssl/x509.h X509_NAME_add_entry_by_txt" _add_entry_by_txt :: Ptr X509_NAME -> CString -> CInt -> Ptr CChar -> CInt -> CInt -> CInt -> IO CInt foreign import capi unsafe "openssl/x509.h X509_NAME_entry_count" _entry_count :: Ptr X509_NAME -> IO CInt foreign import capi unsafe "openssl/x509.h X509_NAME_get_entry" _get_entry :: Ptr X509_NAME -> CInt -> IO (Ptr X509_NAME_ENTRY) foreign import capi unsafe "openssl/x509.h X509_NAME_ENTRY_get_object" _ENTRY_get_object :: Ptr X509_NAME_ENTRY -> IO (Ptr ASN1_OBJECT) foreign import capi unsafe "openssl/x509.h X509_NAME_ENTRY_get_data" _ENTRY_get_data :: Ptr X509_NAME_ENTRY -> IO (Ptr ASN1_STRING) allocaX509Name :: (Ptr X509_NAME -> IO a) -> IO a allocaX509Name :: forall a. (Ptr X509_NAME -> IO a) -> IO a allocaX509Name = IO (Ptr X509_NAME) -> (Ptr X509_NAME -> IO ()) -> (Ptr X509_NAME -> IO a) -> IO a forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c bracket IO (Ptr X509_NAME) _new Ptr X509_NAME -> IO () _free withX509Name :: [(String, String)] -> (Ptr X509_NAME -> IO a) -> IO a withX509Name :: forall a. [(String, String)] -> (Ptr X509_NAME -> IO a) -> IO a withX509Name [(String, String)] name Ptr X509_NAME -> IO a m = (Ptr X509_NAME -> IO a) -> IO a forall a. (Ptr X509_NAME -> IO a) -> IO a allocaX509Name ((Ptr X509_NAME -> IO a) -> IO a) -> (Ptr X509_NAME -> IO a) -> IO a forall a b. (a -> b) -> a -> b $ \ Ptr X509_NAME namePtr -> do ((String, String) -> IO ()) -> [(String, String)] -> IO () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (Ptr X509_NAME -> (String, String) -> IO () addEntry Ptr X509_NAME namePtr) [(String, String)] name Ptr X509_NAME -> IO a m Ptr X509_NAME namePtr where addEntry :: Ptr X509_NAME -> (String, String) -> IO () addEntry :: Ptr X509_NAME -> (String, String) -> IO () addEntry Ptr X509_NAME namePtr (String key, String val) = String -> (CString -> IO ()) -> IO () forall a. String -> (CString -> IO a) -> IO a withCString String key ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $ \ CString keyPtr -> String -> (CStringLen -> IO ()) -> IO () forall a. String -> (CStringLen -> IO a) -> IO a withCStringLen String val ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $ \ (CString valPtr, Int valLen) -> Ptr X509_NAME -> CString -> CInt -> CString -> CInt -> CInt -> CInt -> IO CInt _add_entry_by_txt Ptr X509_NAME namePtr CString keyPtr (CInt 4096) CString valPtr (Int -> CInt forall a b. (Integral a, Num b) => a -> b fromIntegral Int valLen) (-CInt 1) CInt 0 {-# LINE 59 "OpenSSL/X509/Name.hsc" #-} IO CInt -> (CInt -> IO CInt) -> IO CInt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= (CInt -> Bool) -> CInt -> IO CInt forall a. (a -> Bool) -> a -> IO a failIf (CInt -> CInt -> Bool forall a. Eq a => a -> a -> Bool /= CInt 1) IO CInt -> IO () -> IO () forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> () -> IO () forall (m :: * -> *) a. Monad m => a -> m a return () peekX509Name :: Ptr X509_NAME -> Bool -> IO [(String, String)] peekX509Name :: Ptr X509_NAME -> Bool -> IO [(String, String)] peekX509Name Ptr X509_NAME namePtr Bool wantLongName = do Int count <- Int -> IO Int forall (m :: * -> *) a. Monad m => a -> m a return (Int -> IO Int) -> (CInt -> Int) -> CInt -> IO Int forall b c a. (b -> c) -> (a -> b) -> a -> c . CInt -> Int forall a b. (Integral a, Num b) => a -> b fromIntegral (CInt -> IO Int) -> IO CInt -> IO Int forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< (CInt -> Bool) -> CInt -> IO CInt forall a. (a -> Bool) -> a -> IO a failIf (CInt -> CInt -> Bool forall a. Ord a => a -> a -> Bool < CInt 0) (CInt -> IO CInt) -> IO CInt -> IO CInt forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Ptr X509_NAME -> IO CInt _entry_count Ptr X509_NAME namePtr (Int -> IO (String, String)) -> [Int] -> IO [(String, String)] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM Int -> IO (String, String) peekEntry [Int 0..Int count Int -> Int -> Int forall a. Num a => a -> a -> a - Int 1] where peekEntry :: Int -> IO (String, String) peekEntry :: Int -> IO (String, String) peekEntry Int n = do Ptr X509_NAME_ENTRY ent <- Ptr X509_NAME -> CInt -> IO (Ptr X509_NAME_ENTRY) _get_entry Ptr X509_NAME namePtr (Int -> CInt forall a b. (Integral a, Num b) => a -> b fromIntegral Int n) IO (Ptr X509_NAME_ENTRY) -> (Ptr X509_NAME_ENTRY -> IO (Ptr X509_NAME_ENTRY)) -> IO (Ptr X509_NAME_ENTRY) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Ptr X509_NAME_ENTRY -> IO (Ptr X509_NAME_ENTRY) forall a. Ptr a -> IO (Ptr a) failIfNull Ptr ASN1_OBJECT obj <- Ptr X509_NAME_ENTRY -> IO (Ptr ASN1_OBJECT) _ENTRY_get_object Ptr X509_NAME_ENTRY ent IO (Ptr ASN1_OBJECT) -> (Ptr ASN1_OBJECT -> IO (Ptr ASN1_OBJECT)) -> IO (Ptr ASN1_OBJECT) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Ptr ASN1_OBJECT -> IO (Ptr ASN1_OBJECT) forall a. Ptr a -> IO (Ptr a) failIfNull Ptr ASN1_STRING dat <- Ptr X509_NAME_ENTRY -> IO (Ptr ASN1_STRING) _ENTRY_get_data Ptr X509_NAME_ENTRY ent IO (Ptr ASN1_STRING) -> (Ptr ASN1_STRING -> IO (Ptr ASN1_STRING)) -> IO (Ptr ASN1_STRING) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Ptr ASN1_STRING -> IO (Ptr ASN1_STRING) forall a. Ptr a -> IO (Ptr a) failIfNull CInt nid <- Ptr ASN1_OBJECT -> IO CInt obj2nid Ptr ASN1_OBJECT obj String key <- if Bool wantLongName then CInt -> IO String nid2ln CInt nid else CInt -> IO String nid2sn CInt nid String val <- Ptr ASN1_STRING -> IO String peekASN1String Ptr ASN1_STRING dat (String, String) -> IO (String, String) forall (m :: * -> *) a. Monad m => a -> m a return (String key, String val)