{-# 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 a b. IO a -> (a -> IO b) -> IO b
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 a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>  () -> IO ()
forall a. a -> IO a
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 a. a -> IO a
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a b. IO a -> (a -> IO b) -> IO b
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 a b. IO a -> (a -> IO b) -> IO b
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 a b. IO a -> (a -> IO b) -> IO b
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
key, String
val)