{-# LINE 1 "OpenSSL/DSA.hsc" #-}
{-# LANGUAGE DeriveDataTypeable       #-}
{-# LANGUAGE EmptyDataDecls           #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CApiFFI                  #-}
{-# OPTIONS_HADDOCK prune             #-}
-- | The Digital Signature Algorithm (FIPS 186-2).
--   See <http://www.openssl.org/docs/crypto/dsa.html>
module OpenSSL.DSA
    ( -- * Type
      DSAKey(..)
    , DSAPubKey
    , DSAKeyPair
    , DSA -- private

      -- * Key and parameter generation
    , generateDSAParameters
    , generateDSAKey
    , generateDSAParametersAndKey

      -- * Signing and verification
    , signDigestedDataWithDSA
    , verifyDigestedDataWithDSA

      -- * Extracting fields of DSA objects
    , dsaPrivate
    , dsaPubKeyToTuple
    , dsaKeyPairToTuple
    , tupleToDSAPubKey
    , tupleToDSAKeyPair
    ) where

import Control.Monad
import qualified Data.ByteString as BS
import Data.Typeable
import Foreign.C.String (CString)

{-# LINE 37 "OpenSSL/DSA.hsc" #-}
import Foreign.C.Types (CChar(..), CInt(..))

{-# LINE 41 "OpenSSL/DSA.hsc" #-}
import Foreign.ForeignPtr (ForeignPtr, newForeignPtr, withForeignPtr)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr (FunPtr, Ptr, nullPtr)
import Foreign.Storable (Storable(..))
import OpenSSL.BN
import OpenSSL.Utils
import System.IO.Unsafe (unsafePerformIO)

-- | The type of a DSA public key, includes parameters p, q, g and public.
newtype DSAPubKey = DSAPubKey (ForeignPtr DSA)
    deriving Typeable

-- | The type of a DSA keypair, includes parameters p, q, g, public and private.
newtype DSAKeyPair = DSAKeyPair (ForeignPtr DSA)
    deriving Typeable

-- DSAPubKey and DSAKeyPair are in fact the same type at the OpenSSL
-- level, but we want to treat them differently for type-safety.
data DSA

-- |@'DSAKey' a@ is either 'DSAPubKey' or 'DSAKeyPair'.
class DSAKey k where
    -- |Return the length of key.
    dsaSize :: k -> Int
    dsaSize k
dsa
        = IO Int -> Int
forall a. IO a -> a
unsafePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$
          k -> (Ptr DSA -> IO Int) -> IO Int
forall a. k -> (Ptr DSA -> IO a) -> IO a
forall k a. DSAKey k => k -> (Ptr DSA -> IO a) -> IO a
withDSAPtr k
dsa ((Ptr DSA -> IO Int) -> IO Int) -> (Ptr DSA -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ Ptr DSA
dsaPtr ->
              (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Ptr DSA -> IO CInt
_size Ptr DSA
dsaPtr)

    -- |Return the public prime number of the key.
    dsaP :: k -> Integer
    dsaP = (Ptr DSA -> IO (Ptr BIGNUM)) -> k -> Integer
forall k. DSAKey k => (Ptr DSA -> IO (Ptr BIGNUM)) -> k -> Integer
peekI Ptr DSA -> IO (Ptr BIGNUM)
dsa_p

    -- |Return the public 160-bit subprime, @q | p - 1@ of the key.
    dsaQ :: k -> Integer
    dsaQ = (Ptr DSA -> IO (Ptr BIGNUM)) -> k -> Integer
forall k. DSAKey k => (Ptr DSA -> IO (Ptr BIGNUM)) -> k -> Integer
peekI Ptr DSA -> IO (Ptr BIGNUM)
dsa_q

    -- |Return the public generator of subgroup of the key.
    dsaG :: k -> Integer
    dsaG = (Ptr DSA -> IO (Ptr BIGNUM)) -> k -> Integer
forall k. DSAKey k => (Ptr DSA -> IO (Ptr BIGNUM)) -> k -> Integer
peekI Ptr DSA -> IO (Ptr BIGNUM)
dsa_g

    -- |Return the public key @y = g^x@.
    dsaPublic :: k -> Integer
    dsaPublic = (Ptr DSA -> IO (Ptr BIGNUM)) -> k -> Integer
forall k. DSAKey k => (Ptr DSA -> IO (Ptr BIGNUM)) -> k -> Integer
peekI Ptr DSA -> IO (Ptr BIGNUM)
dsa_pub_key

    -- private
    withDSAPtr   :: k -> (Ptr DSA -> IO a) -> IO a
    peekDSAPtr   :: Ptr DSA -> IO (Maybe k)
    absorbDSAPtr :: Ptr DSA -> IO (Maybe k)


instance DSAKey DSAPubKey where
    withDSAPtr :: forall a. DSAPubKey -> (Ptr DSA -> IO a) -> IO a
withDSAPtr (DSAPubKey ForeignPtr DSA
fp) = ForeignPtr DSA -> (Ptr DSA -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DSA
fp
    peekDSAPtr :: Ptr DSA -> IO (Maybe DSAPubKey)
peekDSAPtr Ptr DSA
dsaPtr         = Ptr DSA -> IO (Ptr DSA)
_pubDup Ptr DSA
dsaPtr IO (Ptr DSA)
-> (Ptr DSA -> IO (Maybe DSAPubKey)) -> IO (Maybe DSAPubKey)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr DSA -> IO (Maybe DSAPubKey)
forall k. DSAKey k => Ptr DSA -> IO (Maybe k)
absorbDSAPtr
    absorbDSAPtr :: Ptr DSA -> IO (Maybe DSAPubKey)
absorbDSAPtr Ptr DSA
dsaPtr       = (ForeignPtr DSA -> Maybe DSAPubKey)
-> IO (ForeignPtr DSA) -> IO (Maybe DSAPubKey)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DSAPubKey -> Maybe DSAPubKey
forall a. a -> Maybe a
Just (DSAPubKey -> Maybe DSAPubKey)
-> (ForeignPtr DSA -> DSAPubKey)
-> ForeignPtr DSA
-> Maybe DSAPubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignPtr DSA -> DSAPubKey
DSAPubKey) (FinalizerPtr DSA -> Ptr DSA -> IO (ForeignPtr DSA)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr DSA
_free Ptr DSA
dsaPtr)


instance DSAKey DSAKeyPair where
    withDSAPtr :: forall a. DSAKeyPair -> (Ptr DSA -> IO a) -> IO a
withDSAPtr (DSAKeyPair ForeignPtr DSA
fp) = ForeignPtr DSA -> (Ptr DSA -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DSA
fp
    peekDSAPtr :: Ptr DSA -> IO (Maybe DSAKeyPair)
peekDSAPtr Ptr DSA
dsaPtr
        = do Bool
hasP <- Ptr DSA -> IO Bool
hasDSAPrivateKey Ptr DSA
dsaPtr
             if Bool
hasP then
                 Ptr DSA -> IO (Ptr DSA)
_privDup Ptr DSA
dsaPtr IO (Ptr DSA)
-> (Ptr DSA -> IO (Maybe DSAKeyPair)) -> IO (Maybe DSAKeyPair)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr DSA -> IO (Maybe DSAKeyPair)
forall k. DSAKey k => Ptr DSA -> IO (Maybe k)
absorbDSAPtr
               else
                 Maybe DSAKeyPair -> IO (Maybe DSAKeyPair)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DSAKeyPair
forall a. Maybe a
Nothing
    absorbDSAPtr :: Ptr DSA -> IO (Maybe DSAKeyPair)
absorbDSAPtr Ptr DSA
dsaPtr
        = do Bool
hasP <- Ptr DSA -> IO Bool
hasDSAPrivateKey Ptr DSA
dsaPtr
             if Bool
hasP then
                 (ForeignPtr DSA -> Maybe DSAKeyPair)
-> IO (ForeignPtr DSA) -> IO (Maybe DSAKeyPair)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DSAKeyPair -> Maybe DSAKeyPair
forall a. a -> Maybe a
Just (DSAKeyPair -> Maybe DSAKeyPair)
-> (ForeignPtr DSA -> DSAKeyPair)
-> ForeignPtr DSA
-> Maybe DSAKeyPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignPtr DSA -> DSAKeyPair
DSAKeyPair) (FinalizerPtr DSA -> Ptr DSA -> IO (ForeignPtr DSA)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr DSA
_free Ptr DSA
dsaPtr)
               else
                 Maybe DSAKeyPair -> IO (Maybe DSAKeyPair)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DSAKeyPair
forall a. Maybe a
Nothing


hasDSAPrivateKey :: Ptr DSA -> IO Bool
hasDSAPrivateKey :: Ptr DSA -> IO Bool
hasDSAPrivateKey Ptr DSA
dsaPtr
    = (Ptr BIGNUM -> Bool) -> IO (Ptr BIGNUM) -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Ptr BIGNUM -> Ptr BIGNUM -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr BIGNUM
forall a. Ptr a
nullPtr) (Ptr DSA -> IO (Ptr BIGNUM)
dsa_priv_key Ptr DSA
dsaPtr)


foreign import capi unsafe "openssl/dsa.h &DSA_free"
        _free :: FunPtr (Ptr DSA -> IO ())

foreign import capi unsafe "openssl/dsa.h DSA_free"
        dsa_free :: Ptr DSA -> IO ()

foreign import capi unsafe "openssl/dsa.h BN_free"
        _bn_free :: Ptr BIGNUM -> IO ()

foreign import capi unsafe "openssl/dsa.h DSA_new"
        _dsa_new :: IO (Ptr DSA)

foreign import capi unsafe "openssl/dsa.h DSA_generate_key"
        _dsa_generate_key :: Ptr DSA -> IO ()

foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_dsa_sign"
        _dsa_sign :: Ptr DSA -> CString -> CInt -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO CInt

foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_dsa_verify"
        _dsa_verify :: Ptr DSA -> CString -> CInt -> Ptr BIGNUM -> Ptr BIGNUM -> IO CInt

foreign import capi safe "openssl/dsa.h DSA_generate_parameters"
        _generate_params :: CInt -> Ptr CChar -> CInt -> Ptr CInt -> Ptr CInt -> Ptr () -> Ptr () -> IO (Ptr DSA)

foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_DSAPublicKey_dup"
        _pubDup :: Ptr DSA -> IO (Ptr DSA)

foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_DSAPrivateKey_dup"
        _privDup :: Ptr DSA -> IO (Ptr DSA)

foreign import capi unsafe "openssl/dsa.h DSA_size"
        _size :: Ptr DSA -> IO CInt

dsa_p, dsa_q, dsa_g, dsa_pub_key, dsa_priv_key :: Ptr DSA -> IO (Ptr BIGNUM)
setPQG :: Ptr DSA -> Integer -> Integer -> Integer -> IO ()
setKey :: Ptr DSA -> Ptr BIGNUM -> Ptr BIGNUM -> IO ()


{-# LINE 157 "OpenSSL/DSA.hsc" #-}

foreign import capi unsafe "openssl/dsa.h DSA_get0_pqg"
        _get0_pqg :: Ptr DSA -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO ()

foreign import capi unsafe "openssl/dsa.h DSA_get0_key"
        _get0_key :: Ptr DSA -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO ()

foreign import capi unsafe "openssl/dsa.h DSA_set0_pqg"
        _set0_pqg :: Ptr DSA -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> IO CInt

foreign import capi unsafe "openssl/dsa.h DSA_set0_key"
        _set0_key :: Ptr DSA -> Ptr BIGNUM -> Ptr BIGNUM -> IO CInt

withPQG :: (Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO a)
        -> Ptr DSA -> IO a
withPQG :: forall a.
(Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO a)
-> Ptr DSA -> IO a
withPQG Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO a
f Ptr DSA
dsa = (Ptr (Ptr BIGNUM) -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr BIGNUM) -> IO a) -> IO a)
-> (Ptr (Ptr BIGNUM) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr BIGNUM)
p -> (Ptr (Ptr BIGNUM) -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr BIGNUM) -> IO a) -> IO a)
-> (Ptr (Ptr BIGNUM) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr BIGNUM)
q -> (Ptr (Ptr BIGNUM) -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr BIGNUM) -> IO a) -> IO a)
-> (Ptr (Ptr BIGNUM) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr BIGNUM)
g -> do
    Ptr (Ptr BIGNUM) -> Ptr BIGNUM -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr BIGNUM)
p Ptr BIGNUM
forall a. Ptr a
nullPtr
    Ptr (Ptr BIGNUM) -> Ptr BIGNUM -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr BIGNUM)
q Ptr BIGNUM
forall a. Ptr a
nullPtr
    Ptr (Ptr BIGNUM) -> Ptr BIGNUM -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr BIGNUM)
g Ptr BIGNUM
forall a. Ptr a
nullPtr
    Ptr DSA
-> Ptr (Ptr BIGNUM)
-> Ptr (Ptr BIGNUM)
-> Ptr (Ptr BIGNUM)
-> IO ()
_get0_pqg Ptr DSA
dsa Ptr (Ptr BIGNUM)
p Ptr (Ptr BIGNUM)
q Ptr (Ptr BIGNUM)
g
    Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO a
f Ptr (Ptr BIGNUM)
p Ptr (Ptr BIGNUM)
q Ptr (Ptr BIGNUM)
g

dsa_p :: Ptr DSA -> IO (Ptr BIGNUM)
dsa_p = (Ptr (Ptr BIGNUM)
 -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM))
-> Ptr DSA -> IO (Ptr BIGNUM)
forall a.
(Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO a)
-> Ptr DSA -> IO a
withPQG ((Ptr (Ptr BIGNUM)
  -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM))
 -> Ptr DSA -> IO (Ptr BIGNUM))
-> (Ptr (Ptr BIGNUM)
    -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM))
-> Ptr DSA
-> IO (Ptr BIGNUM)
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr BIGNUM)
p Ptr (Ptr BIGNUM)
_ Ptr (Ptr BIGNUM)
_ -> Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr BIGNUM)
p
dsa_q :: Ptr DSA -> IO (Ptr BIGNUM)
dsa_q = (Ptr (Ptr BIGNUM)
 -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM))
-> Ptr DSA -> IO (Ptr BIGNUM)
forall a.
(Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO a)
-> Ptr DSA -> IO a
withPQG ((Ptr (Ptr BIGNUM)
  -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM))
 -> Ptr DSA -> IO (Ptr BIGNUM))
-> (Ptr (Ptr BIGNUM)
    -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM))
-> Ptr DSA
-> IO (Ptr BIGNUM)
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr BIGNUM)
_ Ptr (Ptr BIGNUM)
q Ptr (Ptr BIGNUM)
_ -> Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr BIGNUM)
q
dsa_g :: Ptr DSA -> IO (Ptr BIGNUM)
dsa_g = (Ptr (Ptr BIGNUM)
 -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM))
-> Ptr DSA -> IO (Ptr BIGNUM)
forall a.
(Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO a)
-> Ptr DSA -> IO a
withPQG ((Ptr (Ptr BIGNUM)
  -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM))
 -> Ptr DSA -> IO (Ptr BIGNUM))
-> (Ptr (Ptr BIGNUM)
    -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM))
-> Ptr DSA
-> IO (Ptr BIGNUM)
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr BIGNUM)
_ Ptr (Ptr BIGNUM)
_ Ptr (Ptr BIGNUM)
g -> Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr BIGNUM)
g

withKey :: (Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO a) -> Ptr DSA -> IO a
withKey :: forall a.
(Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO a) -> Ptr DSA -> IO a
withKey Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO a
f Ptr DSA
dsa = (Ptr (Ptr BIGNUM) -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr BIGNUM) -> IO a) -> IO a)
-> (Ptr (Ptr BIGNUM) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr BIGNUM)
pub -> (Ptr (Ptr BIGNUM) -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr BIGNUM) -> IO a) -> IO a)
-> (Ptr (Ptr BIGNUM) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr BIGNUM)
priv -> do
    Ptr (Ptr BIGNUM) -> Ptr BIGNUM -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr BIGNUM)
pub Ptr BIGNUM
forall a. Ptr a
nullPtr
    Ptr (Ptr BIGNUM) -> Ptr BIGNUM -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr BIGNUM)
priv Ptr BIGNUM
forall a. Ptr a
nullPtr
    Ptr DSA -> Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO ()
_get0_key Ptr DSA
dsa Ptr (Ptr BIGNUM)
pub Ptr (Ptr BIGNUM)
priv
    Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO a
f Ptr (Ptr BIGNUM)
pub Ptr (Ptr BIGNUM)
priv
dsa_pub_key :: Ptr DSA -> IO (Ptr BIGNUM)
dsa_pub_key  = (Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM))
-> Ptr DSA -> IO (Ptr BIGNUM)
forall a.
(Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO a) -> Ptr DSA -> IO a
withKey ((Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM))
 -> Ptr DSA -> IO (Ptr BIGNUM))
-> (Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM))
-> Ptr DSA
-> IO (Ptr BIGNUM)
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr BIGNUM)
p Ptr (Ptr BIGNUM)
_ -> Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr BIGNUM)
p
dsa_priv_key :: Ptr DSA -> IO (Ptr BIGNUM)
dsa_priv_key = (Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM))
-> Ptr DSA -> IO (Ptr BIGNUM)
forall a.
(Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO a) -> Ptr DSA -> IO a
withKey ((Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM))
 -> Ptr DSA -> IO (Ptr BIGNUM))
-> (Ptr (Ptr BIGNUM) -> Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM))
-> Ptr DSA
-> IO (Ptr BIGNUM)
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr BIGNUM)
_ Ptr (Ptr BIGNUM)
p -> Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr BIGNUM)
p

setPQG :: Ptr DSA -> Integer -> Integer -> Integer -> IO ()
setPQG Ptr DSA
ptr Integer
p Integer
q Integer
g = do
  Ptr BIGNUM
p' <- (BigNum -> Ptr BIGNUM) -> IO BigNum -> IO (Ptr BIGNUM)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BigNum -> Ptr BIGNUM
unwrapBN (Integer -> IO BigNum
newBN Integer
p)
  Ptr BIGNUM
q' <- (BigNum -> Ptr BIGNUM) -> IO BigNum -> IO (Ptr BIGNUM)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BigNum -> Ptr BIGNUM
unwrapBN (Integer -> IO BigNum
newBN Integer
q)
  Ptr BIGNUM
g' <- (BigNum -> Ptr BIGNUM) -> IO BigNum -> IO (Ptr BIGNUM)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BigNum -> Ptr BIGNUM
unwrapBN (Integer -> IO BigNum
newBN Integer
g)
  IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DSA -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> IO CInt
_set0_pqg Ptr DSA
ptr Ptr BIGNUM
p' Ptr BIGNUM
q' Ptr BIGNUM
g'

setKey :: Ptr DSA -> Ptr BIGNUM -> Ptr BIGNUM -> IO ()
setKey Ptr DSA
ptr Ptr BIGNUM
pub Ptr BIGNUM
priv = IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr DSA -> Ptr BIGNUM -> Ptr BIGNUM -> IO CInt
_set0_key Ptr DSA
ptr Ptr BIGNUM
pub Ptr BIGNUM
priv


{-# LINE 218 "OpenSSL/DSA.hsc" #-}

peekI :: DSAKey k => (Ptr DSA -> IO (Ptr BIGNUM)) -> k -> Integer
peekI :: forall k. DSAKey k => (Ptr DSA -> IO (Ptr BIGNUM)) -> k -> Integer
peekI Ptr DSA -> IO (Ptr BIGNUM)
peeker k
dsa
    = IO Integer -> Integer
forall a. IO a -> a
unsafePerformIO (IO Integer -> Integer) -> IO Integer -> Integer
forall a b. (a -> b) -> a -> b
$
      k -> (Ptr DSA -> IO Integer) -> IO Integer
forall a. k -> (Ptr DSA -> IO a) -> IO a
forall k a. DSAKey k => k -> (Ptr DSA -> IO a) -> IO a
withDSAPtr k
dsa ((Ptr DSA -> IO Integer) -> IO Integer)
-> (Ptr DSA -> IO Integer) -> IO Integer
forall a b. (a -> b) -> a -> b
$ \ Ptr DSA
dsaPtr ->
          do Ptr BIGNUM
bn <- Ptr DSA -> IO (Ptr BIGNUM)
peeker Ptr DSA
dsaPtr
             Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr BIGNUM
bn Ptr BIGNUM -> Ptr BIGNUM -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr BIGNUM
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"peekI: got a nullPtr"
             BigNum -> IO Integer
peekBN (Ptr BIGNUM -> BigNum
wrapBN Ptr BIGNUM
bn)

-- | Generate DSA parameters (*not* a key, but required for a key). This is a
--   compute intensive operation. See FIPS 186-2, app 2. This agrees with the
--   test vectors given in FIP 186-2, app 5
generateDSAParameters :: Int  -- ^ The number of bits in the generated prime: 512 <= x <= 1024
                      -> Maybe BS.ByteString  -- ^ optional seed, its length must be 20 bytes
                      -> IO (Int, Int, Integer, Integer, Integer)  -- ^ (iteration count, generator count, p, q, g)
generateDSAParameters :: Int -> Maybe ByteString -> IO (Int, Int, Integer, Integer, Integer)
generateDSAParameters Int
nbits Maybe ByteString
mseed = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nbits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
512 Bool -> Bool -> Bool
|| Int
nbits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1024) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid DSA bit size"
  (Ptr CInt -> IO (Int, Int, Integer, Integer, Integer))
-> IO (Int, Int, Integer, Integer, Integer)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca (\Ptr CInt
i1 ->
    (Ptr CInt -> IO (Int, Int, Integer, Integer, Integer))
-> IO (Int, Int, Integer, Integer, Integer)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca (\Ptr CInt
i2 ->
      (\(Ptr CChar, Int) -> IO (Int, Int, Integer, Integer, Integer)
x -> case Maybe ByteString
mseed of
                  Maybe ByteString
Nothing -> (Ptr CChar, Int) -> IO (Int, Int, Integer, Integer, Integer)
x (Ptr CChar
forall a. Ptr a
nullPtr, Int
0)
                  Just ByteString
seed -> ByteString
-> ((Ptr CChar, Int) -> IO (Int, Int, Integer, Integer, Integer))
-> IO (Int, Int, Integer, Integer, Integer)
forall a. ByteString -> ((Ptr CChar, Int) -> IO a) -> IO a
BS.useAsCStringLen ByteString
seed (Ptr CChar, Int) -> IO (Int, Int, Integer, Integer, Integer)
x) (\(Ptr CChar
seedptr, Int
seedlen) -> do
        Ptr DSA
ptr <- CInt
-> Ptr CChar
-> CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr ()
-> Ptr ()
-> IO (Ptr DSA)
_generate_params (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nbits) Ptr CChar
seedptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
seedlen) Ptr CInt
i1 Ptr CInt
i2 Ptr ()
forall a. Ptr a
nullPtr Ptr ()
forall a. Ptr a
nullPtr
        Ptr DSA -> IO ()
forall a. Ptr a -> IO ()
failIfNull_ Ptr DSA
ptr
        CInt
itcount <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
i1
        CInt
gencount <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
i2
        Integer
p <- Ptr DSA -> IO (Ptr BIGNUM)
dsa_p Ptr DSA
ptr IO (Ptr BIGNUM) -> (Ptr BIGNUM -> IO Integer) -> IO Integer
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BigNum -> IO Integer
peekBN (BigNum -> IO Integer)
-> (Ptr BIGNUM -> BigNum) -> Ptr BIGNUM -> IO Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr BIGNUM -> BigNum
wrapBN
        Integer
q <- Ptr DSA -> IO (Ptr BIGNUM)
dsa_q Ptr DSA
ptr IO (Ptr BIGNUM) -> (Ptr BIGNUM -> IO Integer) -> IO Integer
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BigNum -> IO Integer
peekBN (BigNum -> IO Integer)
-> (Ptr BIGNUM -> BigNum) -> Ptr BIGNUM -> IO Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr BIGNUM -> BigNum
wrapBN
        Integer
g <- Ptr DSA -> IO (Ptr BIGNUM)
dsa_g Ptr DSA
ptr IO (Ptr BIGNUM) -> (Ptr BIGNUM -> IO Integer) -> IO Integer
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BigNum -> IO Integer
peekBN (BigNum -> IO Integer)
-> (Ptr BIGNUM -> BigNum) -> Ptr BIGNUM -> IO Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr BIGNUM -> BigNum
wrapBN
        Ptr DSA -> IO ()
dsa_free Ptr DSA
ptr
        (Int, Int, Integer, Integer, Integer)
-> IO (Int, Int, Integer, Integer, Integer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
itcount, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
gencount, Integer
p, Integer
q, Integer
g))))

{-
-- | This function just runs the example DSA generation, as given in FIP 186-2,
--   app 5. The return values should be:
--   (105,
--    "8df2a494492276aa3d25759bb06869cbeac0d83afb8d0cf7cbb8324f0d7882e5d0762fc5b7210
--     eafc2e9adac32ab7aac49693dfbf83724c2ec0736ee31c80291",
--     "c773218c737ec8ee993b4f2ded30f48edace915f",
--     "626d027839ea0a13413163a55b4cb500299d5522956cefcb3bff10f399ce2c2e71cb9de5fa24
--      babf58e5b79521925c9cc42e9f6f464b088cc572af53e6d78802"), as given at the bottom of
--    page 21
test_generateParameters = do
  let seed = BS.pack [0xd5, 0x01, 0x4e, 0x4b,
                      0x60, 0xef, 0x2b, 0xa8,
                      0xb6, 0x21, 0x1b, 0x40,
                      0x62, 0xba, 0x32, 0x24,
                      0xe0, 0x42, 0x7d, 0xd3]
  (a, b, p, q, g) <- generateParameters 512 $ Just seed
  return (a, toHex p, toHex q, g)
-}

-- | Generate a new DSA keypair, given valid parameters
generateDSAKey :: Integer  -- ^ p
               -> Integer  -- ^ q
               -> Integer  -- ^ g
               -> IO DSAKeyPair
generateDSAKey :: Integer -> Integer -> Integer -> IO DSAKeyPair
generateDSAKey Integer
p Integer
q Integer
g = do
  Ptr DSA
ptr <- IO (Ptr DSA)
_dsa_new
  Ptr DSA -> Integer -> Integer -> Integer -> IO ()
setPQG Ptr DSA
ptr Integer
p Integer
q Integer
g
  Ptr DSA -> IO ()
_dsa_generate_key Ptr DSA
ptr
  (ForeignPtr DSA -> DSAKeyPair)
-> IO (ForeignPtr DSA) -> IO DSAKeyPair
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ForeignPtr DSA -> DSAKeyPair
DSAKeyPair (FinalizerPtr DSA -> Ptr DSA -> IO (ForeignPtr DSA)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr DSA
_free Ptr DSA
ptr)

-- |Return the private key @x@.
dsaPrivate :: DSAKeyPair -> Integer
dsaPrivate :: DSAKeyPair -> Integer
dsaPrivate = (Ptr DSA -> IO (Ptr BIGNUM)) -> DSAKeyPair -> Integer
forall k. DSAKey k => (Ptr DSA -> IO (Ptr BIGNUM)) -> k -> Integer
peekI Ptr DSA -> IO (Ptr BIGNUM)
dsa_priv_key

-- | Convert a DSAPubKey object to a tuple of its members in the
--   order p, q, g, and public.
dsaPubKeyToTuple :: DSAKeyPair -> (Integer, Integer, Integer, Integer)
dsaPubKeyToTuple :: DSAKeyPair -> (Integer, Integer, Integer, Integer)
dsaPubKeyToTuple DSAKeyPair
dsa
    = let p :: Integer
p   = (Ptr DSA -> IO (Ptr BIGNUM)) -> DSAKeyPair -> Integer
forall k. DSAKey k => (Ptr DSA -> IO (Ptr BIGNUM)) -> k -> Integer
peekI Ptr DSA -> IO (Ptr BIGNUM)
dsa_p DSAKeyPair
dsa
          q :: Integer
q   = (Ptr DSA -> IO (Ptr BIGNUM)) -> DSAKeyPair -> Integer
forall k. DSAKey k => (Ptr DSA -> IO (Ptr BIGNUM)) -> k -> Integer
peekI Ptr DSA -> IO (Ptr BIGNUM)
dsa_q DSAKeyPair
dsa
          g :: Integer
g   = (Ptr DSA -> IO (Ptr BIGNUM)) -> DSAKeyPair -> Integer
forall k. DSAKey k => (Ptr DSA -> IO (Ptr BIGNUM)) -> k -> Integer
peekI Ptr DSA -> IO (Ptr BIGNUM)
dsa_g DSAKeyPair
dsa
          pub :: Integer
pub = (Ptr DSA -> IO (Ptr BIGNUM)) -> DSAKeyPair -> Integer
forall k. DSAKey k => (Ptr DSA -> IO (Ptr BIGNUM)) -> k -> Integer
peekI Ptr DSA -> IO (Ptr BIGNUM)
dsa_pub_key DSAKeyPair
dsa
      in
        (Integer
p, Integer
q, Integer
g, Integer
pub)

-- | Convert a DSAKeyPair object to a tuple of its members in the
--   order p, q, g, public and private.
dsaKeyPairToTuple :: DSAKeyPair -> (Integer, Integer, Integer, Integer, Integer)
dsaKeyPairToTuple :: DSAKeyPair -> (Integer, Integer, Integer, Integer, Integer)
dsaKeyPairToTuple DSAKeyPair
dsa
    = let p :: Integer
p   = (Ptr DSA -> IO (Ptr BIGNUM)) -> DSAKeyPair -> Integer
forall k. DSAKey k => (Ptr DSA -> IO (Ptr BIGNUM)) -> k -> Integer
peekI Ptr DSA -> IO (Ptr BIGNUM)
dsa_p DSAKeyPair
dsa
          q :: Integer
q   = (Ptr DSA -> IO (Ptr BIGNUM)) -> DSAKeyPair -> Integer
forall k. DSAKey k => (Ptr DSA -> IO (Ptr BIGNUM)) -> k -> Integer
peekI Ptr DSA -> IO (Ptr BIGNUM)
dsa_q DSAKeyPair
dsa
          g :: Integer
g   = (Ptr DSA -> IO (Ptr BIGNUM)) -> DSAKeyPair -> Integer
forall k. DSAKey k => (Ptr DSA -> IO (Ptr BIGNUM)) -> k -> Integer
peekI Ptr DSA -> IO (Ptr BIGNUM)
dsa_g DSAKeyPair
dsa
          pub :: Integer
pub = (Ptr DSA -> IO (Ptr BIGNUM)) -> DSAKeyPair -> Integer
forall k. DSAKey k => (Ptr DSA -> IO (Ptr BIGNUM)) -> k -> Integer
peekI Ptr DSA -> IO (Ptr BIGNUM)
dsa_pub_key  DSAKeyPair
dsa
          pri :: Integer
pri = (Ptr DSA -> IO (Ptr BIGNUM)) -> DSAKeyPair -> Integer
forall k. DSAKey k => (Ptr DSA -> IO (Ptr BIGNUM)) -> k -> Integer
peekI Ptr DSA -> IO (Ptr BIGNUM)
dsa_priv_key DSAKeyPair
dsa
      in
        (Integer
p, Integer
q, Integer
g, Integer
pub, Integer
pri)

-- | Convert a tuple of members (in the same format as from
--   'dsaPubKeyToTuple') into a DSAPubKey object
tupleToDSAPubKey :: (Integer, Integer, Integer, Integer) -> DSAPubKey
tupleToDSAPubKey :: (Integer, Integer, Integer, Integer) -> DSAPubKey
tupleToDSAPubKey (Integer
p, Integer
q, Integer
g, Integer
pub) = IO DSAPubKey -> DSAPubKey
forall a. IO a -> a
unsafePerformIO (IO DSAPubKey -> DSAPubKey) -> IO DSAPubKey -> DSAPubKey
forall a b. (a -> b) -> a -> b
$ do
  Ptr DSA
ptr <- IO (Ptr DSA)
_dsa_new
  Ptr DSA -> Integer -> Integer -> Integer -> IO ()
setPQG Ptr DSA
ptr Integer
p Integer
q Integer
g
  Ptr BIGNUM
pub' <- (BigNum -> Ptr BIGNUM) -> IO BigNum -> IO (Ptr BIGNUM)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BigNum -> Ptr BIGNUM
unwrapBN (Integer -> IO BigNum
newBN Integer
pub)
  Ptr DSA -> Ptr BIGNUM -> Ptr BIGNUM -> IO ()
setKey Ptr DSA
ptr Ptr BIGNUM
pub' Ptr BIGNUM
forall a. Ptr a
nullPtr
  (ForeignPtr DSA -> DSAPubKey)
-> IO (ForeignPtr DSA) -> IO DSAPubKey
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ForeignPtr DSA -> DSAPubKey
DSAPubKey (FinalizerPtr DSA -> Ptr DSA -> IO (ForeignPtr DSA)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr DSA
_free Ptr DSA
ptr)

-- | Convert a tuple of members (in the same format as from
--   'dsaPubKeyToTuple') into a DSAPubKey object
tupleToDSAKeyPair :: (Integer, Integer, Integer, Integer, Integer) -> DSAKeyPair
tupleToDSAKeyPair :: (Integer, Integer, Integer, Integer, Integer) -> DSAKeyPair
tupleToDSAKeyPair (Integer
p, Integer
q, Integer
g, Integer
pub, Integer
pri) = IO DSAKeyPair -> DSAKeyPair
forall a. IO a -> a
unsafePerformIO (IO DSAKeyPair -> DSAKeyPair) -> IO DSAKeyPair -> DSAKeyPair
forall a b. (a -> b) -> a -> b
$ do
  Ptr DSA
ptr <- IO (Ptr DSA)
_dsa_new
  Ptr DSA -> Integer -> Integer -> Integer -> IO ()
setPQG Ptr DSA
ptr Integer
p Integer
q Integer
g
  Ptr BIGNUM
pub' <- (BigNum -> Ptr BIGNUM) -> IO BigNum -> IO (Ptr BIGNUM)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BigNum -> Ptr BIGNUM
unwrapBN (Integer -> IO BigNum
newBN Integer
pub)
  Ptr BIGNUM
priv' <- (BigNum -> Ptr BIGNUM) -> IO BigNum -> IO (Ptr BIGNUM)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BigNum -> Ptr BIGNUM
unwrapBN (Integer -> IO BigNum
newBN Integer
pri)
  Ptr DSA -> Ptr BIGNUM -> Ptr BIGNUM -> IO ()
setKey Ptr DSA
ptr Ptr BIGNUM
pub' Ptr BIGNUM
priv'
  (ForeignPtr DSA -> DSAKeyPair)
-> IO (ForeignPtr DSA) -> IO DSAKeyPair
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ForeignPtr DSA -> DSAKeyPair
DSAKeyPair (FinalizerPtr DSA -> Ptr DSA -> IO (ForeignPtr DSA)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr DSA
_free Ptr DSA
ptr)

-- | A utility function to generate both the parameters and the key pair at the
--   same time. Saves serialising and deserialising the parameters too
generateDSAParametersAndKey :: Int  -- ^ The number of bits in the generated prime: 512 <= x <= 1024
                            -> Maybe BS.ByteString  -- ^ optional seed, its length must be 20 bytes
                            -> IO DSAKeyPair
generateDSAParametersAndKey :: Int -> Maybe ByteString -> IO DSAKeyPair
generateDSAParametersAndKey Int
nbits Maybe ByteString
mseed =
  (\(Ptr CChar, Int) -> IO DSAKeyPair
x -> case Maybe ByteString
mseed of
              Maybe ByteString
Nothing -> (Ptr CChar, Int) -> IO DSAKeyPair
x (Ptr CChar
forall a. Ptr a
nullPtr, Int
0)
              Just ByteString
seed -> ByteString -> ((Ptr CChar, Int) -> IO DSAKeyPair) -> IO DSAKeyPair
forall a. ByteString -> ((Ptr CChar, Int) -> IO a) -> IO a
BS.useAsCStringLen ByteString
seed (Ptr CChar, Int) -> IO DSAKeyPair
x) (\(Ptr CChar
seedptr, Int
seedlen) -> do
    Ptr DSA
ptr <- CInt
-> Ptr CChar
-> CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr ()
-> Ptr ()
-> IO (Ptr DSA)
_generate_params (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nbits) Ptr CChar
seedptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
seedlen) Ptr CInt
forall a. Ptr a
nullPtr Ptr CInt
forall a. Ptr a
nullPtr Ptr ()
forall a. Ptr a
nullPtr Ptr ()
forall a. Ptr a
nullPtr
    Ptr DSA -> IO ()
forall a. Ptr a -> IO ()
failIfNull_ Ptr DSA
ptr
    Ptr DSA -> IO ()
_dsa_generate_key Ptr DSA
ptr
    (ForeignPtr DSA -> DSAKeyPair)
-> IO (ForeignPtr DSA) -> IO DSAKeyPair
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ForeignPtr DSA -> DSAKeyPair
DSAKeyPair (FinalizerPtr DSA -> Ptr DSA -> IO (ForeignPtr DSA)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr DSA
_free Ptr DSA
ptr))

-- | Sign pre-digested data. The DSA specs call for SHA1 to be used so, if you
--   use anything else, YMMV. Returns a pair of Integers which, together, are
--   the signature
signDigestedDataWithDSA :: DSAKeyPair -> BS.ByteString -> IO (Integer, Integer)
signDigestedDataWithDSA :: DSAKeyPair -> ByteString -> IO (Integer, Integer)
signDigestedDataWithDSA DSAKeyPair
dsa ByteString
bytes =
  ByteString
-> ((Ptr CChar, Int) -> IO (Integer, Integer))
-> IO (Integer, Integer)
forall a. ByteString -> ((Ptr CChar, Int) -> IO a) -> IO a
BS.useAsCStringLen ByteString
bytes (\(Ptr CChar
ptr, Int
len) ->
    (Ptr (Ptr BIGNUM) -> IO (Integer, Integer))
-> IO (Integer, Integer)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca (\Ptr (Ptr BIGNUM)
rptr ->
      (Ptr (Ptr BIGNUM) -> IO (Integer, Integer))
-> IO (Integer, Integer)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca (\Ptr (Ptr BIGNUM)
sptr ->
        DSAKeyPair
-> (Ptr DSA -> IO (Integer, Integer)) -> IO (Integer, Integer)
forall k a. DSAKey k => k -> (Ptr DSA -> IO a) -> IO a
forall a. DSAKeyPair -> (Ptr DSA -> IO a) -> IO a
withDSAPtr DSAKeyPair
dsa (\Ptr DSA
dsaptr -> do
          Ptr DSA
-> Ptr CChar
-> CInt
-> Ptr (Ptr BIGNUM)
-> Ptr (Ptr BIGNUM)
-> IO CInt
_dsa_sign Ptr DSA
dsaptr Ptr CChar
ptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Ptr (Ptr BIGNUM)
rptr Ptr (Ptr BIGNUM)
sptr 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
0)
          Integer
r <- Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr BIGNUM)
rptr IO (Ptr BIGNUM) -> (Ptr BIGNUM -> IO Integer) -> IO Integer
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BigNum -> IO Integer
peekBN (BigNum -> IO Integer)
-> (Ptr BIGNUM -> BigNum) -> Ptr BIGNUM -> IO Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr BIGNUM -> BigNum
wrapBN
          Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr BIGNUM)
rptr 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 ()
_bn_free
          Integer
s <- Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr BIGNUM)
sptr IO (Ptr BIGNUM) -> (Ptr BIGNUM -> IO Integer) -> IO Integer
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BigNum -> IO Integer
peekBN (BigNum -> IO Integer)
-> (Ptr BIGNUM -> BigNum) -> Ptr BIGNUM -> IO Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr BIGNUM -> BigNum
wrapBN
          Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr BIGNUM)
sptr 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 ()
_bn_free
          (Integer, Integer) -> IO (Integer, Integer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
r, Integer
s)))))

-- | Verify pre-digested data given a signature.
verifyDigestedDataWithDSA :: DSAKey k => k -> BS.ByteString -> (Integer, Integer) -> IO Bool
verifyDigestedDataWithDSA :: forall k.
DSAKey k =>
k -> ByteString -> (Integer, Integer) -> IO Bool
verifyDigestedDataWithDSA k
dsa ByteString
bytes (Integer
r, Integer
s) =
  ByteString -> ((Ptr CChar, Int) -> IO Bool) -> IO Bool
forall a. ByteString -> ((Ptr CChar, Int) -> IO a) -> IO a
BS.useAsCStringLen ByteString
bytes (\(Ptr CChar
ptr, Int
len) ->
    Integer -> (BigNum -> IO Bool) -> IO Bool
forall a. Integer -> (BigNum -> IO a) -> IO a
withBN Integer
r (\BigNum
bnR ->
      Integer -> (BigNum -> IO Bool) -> IO Bool
forall a. Integer -> (BigNum -> IO a) -> IO a
withBN Integer
s (\BigNum
bnS ->
        k -> (Ptr DSA -> IO Bool) -> IO Bool
forall a. k -> (Ptr DSA -> IO a) -> IO a
forall k a. DSAKey k => k -> (Ptr DSA -> IO a) -> IO a
withDSAPtr k
dsa (\Ptr DSA
dsaptr ->
          (CInt -> Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
1)
               (Ptr DSA -> Ptr CChar -> CInt -> Ptr BIGNUM -> Ptr BIGNUM -> IO CInt
_dsa_verify Ptr DSA
dsaptr Ptr CChar
ptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) (BigNum -> Ptr BIGNUM
unwrapBN BigNum
bnR) (BigNum -> Ptr BIGNUM
unwrapBN BigNum
bnS))))))


instance Eq DSAPubKey where
    DSAPubKey
a == :: DSAPubKey -> DSAPubKey -> Bool
== DSAPubKey
b
        = DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaP      DSAPubKey
a Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaP      DSAPubKey
b Bool -> Bool -> Bool
&&
          DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaQ      DSAPubKey
a Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaQ      DSAPubKey
b Bool -> Bool -> Bool
&&
          DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaG      DSAPubKey
a Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaG      DSAPubKey
b Bool -> Bool -> Bool
&&
          DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaPublic DSAPubKey
a Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaPublic DSAPubKey
b

instance Eq DSAKeyPair where
    DSAKeyPair
a == :: DSAKeyPair -> DSAKeyPair -> Bool
== DSAKeyPair
b
        = DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaP       DSAKeyPair
a Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaP       DSAKeyPair
b Bool -> Bool -> Bool
&&
          DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaQ       DSAKeyPair
a Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaQ       DSAKeyPair
b Bool -> Bool -> Bool
&&
          DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaG       DSAKeyPair
a Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaG       DSAKeyPair
b Bool -> Bool -> Bool
&&
          DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaPublic  DSAKeyPair
a Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaPublic  DSAKeyPair
b Bool -> Bool -> Bool
&&
          DSAKeyPair -> Integer
dsaPrivate DSAKeyPair
a Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== DSAKeyPair -> Integer
dsaPrivate DSAKeyPair
b

instance Ord DSAPubKey where
    DSAPubKey
a compare :: DSAPubKey -> DSAPubKey -> Ordering
`compare` DSAPubKey
b
        | DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaP      DSAPubKey
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaP      DSAPubKey
b = Ordering
LT
        | DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaP      DSAPubKey
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaP      DSAPubKey
b = Ordering
GT
        | DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaQ      DSAPubKey
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaQ      DSAPubKey
b = Ordering
LT
        | DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaQ      DSAPubKey
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaQ      DSAPubKey
b = Ordering
GT
        | DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaG      DSAPubKey
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaG      DSAPubKey
b = Ordering
LT
        | DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaG      DSAPubKey
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaG      DSAPubKey
b = Ordering
GT
        | DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaPublic DSAPubKey
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaPublic DSAPubKey
b = Ordering
LT
        | DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaPublic DSAPubKey
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaPublic DSAPubKey
b = Ordering
GT
        | Bool
otherwise                 = Ordering
EQ

instance Ord DSAKeyPair where
    DSAKeyPair
a compare :: DSAKeyPair -> DSAKeyPair -> Ordering
`compare` DSAKeyPair
b
        | DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaP       DSAKeyPair
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaP       DSAKeyPair
b = Ordering
LT
        | DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaP       DSAKeyPair
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaP       DSAKeyPair
b = Ordering
GT
        | DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaQ       DSAKeyPair
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaQ       DSAKeyPair
b = Ordering
LT
        | DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaQ       DSAKeyPair
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaQ       DSAKeyPair
b = Ordering
GT
        | DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaG       DSAKeyPair
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaG       DSAKeyPair
b = Ordering
LT
        | DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaG       DSAKeyPair
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaG       DSAKeyPair
b = Ordering
GT
        | DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaPublic  DSAKeyPair
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaPublic  DSAKeyPair
b = Ordering
LT
        | DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaPublic  DSAKeyPair
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaPublic  DSAKeyPair
b = Ordering
GT
        | DSAKeyPair -> Integer
dsaPrivate DSAKeyPair
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< DSAKeyPair -> Integer
dsaPrivate DSAKeyPair
b = Ordering
LT
        | DSAKeyPair -> Integer
dsaPrivate DSAKeyPair
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> DSAKeyPair -> Integer
dsaPrivate DSAKeyPair
b = Ordering
GT
        | Bool
otherwise                   = Ordering
EQ

instance Show DSAPubKey where
    show :: DSAPubKey -> String
show DSAPubKey
a
        = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"DSAPubKey {"
                 , String
"dsaP = ", Integer -> String
forall a. Show a => a -> String
show (DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaP DSAPubKey
a), String
", "
                 , String
"dsaQ = ", Integer -> String
forall a. Show a => a -> String
show (DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaQ DSAPubKey
a), String
", "
                 , String
"dsaG = ", Integer -> String
forall a. Show a => a -> String
show (DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaG DSAPubKey
a), String
", "
                 , String
"dsaPublic = ", Integer -> String
forall a. Show a => a -> String
show (DSAPubKey -> Integer
forall k. DSAKey k => k -> Integer
dsaPublic DSAPubKey
a)
                 , String
"}"
                 ]

instance Show DSAKeyPair where
    show :: DSAKeyPair -> String
show DSAKeyPair
a
        = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"DSAPubKey {"
                 , String
"dsaP = ", Integer -> String
forall a. Show a => a -> String
show (DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaP DSAKeyPair
a), String
", "
                 , String
"dsaQ = ", Integer -> String
forall a. Show a => a -> String
show (DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaQ DSAKeyPair
a), String
", "
                 , String
"dsaG = ", Integer -> String
forall a. Show a => a -> String
show (DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaG DSAKeyPair
a), String
", "
                 , String
"dsaPublic = ", Integer -> String
forall a. Show a => a -> String
show (DSAKeyPair -> Integer
forall k. DSAKey k => k -> Integer
dsaPublic DSAKeyPair
a), String
", "
                 , String
"dsaPrivate = ", Integer -> String
forall a. Show a => a -> String
show (DSAKeyPair -> Integer
dsaPrivate DSAKeyPair
a)
                 , String
"}"
                 ]