{-|
Module      : Botan.Low.MPI
Description : Multiple Precision Integers
Copyright   : (c) 2023-2024, Apotheca Labs
              (c) 2024-2025, Haskell Foundation
License     : BSD-3-Clause
Maintainer  : joris@well-typed.com, leo@apotheca.io
Stability   : experimental
Portability : POSIX
-}

module Botan.Low.MPI (

    MP(..)
  , withMP
  , mpInit
  , mpDestroy
  , mpToHex
  , mpToStr
  , mpClear
  , mpSetFromInt
  , mpSetFromMP
  , mpCopy
  , mpSetFromStr
  , mpSetFromRadixStr
  , mpNumBits
  , mpNumBytes
  , mpToBin
  , mpFromBin
  , mpToWord32
  , mpIsPositive
  , mpIsNegative
  , mpFlipSign
  , mpIsZero
  , mpAddWord32
  , mpSubWord32
  , mpAdd
  , mpSub
  , mpMul
  , mpDiv
  , mpModMul
  , mpEqual
  , mpCmp
  , mpSwap
  , mpPowMod
  , mpLeftShift
  , mpRightShift
  , mpModInverse
  , mpRandBits
  , mpRandRange
  , mpGCD
  , mpIsPrime
  , mpGetBit
  , mpSetBit
  , mpClearBit

  ) where

import           Botan.Bindings.ConstPtr (ConstPtr (..))
import           Botan.Bindings.MPI
import           Botan.Low.Error.Internal
import           Botan.Low.Internal.ByteString
import           Botan.Low.Make
import           Botan.Low.Remake
import           Botan.Low.RNG
import           Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import           Data.Word
import           Foreign.C.Types
import           Foreign.ForeignPtr
import           Foreign.Marshal.Alloc
import           Foreign.Ptr
import           Foreign.Storable

-- Yes, the module is named MPI, but the type is MP.
-- I'm probably renaming the module / type to `Botan.Integer` for ergonomics,
--  like I did with `Botan.RNG`.

-- NOTE: Operations have a different format here, compared to other botan objects.
--  Botan.Make does not apply very well.
--  MPI are rarely mutated, and usually take a destination argument instead.
--  As such, there are some mk- functions specific to MPI, and this module
--  will be greatly improved by idiomatic bindings wrappers

-- NOTE: This whole module is not idiomatic - some methods mutate, some have a destination argument
--  It will need furter wrapping.

newtype MP = MkMP { MP -> ForeignPtr BotanMPStruct
foreignPtr :: ForeignPtr BotanMPStruct }

withMP     :: MP -> (BotanMP -> IO a) -> IO a
mpDestroy  :: MP -> IO ()
createMP   :: (Ptr BotanMP -> IO CInt) -> IO MP
(MP -> (BotanMP -> IO a) -> IO a
withMP, MP -> IO ()
mpDestroy, (Ptr BotanMP -> IO CInt) -> IO MP
createMP)
    = (Ptr BotanMPStruct -> BotanMP)
-> (BotanMP -> Ptr BotanMPStruct)
-> (ForeignPtr BotanMPStruct -> MP)
-> (MP -> ForeignPtr BotanMPStruct)
-> FinalizerPtr BotanMPStruct
-> (MP -> (BotanMP -> IO a) -> IO a, MP -> IO (),
    (Ptr BotanMP -> IO CInt) -> IO MP)
forall botan struct object a.
Storable botan =>
(Ptr struct -> botan)
-> (botan -> Ptr struct)
-> (ForeignPtr struct -> object)
-> (object -> ForeignPtr struct)
-> FinalizerPtr struct
-> (object -> (botan -> IO a) -> IO a, object -> IO (),
    (Ptr botan -> IO CInt) -> IO object)
mkBindings
        Ptr BotanMPStruct -> BotanMP
MkBotanMP (.ptr)
        ForeignPtr BotanMPStruct -> MP
MkMP (.foreignPtr)
        FinalizerPtr BotanMPStruct
botan_mp_destroy

mpInit :: IO MP
-- mpInit = mkInit MkMP botan_mp_init botan_mp_destroy
mpInit :: IO MP
mpInit = (Ptr BotanMP -> IO CInt) -> IO MP
createMP Ptr BotanMP -> IO CInt
botan_mp_init

-- NOTE: The actual botan_mp_to_hex is misleading
--  The actual buffer size is 2 + (num_bytes * 2) + 1 bytes in length
--  The leading 2 is `0x` prefix, the trailing 1 is `\0` suffix
mpToHex :: MP -> IO ByteString
mpToHex :: MP -> IO ByteString
mpToHex MP
mp = MP -> (BotanMP -> IO ByteString) -> IO ByteString
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP MP
mp ((BotanMP -> IO ByteString) -> IO ByteString)
-> (BotanMP -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ BotanMP
mpPtr -> do
    Int
numBytes <- MP -> IO Int
mpNumBytes MP
mp
    Int -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
numBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
bytesPtr -> do
        HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ BotanMP -> Ptr CChar -> IO CInt
botan_mp_to_hex BotanMP
mpPtr Ptr CChar
bytesPtr
        Ptr CChar -> IO ByteString
ByteString.packCString Ptr CChar
bytesPtr

mpToStr :: MP -> Int -> IO ByteString
mpToStr :: MP -> Int -> IO ByteString
mpToStr MP
mp Int
base = MP -> (BotanMP -> IO ByteString) -> IO ByteString
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP MP
mp ((BotanMP -> IO ByteString) -> IO ByteString)
-> (BotanMP -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ BotanMP
mpPtr -> do
    (Ptr CChar -> Ptr CSize -> IO CInt) -> IO ByteString
forall byte. (Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString
allocBytesQueryingCString ((Ptr CChar -> Ptr CSize -> IO CInt) -> IO ByteString)
-> (Ptr CChar -> Ptr CSize -> IO CInt) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
bytesPtr Ptr CSize
szPtr ->
        BotanMP -> Word8 -> Ptr CChar -> Ptr CSize -> IO CInt
botan_mp_to_str BotanMP
mpPtr (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
base) Ptr CChar
bytesPtr Ptr CSize
szPtr

mpClear :: MP -> IO ()
mpClear :: MP -> IO ()
mpClear = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> Action BotanMP -> MP -> IO ()
forall typ ptr. WithPtr typ ptr -> Action ptr -> typ -> IO ()
mkAction MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP Action BotanMP
botan_mp_clear

mpSetFromInt :: MP -> Int -> IO ()
mpSetFromInt :: MP -> Int -> IO ()
mpSetFromInt = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> SetCInt BotanMP -> MP -> Int -> IO ()
forall typ ptr.
WithPtr typ ptr -> SetCInt ptr -> typ -> Int -> IO ()
mkSetCInt MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP SetCInt BotanMP
botan_mp_set_from_int

mpSetFromMP :: MP -> MP -> IO ()
mpSetFromMP :: MP -> MP -> IO ()
mpSetFromMP = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> UnaryOp BotanMP -> MP -> MP -> IO ()
forall typ ptr.
WithPtr typ ptr -> UnaryOp ptr -> typ -> typ -> IO ()
mkUnaryOp MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP UnaryOp BotanMP
botan_mp_set_from_mp

-- NOTE: Convenience function
mpCopy :: MP -> IO MP
mpCopy :: MP -> IO MP
mpCopy MP
mp = do
    MP
copy <- IO MP
mpInit
    MP -> MP -> IO ()
mpSetFromMP MP
copy MP
mp
    MP -> IO MP
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MP
copy

mpSetFromStr :: MP -> ByteString -> IO ()
mpSetFromStr :: MP -> ByteString -> IO ()
mpSetFromStr = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> (BotanMP -> Ptr CChar -> IO CInt) -> MP -> ByteString -> IO ()
forall typ ptr.
WithPtr typ ptr -> SetCString ptr -> typ -> ByteString -> IO ()
mkSetCString MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP (\ BotanMP
mp Ptr CChar
cstr -> BotanMP -> ConstPtr CChar -> IO CInt
botan_mp_set_from_str BotanMP
mp (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
cstr))

-- NOTE: According to unit tests, this function *does not* prepend "0x" to the value
mpSetFromRadixStr :: MP -> ByteString -> Int -> IO ()
mpSetFromRadixStr :: MP -> ByteString -> Int -> IO ()
mpSetFromRadixStr = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> SetCString_csize BotanMP -> MP -> ByteString -> Int -> IO ()
forall typ ptr.
WithPtr typ ptr
-> SetCString_csize ptr -> typ -> ByteString -> Int -> IO ()
mkSetCString_csize MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP (\ BotanMP
mp Ptr CChar
cstr CSize
radix -> BotanMP -> ConstPtr CChar -> CSize -> IO CInt
botan_mp_set_from_radix_str BotanMP
mp (Ptr CChar -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr CChar
cstr) CSize
radix)

mpNumBits :: MP -> IO Int
mpNumBits :: MP -> IO Int
mpNumBits = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> GetSize BotanMP -> MP -> IO Int
forall typ ptr. WithPtr typ ptr -> GetSize ptr -> typ -> IO Int
mkGetSize MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP GetSize BotanMP
botan_mp_num_bits

mpNumBytes :: MP -> IO Int
mpNumBytes :: MP -> IO Int
mpNumBytes = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> GetSize BotanMP -> MP -> IO Int
forall typ ptr. WithPtr typ ptr -> GetSize ptr -> typ -> IO Int
mkGetSize MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP GetSize BotanMP
botan_mp_num_bytes

mpToBin :: MP -> IO ByteString
mpToBin :: MP -> IO ByteString
mpToBin MP
mp = MP -> (BotanMP -> IO ByteString) -> IO ByteString
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP MP
mp ((BotanMP -> IO ByteString) -> IO ByteString)
-> (BotanMP -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ BotanMP
mpPtr -> do
    Int
numBytes <- MP -> IO Int
mpNumBytes MP
mp
    Int -> (Ptr Word8 -> IO ()) -> IO ByteString
forall byte. Int -> (Ptr byte -> IO ()) -> IO ByteString
allocBytes Int
numBytes ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
bytesPtr -> do
        HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ BotanMP -> Ptr Word8 -> IO CInt
botan_mp_to_bin BotanMP
mpPtr Ptr Word8
bytesPtr

-- NOTE: Awkward, more like mpSetFromBin
--  When we wrap it in higher level, fromBin should be :: ByteString -> IO Integer
mpFromBin :: MP -> ByteString -> IO ()
mpFromBin :: MP -> ByteString -> IO ()
mpFromBin = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> SetBytesLen BotanMP -> MP -> ByteString -> IO ()
forall typ ptr.
WithPtr typ ptr -> SetBytesLen ptr -> typ -> ByteString -> IO ()
mkSetBytesLen MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP (\ BotanMP
mp Ptr Word8
cbytes CSize
len -> BotanMP -> ConstPtr Word8 -> CSize -> IO CInt
botan_mp_from_bin BotanMP
mp (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
cbytes) CSize
len)

mpToWord32 :: MP -> IO Word32
mpToWord32 :: MP -> IO Word32
mpToWord32 MP
mp = MP -> (BotanMP -> IO Word32) -> IO Word32
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP MP
mp ((BotanMP -> IO Word32) -> IO Word32)
-> (BotanMP -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \ BotanMP
mpPtr -> do
    (Ptr Word32 -> IO Word32) -> IO Word32
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Word32 -> IO Word32) -> IO Word32)
-> (Ptr Word32 -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \ Ptr Word32
valPtr -> do
        HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ BotanMP -> Ptr Word32 -> IO CInt
botan_mp_to_uint32 BotanMP
mpPtr Ptr Word32
valPtr
        Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
valPtr

mpIsPositive :: MP -> IO Bool
mpIsPositive :: MP -> IO Bool
mpIsPositive = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> Action BotanMP -> MP -> IO Bool
forall typ ptr.
WithPtr typ ptr -> GetBoolCode ptr -> typ -> IO Bool
mkGetBoolCode MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP Action BotanMP
botan_mp_is_positive

mpIsNegative :: MP -> IO Bool
mpIsNegative :: MP -> IO Bool
mpIsNegative = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> Action BotanMP -> MP -> IO Bool
forall typ ptr.
WithPtr typ ptr -> GetBoolCode ptr -> typ -> IO Bool
mkGetBoolCode MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP Action BotanMP
botan_mp_is_negative

mpFlipSign :: MP -> IO ()
mpFlipSign :: MP -> IO ()
mpFlipSign = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> Action BotanMP -> MP -> IO ()
forall typ ptr. WithPtr typ ptr -> Action ptr -> typ -> IO ()
mkAction MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP Action BotanMP
botan_mp_flip_sign

mpIsZero :: MP -> IO Bool
mpIsZero :: MP -> IO Bool
mpIsZero = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> Action BotanMP -> MP -> IO Bool
forall typ ptr.
WithPtr typ ptr -> GetBoolCode ptr -> typ -> IO Bool
mkGetBoolCode MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP Action BotanMP
botan_mp_is_zero

mpAddWord32 :: MP -> MP -> Word32 -> IO ()
mpAddWord32 :: MP -> MP -> Word32 -> IO ()
mpAddWord32 MP
result MP
x Word32
y = MP -> (BotanMP -> IO ()) -> IO ()
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP MP
result ((BotanMP -> IO ()) -> IO ()) -> (BotanMP -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanMP
resultPtr -> do
    MP -> (BotanMP -> IO ()) -> IO ()
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP MP
x ((BotanMP -> IO ()) -> IO ()) -> (BotanMP -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanMP
xPtr -> do
        HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ BotanMP -> BotanMP -> Word32 -> IO CInt
botan_mp_add_u32 BotanMP
resultPtr BotanMP
xPtr Word32
y

mpSubWord32 :: MP -> MP -> Word32 -> IO ()
mpSubWord32 :: MP -> MP -> Word32 -> IO ()
mpSubWord32 MP
result MP
x Word32
y = MP -> (BotanMP -> IO ()) -> IO ()
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP MP
result ((BotanMP -> IO ()) -> IO ()) -> (BotanMP -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanMP
resultPtr -> do
    MP -> (BotanMP -> IO ()) -> IO ()
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP MP
x ((BotanMP -> IO ()) -> IO ()) -> (BotanMP -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanMP
xPtr -> do
        HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ BotanMP -> BotanMP -> Word32 -> IO CInt
botan_mp_sub_u32 BotanMP
resultPtr BotanMP
xPtr Word32
y

mpAdd :: MP -> MP -> MP -> IO ()
mpAdd :: MP -> MP -> MP -> IO ()
mpAdd = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> BinaryOp BotanMP -> MP -> MP -> MP -> IO ()
forall typ ptr.
WithPtr typ ptr -> BinaryOp ptr -> typ -> typ -> typ -> IO ()
mkBinaryOp MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP BinaryOp BotanMP
botan_mp_add

mpSub :: MP -> MP -> MP -> IO ()
mpSub :: MP -> MP -> MP -> IO ()
mpSub = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> BinaryOp BotanMP -> MP -> MP -> MP -> IO ()
forall typ ptr.
WithPtr typ ptr -> BinaryOp ptr -> typ -> typ -> typ -> IO ()
mkBinaryOp MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP BinaryOp BotanMP
botan_mp_sub

mpMul :: MP -> MP -> MP -> IO ()
mpMul :: MP -> MP -> MP -> IO ()
mpMul = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> BinaryOp BotanMP -> MP -> MP -> MP -> IO ()
forall typ ptr.
WithPtr typ ptr -> BinaryOp ptr -> typ -> typ -> typ -> IO ()
mkBinaryOp MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP BinaryOp BotanMP
botan_mp_mul

mpDiv :: MP -> MP -> MP -> MP -> IO ()
mpDiv :: MP -> MP -> MP -> MP -> IO ()
mpDiv = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> BinaryDuplexOp BotanMP -> MP -> MP -> MP -> MP -> IO ()
forall typ ptr.
WithPtr typ ptr
-> BinaryDuplexOp ptr -> typ -> typ -> typ -> typ -> IO ()
mkBinaryDuplexOp MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP BinaryDuplexOp BotanMP
botan_mp_div

mpModMul :: MP -> MP -> MP -> MP -> IO ()
mpModMul :: MP -> MP -> MP -> MP -> IO ()
mpModMul = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> BinaryDuplexOp BotanMP -> MP -> MP -> MP -> MP -> IO ()
forall typ ptr.
WithPtr typ ptr
-> BinaryDuplexOp ptr -> typ -> typ -> typ -> typ -> IO ()
mkTrinaryOp MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP BinaryDuplexOp BotanMP
botan_mp_mod_mul

-- NOTE: Cannot use mkGetBoolCode unless
mpEqual :: MP -> MP -> IO Bool
mpEqual :: MP -> MP -> IO Bool
mpEqual MP
a MP
b = MP -> (BotanMP -> IO Bool) -> IO Bool
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP MP
a ((BotanMP -> IO Bool) -> IO Bool)
-> (BotanMP -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ BotanMP
aPtr -> do
    MP -> (BotanMP -> IO Bool) -> IO Bool
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP MP
b ((BotanMP -> IO Bool) -> IO Bool)
-> (BotanMP -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ BotanMP
bPtr -> do
        HasCallStack => IO CInt -> IO Bool
IO CInt -> IO Bool
throwBotanCatchingBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$ UnaryOp BotanMP
botan_mp_equal BotanMP
aPtr BotanMP
bPtr

-- TODO: Convert Int to Ordering in >1:1 low-level bindings
mpCmp :: MP -> MP -> IO Int
mpCmp :: MP -> MP -> IO Int
mpCmp MP
a MP
b = MP -> (BotanMP -> IO Int) -> IO Int
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP MP
a ((BotanMP -> IO Int) -> IO Int) -> (BotanMP -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ BotanMP
aPtr -> do
    MP -> (BotanMP -> IO Int) -> IO Int
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP MP
b ((BotanMP -> IO Int) -> IO Int) -> (BotanMP -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ BotanMP
bPtr -> do
        (Ptr CInt -> IO Int) -> IO Int
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Int) -> IO Int) -> (Ptr CInt -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ Ptr CInt
resultPtr -> do
            HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CInt -> UnaryOp BotanMP
botan_mp_cmp Ptr CInt
resultPtr BotanMP
aPtr BotanMP
bPtr
            CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
resultPtr

mpSwap :: MP -> MP -> IO ()
mpSwap :: MP -> MP -> IO ()
mpSwap MP
a MP
b = MP -> (BotanMP -> IO ()) -> IO ()
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP MP
a ((BotanMP -> IO ()) -> IO ()) -> (BotanMP -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanMP
aPtr -> do
    MP -> (BotanMP -> IO ()) -> IO ()
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP MP
b ((BotanMP -> IO ()) -> IO ()) -> (BotanMP -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanMP
bPtr -> do
        HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ UnaryOp BotanMP
botan_mp_swap BotanMP
aPtr BotanMP
bPtr

mpPowMod :: MP -> MP -> MP -> MP -> IO ()
mpPowMod :: MP -> MP -> MP -> MP -> IO ()
mpPowMod = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> BinaryDuplexOp BotanMP -> MP -> MP -> MP -> MP -> IO ()
forall typ ptr.
WithPtr typ ptr
-> BinaryDuplexOp ptr -> typ -> typ -> typ -> typ -> IO ()
mkTrinaryOp MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP BinaryDuplexOp BotanMP
botan_mp_powmod

mpLeftShift :: MP -> MP -> Int -> IO ()
mpLeftShift :: MP -> MP -> Int -> IO ()
mpLeftShift = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> UnaryOp_csize BotanMP -> MP -> MP -> Int -> IO ()
forall typ ptr.
WithPtr typ ptr -> UnaryOp_csize ptr -> typ -> typ -> Int -> IO ()
mkUnaryOp_csize MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP UnaryOp_csize BotanMP
botan_mp_lshift

mpRightShift :: MP -> MP -> Int -> IO ()
mpRightShift :: MP -> MP -> Int -> IO ()
mpRightShift = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> UnaryOp_csize BotanMP -> MP -> MP -> Int -> IO ()
forall typ ptr.
WithPtr typ ptr -> UnaryOp_csize ptr -> typ -> typ -> Int -> IO ()
mkUnaryOp_csize MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP UnaryOp_csize BotanMP
botan_mp_rshift

mpModInverse :: MP -> MP -> MP -> IO ()
mpModInverse :: MP -> MP -> MP -> IO ()
mpModInverse = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> BinaryOp BotanMP -> MP -> MP -> MP -> IO ()
forall typ ptr.
WithPtr typ ptr -> BinaryOp ptr -> typ -> typ -> typ -> IO ()
mkBinaryOp MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP BinaryOp BotanMP
botan_mp_mod_inverse

mpRandBits :: MP -> RNG -> Int -> IO ()
mpRandBits :: MP -> RNG -> Int -> IO ()
mpRandBits MP
mp RNG
rng Int
sz = MP -> (BotanMP -> IO ()) -> IO ()
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP MP
mp ((BotanMP -> IO ()) -> IO ()) -> (BotanMP -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanMP
mpPtr -> do
   RNG -> (BotanRNG -> IO ()) -> IO ()
forall a. RNG -> (BotanRNG -> IO a) -> IO a
withRNG RNG
rng ((BotanRNG -> IO ()) -> IO ()) -> (BotanRNG -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanRNG
botanRNG -> do
        HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ BotanMP -> BotanRNG -> CSize -> IO CInt
botan_mp_rand_bits BotanMP
mpPtr BotanRNG
botanRNG (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)

-- NOTE: Never includes upper bound
mpRandRange :: MP -> RNG -> MP -> MP -> IO ()
mpRandRange :: MP -> RNG -> MP -> MP -> IO ()
mpRandRange MP
mp RNG
rng MP
lower MP
upper = MP -> (BotanMP -> IO ()) -> IO ()
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP MP
mp ((BotanMP -> IO ()) -> IO ()) -> (BotanMP -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanMP
mpPtr -> do
   RNG -> (BotanRNG -> IO ()) -> IO ()
forall a. RNG -> (BotanRNG -> IO a) -> IO a
withRNG RNG
rng ((BotanRNG -> IO ()) -> IO ()) -> (BotanRNG -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanRNG
botanRNG -> do
        MP -> (BotanMP -> IO ()) -> IO ()
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP MP
lower ((BotanMP -> IO ()) -> IO ()) -> (BotanMP -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanMP
lowerPtr -> do
            MP -> (BotanMP -> IO ()) -> IO ()
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP MP
upper ((BotanMP -> IO ()) -> IO ()) -> (BotanMP -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanMP
upperPtr -> do
                HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ BotanMP -> BotanRNG -> UnaryOp BotanMP
botan_mp_rand_range BotanMP
mpPtr BotanRNG
botanRNG BotanMP
lowerPtr BotanMP
upperPtr

mpGCD :: MP -> MP -> MP -> IO ()
mpGCD :: MP -> MP -> MP -> IO ()
mpGCD = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> BinaryOp BotanMP -> MP -> MP -> MP -> IO ()
forall typ ptr.
WithPtr typ ptr -> BinaryOp ptr -> typ -> typ -> typ -> IO ()
mkBinaryOp MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP BinaryOp BotanMP
botan_mp_gcd

-- NOTE: Miller–Rabin primality test
mpIsPrime :: MP -> RNG -> Int -> IO Bool
mpIsPrime :: MP -> RNG -> Int -> IO Bool
mpIsPrime MP
mp RNG
rng Int
probability = MP -> (BotanMP -> IO Bool) -> IO Bool
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP MP
mp ((BotanMP -> IO Bool) -> IO Bool)
-> (BotanMP -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ BotanMP
mpPtr -> do
    RNG -> (BotanRNG -> IO Bool) -> IO Bool
forall a. RNG -> (BotanRNG -> IO a) -> IO a
withRNG RNG
rng ((BotanRNG -> IO Bool) -> IO Bool)
-> (BotanRNG -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ BotanRNG
botanRNG -> do
        HasCallStack => IO CInt -> IO Bool
IO CInt -> IO Bool
throwBotanCatchingBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$ BotanMP -> BotanRNG -> CSize -> IO CInt
botan_mp_is_prime BotanMP
mpPtr BotanRNG
botanRNG (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
probability)

mpGetBit :: MP -> Int -> IO Bool
mpGetBit :: MP -> Int -> IO Bool
mpGetBit = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> GetBoolCode_csize BotanMP -> MP -> Int -> IO Bool
forall typ ptr.
WithPtr typ ptr -> GetBoolCode_csize ptr -> typ -> Int -> IO Bool
mkGetBoolCode_csize MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP GetBoolCode_csize BotanMP
botan_mp_get_bit

mpSetBit :: MP -> Int -> IO ()
mpSetBit :: MP -> Int -> IO ()
mpSetBit = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> GetBoolCode_csize BotanMP -> MP -> Int -> IO ()
forall typ ptr.
WithPtr typ ptr -> SetCSize ptr -> typ -> Int -> IO ()
mkSetCSize MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP GetBoolCode_csize BotanMP
botan_mp_set_bit

mpClearBit :: MP -> Int -> IO ()
mpClearBit :: MP -> Int -> IO ()
mpClearBit = (forall a. MP -> (BotanMP -> IO a) -> IO a)
-> GetBoolCode_csize BotanMP -> MP -> Int -> IO ()
forall typ ptr.
WithPtr typ ptr -> SetCSize ptr -> typ -> Int -> IO ()
mkSetCSize MP -> (BotanMP -> IO a) -> IO a
forall a. MP -> (BotanMP -> IO a) -> IO a
withMP GetBoolCode_csize BotanMP
botan_mp_clear_bit

--
-- Helpers
--

-- int botan_...(botan_mp_t dest, const botan_mp_t source);
type UnaryOp ptr = ptr -> ptr -> IO CInt

mkUnaryOp :: WithPtr typ ptr -> UnaryOp ptr -> typ -> typ -> IO ()
mkUnaryOp :: forall typ ptr.
WithPtr typ ptr -> UnaryOp ptr -> typ -> typ -> IO ()
mkUnaryOp WithPtr typ ptr
withPtr UnaryOp ptr
unary typ
dest typ
source = typ -> (ptr -> IO ()) -> IO ()
WithPtr typ ptr
withPtr typ
dest ((ptr -> IO ()) -> IO ()) -> (ptr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ ptr
destPtr -> do
    typ -> (ptr -> IO ()) -> IO ()
WithPtr typ ptr
withPtr typ
source ((ptr -> IO ()) -> IO ()) -> (ptr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ ptr
sourcePtr -> do
        HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ UnaryOp ptr
unary ptr
destPtr ptr
sourcePtr

-- int botan_...(botan_mp_t dest, const botan_mp_t source, size_t factor);
type UnaryOp_csize ptr = ptr -> ptr -> CSize -> IO CInt

mkUnaryOp_csize :: WithPtr typ ptr -> UnaryOp_csize ptr -> typ -> typ -> Int -> IO ()
mkUnaryOp_csize :: forall typ ptr.
WithPtr typ ptr -> UnaryOp_csize ptr -> typ -> typ -> Int -> IO ()
mkUnaryOp_csize WithPtr typ ptr
withPtr UnaryOp_csize ptr
unary typ
dest typ
source Int
factor  = typ -> (ptr -> IO ()) -> IO ()
WithPtr typ ptr
withPtr typ
dest ((ptr -> IO ()) -> IO ()) -> (ptr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ ptr
destPtr -> do
    typ -> (ptr -> IO ()) -> IO ()
WithPtr typ ptr
withPtr typ
source ((ptr -> IO ()) -> IO ()) -> (ptr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ ptr
sourcePtr -> do
        HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ UnaryOp_csize ptr
unary ptr
destPtr ptr
sourcePtr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
factor)

-- int botan_...(botan_mp_t dest, const botan_mp_t a, const botan_mp_t b);
type BinaryOp ptr = ptr -> ptr -> ptr -> IO CInt

mkBinaryOp :: WithPtr typ ptr -> BinaryOp ptr -> typ -> typ -> typ -> IO ()
mkBinaryOp :: forall typ ptr.
WithPtr typ ptr -> BinaryOp ptr -> typ -> typ -> typ -> IO ()
mkBinaryOp WithPtr typ ptr
withPtr BinaryOp ptr
binary typ
dest typ
a typ
b = typ -> (ptr -> IO ()) -> IO ()
WithPtr typ ptr
withPtr typ
dest ((ptr -> IO ()) -> IO ()) -> (ptr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ ptr
destPtr -> do
    typ -> (ptr -> IO ()) -> IO ()
WithPtr typ ptr
withPtr typ
a ((ptr -> IO ()) -> IO ()) -> (ptr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ ptr
aPtr -> do
        typ -> (ptr -> IO ()) -> IO ()
WithPtr typ ptr
withPtr typ
b ((ptr -> IO ()) -> IO ()) -> (ptr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ ptr
bPtr -> do
            HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ BinaryOp ptr
binary ptr
destPtr ptr
aPtr ptr
bPtr

-- int botan_...(botan_mp_t a, botan_mp_t b, const botan_mp_t x, const botan_mp_t y);
type BinaryDuplexOp ptr = ptr -> ptr -> ptr -> ptr -> IO CInt

-- NOTE: Do not confuse for mkTrinaryOp
mkBinaryDuplexOp :: WithPtr typ ptr -> BinaryDuplexOp ptr -> typ -> typ -> typ -> typ -> IO ()
mkBinaryDuplexOp :: forall typ ptr.
WithPtr typ ptr
-> BinaryDuplexOp ptr -> typ -> typ -> typ -> typ -> IO ()
mkBinaryDuplexOp WithPtr typ ptr
withPtr BinaryDuplexOp ptr
binary typ
a typ
b typ
x typ
y = typ -> (ptr -> IO ()) -> IO ()
WithPtr typ ptr
withPtr typ
a ((ptr -> IO ()) -> IO ()) -> (ptr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ ptr
aPtr -> do
    typ -> (ptr -> IO ()) -> IO ()
WithPtr typ ptr
withPtr typ
b ((ptr -> IO ()) -> IO ()) -> (ptr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ ptr
bPtr -> do
        typ -> (ptr -> IO ()) -> IO ()
WithPtr typ ptr
withPtr typ
x ((ptr -> IO ()) -> IO ()) -> (ptr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ ptr
xPtr -> do
            typ -> (ptr -> IO ()) -> IO ()
WithPtr typ ptr
withPtr typ
y ((ptr -> IO ()) -> IO ()) -> (ptr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ ptr
yPtr -> do
                HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ BinaryDuplexOp ptr
binary ptr
aPtr ptr
bPtr ptr
xPtr ptr
yPtr

-- int botan_...(botan_mp_t a, botan_mp_t b, const botan_mp_t x, const botan_mp_t y);
type TrinaryOp ptr = ptr -> ptr -> ptr -> ptr -> IO CInt

-- NOTE: Do not confuse for mkBinaryDuplexOp
mkTrinaryOp :: WithPtr typ ptr -> TrinaryOp ptr -> typ -> typ -> typ -> typ -> IO ()
mkTrinaryOp :: forall typ ptr.
WithPtr typ ptr
-> BinaryDuplexOp ptr -> typ -> typ -> typ -> typ -> IO ()
mkTrinaryOp WithPtr typ ptr
withPtr TrinaryOp ptr
binary typ
a typ
x typ
y typ
z = typ -> (ptr -> IO ()) -> IO ()
WithPtr typ ptr
withPtr typ
a ((ptr -> IO ()) -> IO ()) -> (ptr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ ptr
aPtr -> do
    typ -> (ptr -> IO ()) -> IO ()
WithPtr typ ptr
withPtr typ
x ((ptr -> IO ()) -> IO ()) -> (ptr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ ptr
xPtr -> do
        typ -> (ptr -> IO ()) -> IO ()
WithPtr typ ptr
withPtr typ
y ((ptr -> IO ()) -> IO ()) -> (ptr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ ptr
yPtr -> do
            typ -> (ptr -> IO ()) -> IO ()
WithPtr typ ptr
withPtr typ
z ((ptr -> IO ()) -> IO ()) -> (ptr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ ptr
zPtr -> do
                HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ TrinaryOp ptr
binary ptr
aPtr ptr
xPtr ptr
yPtr ptr
zPtr