{-|
  Module      : OpenDHT.Internal.PrivateKey
  Description : Interna bindings for an OpenDHT PrivateKey
  Copyright   : (c) Simon Désaulniers, 2025
  License     : GPL-3

  Maintainer  : sim.desaulniers@gmail.com
-}

module OpenDHT.Internal.PrivateKey where

import Data.Functor
import qualified Data.ByteString as BS

import Control.Monad.IO.Class
import Control.Monad.Trans.Maybe

import Foreign.Ptr
import Foreign.C.Types
import Foreign.Marshal.Array

import OpenDHT.Types
import OpenDHT.Internal.Blob
import OpenDHT.Internal.PublicKey
import qualified OpenDHT.Internal.Crypto as Crypto

newtype CPrivateKey = CPrivateKey { CPrivateKey -> CPrivateKeyPtr
_privateKeyPtr :: CPrivateKeyPtr }
type CPrivateKeyPtr = Ptr ()

foreign import ccall "dht_privatekey_generate" dhtPrivatekeyGenerateC :: CUInt -> IO CPrivateKeyPtr

generate :: Int -> Dht CPrivateKey
generate :: Int -> Dht CPrivateKey
generate Int
len = IO CPrivateKey -> Dht CPrivateKey
forall a. IO a -> Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CPrivateKey -> Dht CPrivateKey)
-> IO CPrivateKey -> Dht CPrivateKey
forall a b. (a -> b) -> a -> b
$ CUInt -> IO CPrivateKeyPtr
dhtPrivatekeyGenerateC (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) IO CPrivateKeyPtr
-> (CPrivateKeyPtr -> CPrivateKey) -> IO CPrivateKey
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CPrivateKeyPtr -> CPrivateKey
CPrivateKey

foreign import ccall "dht_privatekey_import" dhtPrivatekeyImportC :: Ptr CUChar -> CUInt -> Ptr CChar -> IO CPrivateKeyPtr

fromBytes :: BS.ByteString -> String -> MaybeT Dht CPrivateKey
fromBytes :: ByteString -> String -> MaybeT Dht CPrivateKey
fromBytes ByteString
dataBs String
password = ByteString
-> Maybe String -> DataImportation () -> MaybeT Dht CPrivateKeyPtr
forall a.
ByteString
-> Maybe String -> DataImportation a -> MaybeT Dht (Ptr a)
Crypto.fromBytes ByteString
dataBs (String -> Maybe String
forall a. a -> Maybe a
Just String
password) DataImportation ()
privateKeyImport MaybeT Dht CPrivateKeyPtr
-> (CPrivateKeyPtr -> CPrivateKey) -> MaybeT Dht CPrivateKey
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CPrivateKeyPtr -> CPrivateKey
CPrivateKey
  where
    privateKeyImport :: DataImportation ()
privateKeyImport Ptr CUChar
dataPtr CUInt
cs (Just Ptr CChar
passPtr) = Ptr CUChar -> CUInt -> Ptr CChar -> IO CPrivateKeyPtr
dhtPrivatekeyImportC Ptr CUChar
dataPtr CUInt
cs Ptr CChar
passPtr
    privateKeyImport Ptr CUChar
_ CUInt
_ Maybe (Ptr CChar)
Nothing               = String -> IO CPrivateKeyPtr
forall a. HasCallStack => String -> a
error String
"PrivateKey.fromBytes: password should have been given."

foreign import ccall "dht_privatekey_export" dhtPrivatekeyExportC :: CPrivateKeyPtr -> Ptr CChar -> Ptr CUInt -> Ptr CChar-> IO CInt

export :: CPrivateKey -> String -> MaybeT Dht String
export :: CPrivateKey -> String -> MaybeT Dht String
export (CPrivateKey CPrivateKeyPtr
pPtr) String
password = CPrivateKeyPtr
-> Maybe String -> DataExportation () -> MaybeT Dht String
forall a.
Ptr a -> Maybe String -> DataExportation a -> MaybeT Dht String
Crypto.export CPrivateKeyPtr
pPtr (String -> Maybe String
forall a. a -> Maybe a
Just String
password) DataExportation ()
privateKeyExport
  where
    privateKeyExport :: DataExportation ()
privateKeyExport CPrivateKeyPtr
pPtr' Ptr CChar
bytesPtr Ptr CUInt
sPtr (Just Ptr CChar
passPtr) = CPrivateKeyPtr -> Ptr CChar -> Ptr CUInt -> Ptr CChar -> IO CInt
dhtPrivatekeyExportC CPrivateKeyPtr
pPtr' Ptr CChar
bytesPtr Ptr CUInt
sPtr Ptr CChar
passPtr
    privateKeyExport CPrivateKeyPtr
_ Ptr CChar
_ Ptr CUInt
_ Maybe (Ptr CChar)
Nothing                      = String -> IO CInt
forall a. HasCallStack => String -> a
error String
"PrivateKey.export: password should have been given."

foreign import ccall "dht_privatekey_get_publickey" dhtPrivatekeyGetPublickeyC :: CPrivateKeyPtr -> IO CPublicKeyPtr

getPublicKey :: CPrivateKey -> Dht CPublicKey
getPublicKey :: CPrivateKey -> Dht CPublicKey
getPublicKey (CPrivateKey CPrivateKeyPtr
pPtr) = IO CPublicKey -> Dht CPublicKey
forall a. IO a -> Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CPublicKey -> Dht CPublicKey)
-> IO CPublicKey -> Dht CPublicKey
forall a b. (a -> b) -> a -> b
$ CPrivateKeyPtr -> IO CPrivateKeyPtr
dhtPrivatekeyGetPublickeyC CPrivateKeyPtr
pPtr IO CPrivateKeyPtr
-> (CPrivateKeyPtr -> CPublicKey) -> IO CPublicKey
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CPrivateKeyPtr -> CPublicKey
CPublicKey

foreign import ccall "dht_privatekey_decrypt" dhtPrivatekeyDecryptC :: CPrivateKeyPtr -> Ptr CChar -> CUInt -> IO CBlobPtr

decrypt :: CPrivateKey -> BS.ByteString -> Dht BS.ByteString
decrypt :: CPrivateKey -> ByteString -> Dht ByteString
decrypt (CPrivateKey CPrivateKeyPtr
pPtr) ByteString
dataBs = IO CPrivateKeyPtr -> Dht CPrivateKeyPtr
forall a. IO a -> Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO CPrivateKeyPtr
decryptData Dht CPrivateKeyPtr
-> (CPrivateKeyPtr -> Dht ByteString) -> Dht ByteString
forall a b. Dht a -> (a -> Dht b) -> Dht b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CPrivateKeyPtr -> Dht ByteString
viewBlob
  where
    decryptData :: IO CPrivateKeyPtr
decryptData = Int -> (Ptr CChar -> IO CPrivateKeyPtr) -> IO CPrivateKeyPtr
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
s ((Ptr CChar -> IO CPrivateKeyPtr) -> IO CPrivateKeyPtr)
-> (Ptr CChar -> IO CPrivateKeyPtr) -> IO CPrivateKeyPtr
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
dataPtr -> CPrivateKeyPtr -> Ptr CChar -> CUInt -> IO CPrivateKeyPtr
dhtPrivatekeyDecryptC CPrivateKeyPtr
pPtr Ptr CChar
dataPtr CUInt
cs
    s :: Int
s           = ByteString -> Int
BS.length ByteString
dataBs
    cs :: CUInt
cs          = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s

foreign import ccall "dht_privatekey_delete" dhtPrivatekeyDeleteC :: CPrivateKeyPtr -> IO ()

delete :: CPrivateKey -> Dht ()
delete :: CPrivateKey -> Dht ()
delete = IO () -> Dht ()
forall a. IO a -> Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Dht ())
-> (CPrivateKey -> IO ()) -> CPrivateKey -> Dht ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CPrivateKeyPtr -> IO ()
dhtPrivatekeyDeleteC (CPrivateKeyPtr -> IO ())
-> (CPrivateKey -> CPrivateKeyPtr) -> CPrivateKey -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CPrivateKey -> CPrivateKeyPtr
_privateKeyPtr

--  vim: set sts=2 ts=2 sw=2 tw=120 et :