{-# LINE 1 "OpenSSL/BN.hsc" #-}



{-# LINE 7 "OpenSSL/BN.hsc" #-}


{-# LINE 11 "OpenSSL/BN.hsc" #-}
{-# LANGUAGE EmptyDataDecls           #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CApiFFI                  #-}

{-# LINE 19 "OpenSSL/BN.hsc" #-}
{-# OPTIONS_HADDOCK prune             #-}
-- |BN - multiprecision integer arithmetics
module OpenSSL.BN
    ( -- * Type
      BigNum
    , BIGNUM

      -- * Allocation
    , allocaBN
    , withBN

    , newBN
    , wrapBN -- private
    , unwrapBN -- private

      -- * Conversion from\/to Integer
    , peekBN
    , integerToBN
    , bnToInteger
    , integerToMPI
    , mpiToInteger

      -- * Computation
    , modexp

      -- * Random number generation
    , randIntegerUptoNMinusOneSuchThat
    , prandIntegerUptoNMinusOneSuchThat
    , randIntegerZeroToNMinusOne
    , prandIntegerZeroToNMinusOne
    , randIntegerOneToNMinusOne
    , prandIntegerOneToNMinusOne
    )
    where

import           Control.Exception hiding (try)
import qualified Data.ByteString as BS
import           Foreign.Marshal
import           Foreign.Ptr
import           Foreign.Storable
import           OpenSSL.Utils
import           System.IO.Unsafe


{-# LINE 67 "OpenSSL/BN.hsc" #-}
import           Control.Monad
import           Foreign.C

{-# LINE 70 "OpenSSL/BN.hsc" #-}

-- |'BigNum' is an opaque object representing a big number.
newtype BigNum = BigNum (Ptr BIGNUM)
data {-# CTYPE "openssl/bn.h" "BIGNUM" #-} BIGNUM


foreign import capi unsafe "openssl/bn.h BN_new"
        _new :: IO (Ptr BIGNUM)

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

-- |@'allocaBN' f@ allocates a 'BigNum' and computes @f@. Then it
-- frees the 'BigNum'.
allocaBN :: (BigNum -> IO a) -> IO a
allocaBN :: forall a. (BigNum -> IO a) -> IO a
allocaBN BigNum -> IO a
m
    = IO (Ptr BIGNUM)
-> (Ptr BIGNUM -> IO ()) -> (Ptr BIGNUM -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Ptr BIGNUM)
_new Ptr BIGNUM -> IO ()
_free (BigNum -> IO a
m (BigNum -> IO a) -> (Ptr BIGNUM -> BigNum) -> Ptr BIGNUM -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr BIGNUM -> BigNum
wrapBN)


unwrapBN :: BigNum -> Ptr BIGNUM
unwrapBN :: BigNum -> Ptr BIGNUM
unwrapBN (BigNum Ptr BIGNUM
p) = Ptr BIGNUM
p


wrapBN :: Ptr BIGNUM -> BigNum
wrapBN :: Ptr BIGNUM -> BigNum
wrapBN = Ptr BIGNUM -> BigNum
BigNum



{-# LINE 98 "OpenSSL/BN.hsc" #-}

{- slow, safe functions ----------------------------------------------------- -}

foreign import capi unsafe "openssl/bn.h BN_bn2dec"
        _bn2dec :: Ptr BIGNUM -> IO CString

foreign import capi unsafe "openssl/bn.h BN_dec2bn"
        _dec2bn :: Ptr (Ptr BIGNUM) -> CString -> IO CInt

foreign import capi unsafe "HsOpenSSL.h HsOpenSSL_OPENSSL_free"
        _openssl_free :: Ptr a -> IO ()

-- |Convert a BIGNUM to an 'Integer'.
bnToInteger :: BigNum -> IO Integer
bnToInteger :: BigNum -> IO Integer
bnToInteger BigNum
bn
    = IO CString
-> (CString -> IO ()) -> (CString -> IO Integer) -> IO Integer
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (do CString
strPtr <- Ptr BIGNUM -> IO CString
_bn2dec (BigNum -> Ptr BIGNUM
unwrapBN BigNum
bn)
                  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CString
strPtr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"BN_bn2dec failed"
                  CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
strPtr)
              CString -> IO ()
forall a. Ptr a -> IO ()
_openssl_free
              ((String -> Integer
forall a. Read a => String -> a
read (String -> Integer) -> IO String -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`) (IO String -> IO Integer)
-> (CString -> IO String) -> CString -> IO Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> IO String
peekCString)

-- |Return a new, alloced BIGNUM.
integerToBN :: Integer -> IO BigNum
integerToBN :: Integer -> IO BigNum
integerToBN Integer
i = do
  String -> (CString -> IO BigNum) -> IO BigNum
forall a. String -> (CString -> IO a) -> IO a
withCString (Integer -> String
forall a. Show a => a -> String
show Integer
i) (\CString
str -> do
    (Ptr (Ptr BIGNUM) -> IO BigNum) -> IO BigNum
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca (\Ptr (Ptr BIGNUM)
bnptr -> do
      Ptr (Ptr BIGNUM) -> Ptr BIGNUM -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr BIGNUM)
bnptr Ptr BIGNUM
forall a. Ptr a
nullPtr
      CInt
_ <- Ptr (Ptr BIGNUM) -> CString -> IO CInt
_dec2bn Ptr (Ptr BIGNUM)
bnptr CString
str IO CInt -> (CInt -> IO CInt) -> IO CInt
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
0)
      Ptr BIGNUM -> BigNum
wrapBN (Ptr BIGNUM -> BigNum) -> IO (Ptr BIGNUM) -> IO BigNum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr (Ptr BIGNUM) -> IO (Ptr BIGNUM)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr BIGNUM)
bnptr))


{-# LINE 235 "OpenSSL/BN.hsc" #-}

-- TODO: we could make a function which doesn't even allocate BN data if we
-- wanted to be very fast and dangerout. The BIGNUM could point right into the
-- Integer's data. However, I'm not sure about the semantics of the GC; which
-- might move the Integer data around.

-- |@'withBN' n f@ converts n to a 'BigNum' and computes @f@. Then it
-- frees the 'BigNum'.
withBN :: Integer -> (BigNum -> IO a) -> IO a
withBN :: forall a. Integer -> (BigNum -> IO a) -> IO a
withBN Integer
dec BigNum -> IO a
m = IO BigNum -> (BigNum -> IO ()) -> (BigNum -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Integer -> IO BigNum
integerToBN Integer
dec) (Ptr BIGNUM -> IO ()
_free (Ptr BIGNUM -> IO ()) -> (BigNum -> Ptr BIGNUM) -> BigNum -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BigNum -> Ptr BIGNUM
unwrapBN) BigNum -> IO a
m

foreign import capi unsafe "openssl/bn.h BN_bn2mpi"
        _bn2mpi :: Ptr BIGNUM -> Ptr CChar -> IO CInt

foreign import capi unsafe "openssl/bn.h BN_mpi2bn"
        _mpi2bn :: Ptr CChar -> CInt -> Ptr BIGNUM -> IO (Ptr BIGNUM)

-- |This is an alias to 'bnToInteger'.
peekBN :: BigNum -> IO Integer
peekBN :: BigNum -> IO Integer
peekBN = BigNum -> IO Integer
bnToInteger

-- |This is an alias to 'integerToBN'.
newBN :: Integer -> IO BigNum
newBN :: Integer -> IO BigNum
newBN = Integer -> IO BigNum
integerToBN

-- | Convert a BigNum to an MPI: a serialisation of large ints which has a
--   4-byte, big endian length followed by the bytes of the number in
--   most-significant-first order.
bnToMPI :: BigNum -> IO BS.ByteString
bnToMPI :: BigNum -> IO ByteString
bnToMPI BigNum
bn = do
  CInt
bytes <- Ptr BIGNUM -> CString -> IO CInt
_bn2mpi (BigNum -> Ptr BIGNUM
unwrapBN BigNum
bn) CString
forall a. Ptr a
nullPtr
  Int -> (CString -> IO ByteString) -> IO ByteString
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
bytes) (\CString
buffer -> do
    CInt
_ <- Ptr BIGNUM -> CString -> IO CInt
_bn2mpi (BigNum -> Ptr BIGNUM
unwrapBN BigNum
bn) CString
buffer
    CStringLen -> IO ByteString
BS.packCStringLen (CString
buffer, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
bytes))

-- | Convert an MPI into a BigNum. See bnToMPI for details of the format
mpiToBN :: BS.ByteString -> IO BigNum
mpiToBN :: ByteString -> IO BigNum
mpiToBN ByteString
mpi = do
  ByteString -> (CStringLen -> IO (Ptr BIGNUM)) -> IO (Ptr BIGNUM)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
mpi (\(CString
ptr, Int
len) -> do
    CString -> CInt -> Ptr BIGNUM -> IO (Ptr BIGNUM)
_mpi2bn CString
ptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Ptr BIGNUM
forall a. Ptr a
nullPtr) IO (Ptr BIGNUM) -> (Ptr BIGNUM -> IO BigNum) -> IO BigNum
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BigNum -> IO BigNum
forall (m :: * -> *) a. Monad m => a -> m a
return (BigNum -> IO BigNum)
-> (Ptr BIGNUM -> BigNum) -> Ptr BIGNUM -> IO BigNum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr BIGNUM -> BigNum
wrapBN

-- | Convert an Integer to an MPI. See bnToMPI for the format
integerToMPI :: Integer -> IO BS.ByteString
integerToMPI :: Integer -> IO ByteString
integerToMPI Integer
v = IO BigNum
-> (BigNum -> IO ()) -> (BigNum -> IO ByteString) -> IO ByteString
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Integer -> IO BigNum
integerToBN Integer
v) (Ptr BIGNUM -> IO ()
_free (Ptr BIGNUM -> IO ()) -> (BigNum -> Ptr BIGNUM) -> BigNum -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BigNum -> Ptr BIGNUM
unwrapBN) BigNum -> IO ByteString
bnToMPI

-- | Convert an MPI to an Integer. See bnToMPI for the format
mpiToInteger :: BS.ByteString -> IO Integer
mpiToInteger :: ByteString -> IO Integer
mpiToInteger ByteString
mpi = do
  BigNum
bn <- ByteString -> IO BigNum
mpiToBN ByteString
mpi
  Integer
v <- BigNum -> IO Integer
bnToInteger BigNum
bn
  Ptr BIGNUM -> IO ()
_free (BigNum -> Ptr BIGNUM
unwrapBN BigNum
bn)
  Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
v

foreign import capi unsafe "openssl/bn.h BN_mod_exp"
        _mod_exp :: Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> BNCtx -> IO CInt

type BNCtx = Ptr BNCTX
data {-# CTYPE "openssl/bn.h" "BN_CTX" #-} BNCTX

foreign import capi unsafe "openssl/bn.h BN_CTX_new"
        _BN_ctx_new :: IO BNCtx

foreign import capi unsafe "openssl/bn.h BN_CTX_free"
        _BN_ctx_free :: BNCtx -> IO ()

withBNCtx :: (BNCtx -> IO a) -> IO a
withBNCtx :: forall a. (BNCtx -> IO a) -> IO a
withBNCtx BNCtx -> IO a
f = IO BNCtx -> (BNCtx -> IO ()) -> (BNCtx -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO BNCtx
_BN_ctx_new BNCtx -> IO ()
_BN_ctx_free BNCtx -> IO a
f

-- |@'modexp' a p m@ computes @a@ to the @p@-th power modulo @m@.
modexp :: Integer -> Integer -> Integer -> Integer
modexp :: Integer -> Integer -> Integer -> Integer
modexp Integer
a Integer
p Integer
m = IO Integer -> Integer
forall a. IO a -> a
unsafePerformIO (do
  Integer -> (BigNum -> IO Integer) -> IO Integer
forall a. Integer -> (BigNum -> IO a) -> IO a
withBN Integer
a (\BigNum
bnA -> (do
    Integer -> (BigNum -> IO Integer) -> IO Integer
forall a. Integer -> (BigNum -> IO a) -> IO a
withBN Integer
p (\BigNum
bnP -> (do
      Integer -> (BigNum -> IO Integer) -> IO Integer
forall a. Integer -> (BigNum -> IO a) -> IO a
withBN Integer
m (\BigNum
bnM -> (do
        (BNCtx -> IO Integer) -> IO Integer
forall a. (BNCtx -> IO a) -> IO a
withBNCtx (\BNCtx
ctx -> (do
          BigNum
r <- Integer -> IO BigNum
newBN Integer
0
          CInt
_ <- Ptr BIGNUM
-> Ptr BIGNUM -> Ptr BIGNUM -> Ptr BIGNUM -> BNCtx -> IO CInt
_mod_exp (BigNum -> Ptr BIGNUM
unwrapBN BigNum
r) (BigNum -> Ptr BIGNUM
unwrapBN BigNum
bnA) (BigNum -> Ptr BIGNUM
unwrapBN BigNum
bnP) (BigNum -> Ptr BIGNUM
unwrapBN BigNum
bnM) BNCtx
ctx
          BigNum -> IO Integer
bnToInteger BigNum
r IO Integer -> (Integer -> IO Integer) -> IO Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return)))))))))

{- Random Integer generation ------------------------------------------------ -}

foreign import capi unsafe "openssl/bn.h BN_rand_range"
        _BN_rand_range :: Ptr BIGNUM -> Ptr BIGNUM -> IO CInt

foreign import capi unsafe "openssl/bn.h BN_pseudo_rand_range"
        _BN_pseudo_rand_range :: Ptr BIGNUM -> Ptr BIGNUM -> IO CInt

-- | Return a strongly random number in the range 0 <= x < n where the given
--   filter function returns true.
randIntegerUptoNMinusOneSuchThat :: (Integer -> Bool)  -- ^ a filter function
                                 -> Integer  -- ^ one plus the upper limit
                                 -> IO Integer
randIntegerUptoNMinusOneSuchThat :: (Integer -> Bool) -> Integer -> IO Integer
randIntegerUptoNMinusOneSuchThat Integer -> Bool
f Integer
range = Integer -> (BigNum -> IO Integer) -> IO Integer
forall a. Integer -> (BigNum -> IO a) -> IO a
withBN Integer
range (\BigNum
bnRange -> (do
  BigNum
r <- Integer -> IO BigNum
newBN Integer
0
  let try :: IO Integer
try = do
        Ptr BIGNUM -> Ptr BIGNUM -> IO CInt
_BN_rand_range (BigNum -> Ptr BIGNUM
unwrapBN BigNum
r) (BigNum -> Ptr BIGNUM
unwrapBN BigNum
bnRange) IO CInt -> (CInt -> IO ()) -> IO ()
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)
        Integer
i <- BigNum -> IO Integer
bnToInteger BigNum
r
        if Integer -> Bool
f Integer
i
           then Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
i
           else IO Integer
try
  IO Integer
try))

-- | Return a random number in the range 0 <= x < n where the given
--   filter function returns true.
prandIntegerUptoNMinusOneSuchThat :: (Integer -> Bool)  -- ^ a filter function
                                  -> Integer  -- ^ one plus the upper limit
                                  -> IO Integer
prandIntegerUptoNMinusOneSuchThat :: (Integer -> Bool) -> Integer -> IO Integer
prandIntegerUptoNMinusOneSuchThat Integer -> Bool
f Integer
range = Integer -> (BigNum -> IO Integer) -> IO Integer
forall a. Integer -> (BigNum -> IO a) -> IO a
withBN Integer
range (\BigNum
bnRange -> (do
  BigNum
r <- Integer -> IO BigNum
newBN Integer
0
  let try :: IO Integer
try = do
        Ptr BIGNUM -> Ptr BIGNUM -> IO CInt
_BN_pseudo_rand_range (BigNum -> Ptr BIGNUM
unwrapBN BigNum
r) (BigNum -> Ptr BIGNUM
unwrapBN BigNum
bnRange) IO CInt -> (CInt -> IO ()) -> IO ()
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)
        Integer
i <- BigNum -> IO Integer
bnToInteger BigNum
r
        if Integer -> Bool
f Integer
i
           then Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
i
           else IO Integer
try
  IO Integer
try))

-- | Return a strongly random number in the range 0 <= x < n
randIntegerZeroToNMinusOne :: Integer -> IO Integer
randIntegerZeroToNMinusOne :: Integer -> IO Integer
randIntegerZeroToNMinusOne = (Integer -> Bool) -> Integer -> IO Integer
randIntegerUptoNMinusOneSuchThat (Bool -> Integer -> Bool
forall a b. a -> b -> a
const Bool
True)
-- | Return a strongly random number in the range 0 < x < n
randIntegerOneToNMinusOne :: Integer -> IO Integer
randIntegerOneToNMinusOne :: Integer -> IO Integer
randIntegerOneToNMinusOne = (Integer -> Bool) -> Integer -> IO Integer
randIntegerUptoNMinusOneSuchThat (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0)

-- | Return a random number in the range 0 <= x < n
prandIntegerZeroToNMinusOne :: Integer -> IO Integer
prandIntegerZeroToNMinusOne :: Integer -> IO Integer
prandIntegerZeroToNMinusOne = (Integer -> Bool) -> Integer -> IO Integer
prandIntegerUptoNMinusOneSuchThat (Bool -> Integer -> Bool
forall a b. a -> b -> a
const Bool
True)
-- | Return a random number in the range 0 < x < n
prandIntegerOneToNMinusOne :: Integer -> IO Integer
prandIntegerOneToNMinusOne :: Integer -> IO Integer
prandIntegerOneToNMinusOne = (Integer -> Bool) -> Integer -> IO Integer
prandIntegerUptoNMinusOneSuchThat (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0)