{-# LINE 1 "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
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
{-# LINE 37 "OpenSSL/ASN1.hsc" #-}
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 :: CInt -> IO String
nid2sn CInt
nid = CInt -> IO (Ptr CChar)
_nid2sn CInt
nid IO (Ptr CChar) -> (Ptr CChar -> IO String) -> IO 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 CChar -> IO String
peekCString
nid2ln :: CInt -> IO String
nid2ln :: CInt -> IO String
nid2ln CInt
nid = CInt -> IO (Ptr CChar)
_nid2ln CInt
nid IO (Ptr CChar) -> (Ptr CChar -> IO String) -> IO 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 CChar -> IO String
peekCString
data {-# CTYPE "openssl/asn1.h" "ASN1_STRING" #-} ASN1_STRING
peekASN1String :: Ptr ASN1_STRING -> IO String
peekASN1String :: Ptr ASN1_STRING -> IO String
peekASN1String Ptr ASN1_STRING
strPtr
= do Ptr CChar
buf <- ((\Ptr ASN1_STRING
hsc_ptr -> Ptr ASN1_STRING -> Int -> IO (Ptr CChar)
forall b. Ptr b -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ASN1_STRING
hsc_ptr Int
8)) Ptr ASN1_STRING
strPtr
{-# LINE 67 "OpenSSL/ASN1.hsc" #-}
CInt
len <- ((\Ptr ASN1_STRING
hsc_ptr -> Ptr ASN1_STRING -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ASN1_STRING
hsc_ptr Int
0)) Ptr ASN1_STRING
strPtr :: IO CInt
{-# LINE 68 "OpenSSL/ASN1.hsc" #-}
CStringLen -> IO String
peekCStringLen (Ptr CChar
buf, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
len)
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 :: Ptr ASN1_INTEGER -> IO Integer
peekASN1Integer Ptr ASN1_INTEGER
intPtr
= (BigNum -> IO Integer) -> IO Integer
forall a. (BigNum -> IO a) -> IO a
allocaBN ((BigNum -> IO Integer) -> IO Integer)
-> (BigNum -> IO Integer) -> IO Integer
forall a b. (a -> b) -> a -> b
$ \ BigNum
bn ->
do Ptr ASN1_INTEGER -> Ptr BIGNUM -> IO (Ptr BIGNUM)
_ASN1_INTEGER_to_BN Ptr ASN1_INTEGER
intPtr (BigNum -> Ptr BIGNUM
unwrapBN BigNum
bn)
IO (Ptr BIGNUM) -> (Ptr BIGNUM -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr BIGNUM -> IO ()
forall a. Ptr a -> IO ()
failIfNull_
BigNum -> IO Integer
peekBN BigNum
bn
allocaASN1Integer :: (Ptr ASN1_INTEGER -> IO a) -> IO a
allocaASN1Integer :: forall a. (Ptr ASN1_INTEGER -> IO a) -> IO a
allocaASN1Integer
= IO (Ptr ASN1_INTEGER)
-> (Ptr ASN1_INTEGER -> IO ())
-> (Ptr ASN1_INTEGER -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Ptr ASN1_INTEGER)
_ASN1_INTEGER_new Ptr ASN1_INTEGER -> IO ()
_ASN1_INTEGER_free
withASN1Integer :: Integer -> (Ptr ASN1_INTEGER -> IO a) -> IO a
withASN1Integer :: forall a. Integer -> (Ptr ASN1_INTEGER -> IO a) -> IO a
withASN1Integer Integer
int Ptr ASN1_INTEGER -> IO a
m
= Integer -> (BigNum -> IO a) -> IO a
forall a. Integer -> (BigNum -> IO a) -> IO a
withBN Integer
int ((BigNum -> IO a) -> IO a) -> (BigNum -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ BigNum
bn ->
(Ptr ASN1_INTEGER -> IO a) -> IO a
forall a. (Ptr ASN1_INTEGER -> IO a) -> IO a
allocaASN1Integer ((Ptr ASN1_INTEGER -> IO a) -> IO a)
-> (Ptr ASN1_INTEGER -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ Ptr ASN1_INTEGER
intPtr ->
do Ptr BIGNUM -> Ptr ASN1_INTEGER -> IO (Ptr ASN1_INTEGER)
_BN_to_ASN1_INTEGER (BigNum -> Ptr BIGNUM
unwrapBN BigNum
bn) Ptr ASN1_INTEGER
intPtr
IO (Ptr ASN1_INTEGER) -> (Ptr ASN1_INTEGER -> IO ()) -> IO ()
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_INTEGER -> IO ()
forall a. Ptr a -> IO ()
failIfNull_
Ptr ASN1_INTEGER -> IO a
m Ptr ASN1_INTEGER
intPtr
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
peekASN1Time :: Ptr ASN1_TIME -> IO UTCTime
peekASN1Time Ptr ASN1_TIME
time
= do BIO
bio <- IO BIO
newMem
BIO -> (Ptr BIO_ -> IO ()) -> IO ()
forall a. BIO -> (Ptr BIO_ -> IO a) -> IO a
withBioPtr BIO
bio ((Ptr BIO_ -> IO ()) -> IO ()) -> (Ptr BIO_ -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr BIO_
bioPtr ->
Ptr BIO_ -> Ptr ASN1_TIME -> IO CInt
_ASN1_TIME_print Ptr BIO_
bioPtr Ptr ASN1_TIME
time
IO CInt -> (CInt -> IO ()) -> IO ()
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 ()
forall a. (a -> Bool) -> a -> IO ()
failIf_ (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
1)
String
timeStr <- BIO -> IO String
bioRead BIO
bio
{-# LINE 135 "OpenSSL/ASN1.hsc" #-}
case Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%b %e %H:%M:%S %Y %Z" String
timeStr of
{-# LINE 139 "OpenSSL/ASN1.hsc" #-}
Just UTCTime
utc -> UTCTime -> IO UTCTime
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return UTCTime
utc
Maybe UTCTime
Nothing -> String -> IO UTCTime
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"peekASN1Time: failed to parse time string: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
timeStr)
allocaASN1Time :: (Ptr ASN1_TIME -> IO a) -> IO a
allocaASN1Time :: forall a. (Ptr ASN1_TIME -> IO a) -> IO a
allocaASN1Time
= IO (Ptr ASN1_TIME)
-> (Ptr ASN1_TIME -> IO ()) -> (Ptr ASN1_TIME -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Ptr ASN1_TIME)
_ASN1_TIME_new Ptr ASN1_TIME -> IO ()
_ASN1_TIME_free
withASN1Time :: UTCTime -> (Ptr ASN1_TIME -> IO a) -> IO a
withASN1Time :: forall a. UTCTime -> (Ptr ASN1_TIME -> IO a) -> IO a
withASN1Time UTCTime
utc Ptr ASN1_TIME -> IO a
m
= (Ptr ASN1_TIME -> IO a) -> IO a
forall a. (Ptr ASN1_TIME -> IO a) -> IO a
allocaASN1Time ((Ptr ASN1_TIME -> IO a) -> IO a)
-> (Ptr ASN1_TIME -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ Ptr ASN1_TIME
time ->
do Ptr ASN1_TIME -> CTime -> IO (Ptr ASN1_TIME)
_ASN1_TIME_set Ptr ASN1_TIME
time (Integer -> CTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (POSIXTime -> Integer
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> Integer) -> POSIXTime -> Integer
forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
utc :: Integer))
IO (Ptr ASN1_TIME) -> (Ptr ASN1_TIME -> IO ()) -> IO ()
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_TIME -> IO ()
forall a. Ptr a -> IO ()
failIfNull_
Ptr ASN1_TIME -> IO a
m Ptr ASN1_TIME
time