{-|
Module      : Botan.Low.MPI
Description : Multiple Precision Integers
Copyright   : (c) Leo D, 2023
License     : BSD-3-Clause
Maintainer  : 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 qualified Data.ByteString as ByteString

import Botan.Bindings.MPI

import Botan.Low.Error
import Botan.Low.Make
import Botan.Low.Prelude
import Botan.Low.Remake
import Botan.Low.RNG

-- 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
getMPForeignPtr :: ForeignPtr BotanMPStruct }

newMP      :: BotanMP -> IO MP
withMP     :: MP -> (BotanMP -> IO a) -> IO a
mpDestroy  :: MP -> IO ()
createMP   :: (Ptr BotanMP -> IO CInt) -> IO MP
(BotanMP -> IO MP
newMP, MP -> (BotanMP -> IO a) -> IO a
withMP, MP -> IO ()
mpDestroy, (Ptr BotanMP -> IO CInt) -> IO MP
createMP, (Ptr BotanMP -> Ptr CSize -> IO CInt) -> IO [MP]
_)
    = (Ptr BotanMPStruct -> BotanMP)
-> (BotanMP -> Ptr BotanMPStruct)
-> (ForeignPtr BotanMPStruct -> MP)
-> (MP -> ForeignPtr BotanMPStruct)
-> FinalizerPtr BotanMPStruct
-> (BotanMP -> IO MP, MP -> (BotanMP -> IO a) -> IO a, MP -> IO (),
    (Ptr BotanMP -> IO CInt) -> IO MP,
    (Ptr BotanMP -> Ptr CSize -> 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
-> (botan -> IO object, object -> (botan -> IO a) -> IO a,
    object -> IO (), (Ptr botan -> IO CInt) -> IO object,
    (Ptr botan -> Ptr CSize -> IO CInt) -> IO [object])
mkBindings
        Ptr BotanMPStruct -> BotanMP
MkBotanMP BotanMP -> Ptr BotanMPStruct
runBotanMP
        ForeignPtr BotanMPStruct -> MP
MkMP MP -> ForeignPtr BotanMPStruct
getMPForeignPtr
        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 BotanErrorCode

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 BotanErrorCode

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 BotanErrorCode

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 BotanErrorCode

-- 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 BotanErrorCode

-- 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