{-|
Module      : Botan.Low.DSA
Description : Algorithm specific key operations: DSA
Copyright   : (c) Leo D, 2023
License     : BSD-3-Clause
Maintainer  : leo@apotheca.io
Stability   : experimental
Portability : POSIX
-}

module Botan.Low.PubKey.DSA where

import qualified Data.ByteString as ByteString

import Botan.Bindings.PubKey
import Botan.Bindings.PubKey.DSA

import Botan.Low.Error
import Botan.Low.Make
import Botan.Low.MPI
import Botan.Low.Prelude
import Botan.Low.PubKey
import Botan.Low.RNG

privKeyCreateDSA
    :: RNG          -- ^ __rng__: initialized PRNG
    -> Int          -- ^ __pbits__: length of the key in bits. Must be between in range (1024, 3072)
                    --   and multiple of 64. Bit size of the prime 'p'
    -> Int          -- ^ __qbits__: qbits order of the subgroup. Must be in range (160, 256) and multiple
                    --   of 8
    -> IO PrivKey   -- ^ __key__: handler to the resulting key
privKeyCreateDSA :: RNG -> Int -> Int -> IO PrivKey
privKeyCreateDSA RNG
rng Int
pbits Int
qbits = RNG -> (BotanRNG -> IO PrivKey) -> IO PrivKey
forall a. RNG -> (BotanRNG -> IO a) -> IO a
withRNG RNG
rng ((BotanRNG -> IO PrivKey) -> IO PrivKey)
-> (BotanRNG -> IO PrivKey) -> IO PrivKey
forall a b. (a -> b) -> a -> b
$ \ BotanRNG
botanRNG -> do
    (Ptr BotanPrivKey -> IO CInt) -> IO PrivKey
createPrivKey ((Ptr BotanPrivKey -> IO CInt) -> IO PrivKey)
-> (Ptr BotanPrivKey -> IO CInt) -> IO PrivKey
forall a b. (a -> b) -> a -> b
$ \ Ptr BotanPrivKey
out -> Ptr BotanPrivKey -> BotanRNG -> CSize -> CSize -> IO CInt
botan_privkey_create_dsa
        Ptr BotanPrivKey
out
        BotanRNG
botanRNG
        (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pbits)
        (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
qbits)
        
privKeyLoadDSA 
    :: MP           -- ^ __p__
    -> MP           -- ^ __q__
    -> MP           -- ^ __g__
    -> MP           -- ^ __x__
    -> IO PrivKey   -- ^ __key__
privKeyLoadDSA :: MP -> MP -> MP -> MP -> IO PrivKey
privKeyLoadDSA = (Ptr BotanPrivKey
 -> BotanMP -> BotanMP -> BotanMP -> BotanMP -> IO CInt)
-> MP -> MP -> MP -> MP -> IO PrivKey
mkPrivKeyLoad4 Ptr BotanPrivKey
-> BotanMP -> BotanMP -> BotanMP -> BotanMP -> IO CInt
botan_privkey_load_dsa

pubKeyLoadDSA
    :: MP           -- ^ __p__
    -> MP           -- ^ __q__
    -> MP           -- ^ __g__
    -> MP           -- ^ __y__
    -> IO PubKey    -- ^ __key__
pubKeyLoadDSA :: MP -> MP -> MP -> MP -> IO PubKey
pubKeyLoadDSA = (Ptr BotanPubKey
 -> BotanMP -> BotanMP -> BotanMP -> BotanMP -> IO CInt)
-> MP -> MP -> MP -> MP -> IO PubKey
mkPubKeyLoad4 Ptr BotanPubKey
-> BotanMP -> BotanMP -> BotanMP -> BotanMP -> IO CInt
botan_pubkey_load_dsa