HsOpenSSL-0.11.7.11: OpenSSL/ASN1.hsc

{-# LANGUAGE CPP #-}
{-# LANGUAGE EmptyDataDecls           #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CApiFFI #-}
module OpenSSL.ASN1
    ( ASN1_OBJECT
    , obj2nid
    , nid2sn
    , nid2ln

    , ASN1_STRING
    , peekASN1String

    , ASN1_INTEGER
    , peekASN1Integer
    , withASN1Integer

    , ASN1_TIME
    , peekASN1Time
    , withASN1Time
    )
    where
#include "HsOpenSSL.h"
import           Control.Exception
import           Data.Time.Clock
import           Data.Time.Clock.POSIX
import           Data.Time.Format
import           Foreign
import           Foreign.C
import           OpenSSL.BIO
import           OpenSSL.BN
import           OpenSSL.Utils

#if !MIN_VERSION_time(1,5,0)
import System.Locale
#endif

{- ASN1_OBJECT --------------------------------------------------------------- -}

data {-# CTYPE "openssl/asn1.h" "ASN1_OBJECT" #-} ASN1_OBJECT

foreign import capi unsafe "openssl/objects.h OBJ_obj2nid"
        obj2nid :: Ptr ASN1_OBJECT -> IO CInt

foreign import capi unsafe "openssl/objects.h OBJ_nid2sn"
        _nid2sn :: CInt -> IO CString

foreign import capi unsafe "openssl/objects.h OBJ_nid2ln"
        _nid2ln :: CInt -> IO CString


nid2sn :: CInt -> IO String
nid2sn nid = _nid2sn nid >>= peekCString


nid2ln :: CInt -> IO String
nid2ln nid = _nid2ln nid >>= peekCString


{- ASN1_STRING --------------------------------------------------------------- -}

data {-# CTYPE "openssl/asn1.h" "ASN1_STRING" #-} ASN1_STRING

foreign import capi unsafe "openssl/asn1.h ASN1_STRING_get0_data"
        _ASN1_STRING_get0_data :: Ptr ASN1_STRING -> IO (Ptr CChar)

foreign import capi unsafe "openssl/asn1.h ASN1_STRING_length"
        _ASN1_STRING_length :: Ptr ASN1_STRING -> IO CInt

peekASN1String :: Ptr ASN1_STRING -> IO String
peekASN1String strPtr
    = do buf <- _ASN1_STRING_get0_data strPtr
         len <- _ASN1_STRING_length strPtr
         peekCStringLen (buf, fromIntegral len)


{- ASN1_INTEGER -------------------------------------------------------------- -}

data {-# CTYPE "openssl/asn1.h" "ASN1_INTEGER" #-} ASN1_INTEGER

foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_M_ASN1_INTEGER_new"
        _ASN1_INTEGER_new :: IO (Ptr ASN1_INTEGER)

foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_M_ASN1_INTEGER_free"
        _ASN1_INTEGER_free :: Ptr ASN1_INTEGER -> IO ()

foreign import capi unsafe "openssl/asn1.h ASN1_INTEGER_to_BN"
        _ASN1_INTEGER_to_BN :: Ptr ASN1_INTEGER -> Ptr BIGNUM -> IO (Ptr BIGNUM)

foreign import capi unsafe "openssl/asn1.h BN_to_ASN1_INTEGER"
        _BN_to_ASN1_INTEGER :: Ptr BIGNUM -> Ptr ASN1_INTEGER -> IO (Ptr ASN1_INTEGER)


peekASN1Integer :: Ptr ASN1_INTEGER -> IO Integer
peekASN1Integer intPtr
    = allocaBN $ \ bn ->
      do _ASN1_INTEGER_to_BN intPtr (unwrapBN bn)
              >>= failIfNull_
         peekBN bn


allocaASN1Integer :: (Ptr ASN1_INTEGER -> IO a) -> IO a
allocaASN1Integer
    = bracket _ASN1_INTEGER_new _ASN1_INTEGER_free


withASN1Integer :: Integer -> (Ptr ASN1_INTEGER -> IO a) -> IO a
withASN1Integer int m
    = withBN int $ \ bn ->
      allocaASN1Integer $ \ intPtr ->
      do _BN_to_ASN1_INTEGER (unwrapBN bn) intPtr
              >>= failIfNull_
         m intPtr


{- ASN1_TIME ---------------------------------------------------------------- -}

data {-# CTYPE "openssl/asn1.h" "ASN1_TIME" #-} ASN1_TIME

foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_M_ASN1_TIME_new"
        _ASN1_TIME_new :: IO (Ptr ASN1_TIME)

foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_M_ASN1_TIME_free"
        _ASN1_TIME_free :: Ptr ASN1_TIME -> IO ()

foreign import capi unsafe "openssl/asn1.h ASN1_TIME_set"
        _ASN1_TIME_set :: Ptr ASN1_TIME -> CTime -> IO (Ptr ASN1_TIME)

foreign import capi unsafe "openssl/asn1.h ASN1_TIME_print"
        _ASN1_TIME_print :: Ptr BIO_ -> Ptr ASN1_TIME -> IO CInt


peekASN1Time :: Ptr ASN1_TIME -> IO UTCTime -- asn1/t_x509.c
peekASN1Time time
    = do bio <- newMem
         withBioPtr bio $ \ bioPtr ->
             _ASN1_TIME_print bioPtr time
                  >>= failIf_ (/= 1)
         timeStr <- bioRead bio
#if MIN_VERSION_time(1,5,0)
         case parseTimeM True defaultTimeLocale "%b %e %H:%M:%S %Y %Z" timeStr of
#else
         case parseTime defaultTimeLocale "%b %e %H:%M:%S %Y %Z" timeStr of
#endif
           Just utc -> return utc
           Nothing  -> fail ("peekASN1Time: failed to parse time string: " ++ timeStr)

allocaASN1Time :: (Ptr ASN1_TIME -> IO a) -> IO a
allocaASN1Time
    = bracket _ASN1_TIME_new _ASN1_TIME_free


withASN1Time :: UTCTime -> (Ptr ASN1_TIME -> IO a) -> IO a
withASN1Time utc m
    = allocaASN1Time $ \ time ->
      do _ASN1_TIME_set time (fromIntegral (round $ utcTimeToPOSIXSeconds utc :: Integer))
              >>= failIfNull_
         m time