-- GENERATED by C->Haskell Compiler, version 0.28.8 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/OpenDHT/Internal/PublicKey.chs" #-}

{-|
  Module      : OpenDHT.Internal.PublicKey
  Description : Internal definitions for PublicKey.
  Copyright   : (c) Simon Désaulniers, 2025
  License     : GPL-3

  Maintainer  : sim.desaulniers@gmail.com
-}

module OpenDHT.Internal.PublicKey where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Array as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Data.Functor
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BSI

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

import Foreign.Ptr
import Foreign.C.Types
import Foreign.C.String
import Foreign.Marshal.Array
import Foreign.Marshal.Utils
import Foreign.Marshal.Alloc
import Foreign.Storable

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



data CPublicKey    = CPublicKey { CPublicKey -> CPublicKeyPtr
_publicKeyPtr :: CPublicKeyPtr }
type CPublicKeyPtr = Ptr ()

newtype PKId  = PKId  { PKId -> String
_pkIdString  :: String }
newtype CPKId = CPKId { _pkIdDataPtr :: Ptr CUChar }

type CPKIdPtr = C2HSImp.Ptr (CPKId)
{-# LINE 41 "src/OpenDHT/Internal/PublicKey.chs" #-}


instance Storable CPKId where
    sizeOf _            = 32
{-# LINE 44 "src/OpenDHT/Internal/PublicKey.chs" #-}

    alignment _         = 1
{-# LINE 45 "src/OpenDHT/Internal/PublicKey.chs" #-}

    poke p (CPKId cPtr) = (\ptr val -> do {C2HSImp.copyArray (ptr `C2HSImp.plusPtr` 0) (val :: (C2HSImp.Ptr C2HSImp.CUChar)) 32}) p cPtr
    peek p              = CPKId <$> (\ptr -> do {return $ ptr `C2HSImp.plusPtr` 0 :: IO (C2HSImp.Ptr C2HSImp.CUChar)}) p

pkIdLen :: Int
pkIdLen :: Int
pkIdLen = Int
32

foreign import ccall "dht_pkid_print" dhtPkidPrintC :: CPKIdPtr -> IO (Ptr CChar)

pkIdPtrToString :: CPKIdPtr -> IO String
pkIdPtrToString :: Ptr CPKId -> IO String
pkIdPtrToString Ptr CPKId
pkidPtr = Ptr CPKId -> IO (Ptr CChar)
dhtPkidPrintC Ptr CPKId
pkidPtr IO (Ptr CChar) -> (Ptr CChar -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr CChar -> IO String
peekCString

emptyPkIdWordArray :: [CUChar]
emptyPkIdWordArray :: [CUChar]
emptyPkIdWordArray = Int -> CUChar -> [CUChar]
forall a. Int -> a -> [a]
replicate Int
pkIdLen (Char -> CUChar
castCharToCUChar Char
'0')

withCPKId :: (Ptr CPKId -> IO b) -> IO b
withCPKId :: forall b. (Ptr CPKId -> IO b) -> IO b
withCPKId Ptr CPKId -> IO b
f = [CUChar] -> (Ptr CUChar -> IO b) -> IO b
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [CUChar]
emptyPkIdWordArray ((Ptr CUChar -> IO b) -> IO b) -> (Ptr CUChar -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \ Ptr CUChar
cucharPtr -> CPKId -> (Ptr CPKId -> IO b) -> IO b
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Ptr CUChar -> CPKId
CPKId Ptr CUChar
cucharPtr) Ptr CPKId -> IO b
f

foreign import ccall "dht_publickey_import" dhtPublickeyImportC :: Ptr CUChar -> CUInt -> IO CPublicKeyPtr

fromBytes :: BS.ByteString -> MaybeT Dht CPublicKey
fromBytes :: ByteString -> MaybeT Dht CPublicKey
fromBytes ByteString
dataBs = ByteString
-> Maybe String -> DataImportation () -> MaybeT Dht CPublicKeyPtr
forall a.
ByteString
-> Maybe String -> DataImportation a -> MaybeT Dht (Ptr a)
Crypto.fromBytes ByteString
dataBs Maybe String
forall a. Maybe a
Nothing DataImportation ()
forall {p}. Ptr CUChar -> CUInt -> p -> IO CPublicKeyPtr
publicKeyImport MaybeT Dht CPublicKeyPtr
-> (CPublicKeyPtr -> CPublicKey) -> MaybeT Dht CPublicKey
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CPublicKeyPtr -> CPublicKey
CPublicKey
  where
    publicKeyImport :: Ptr CUChar -> CUInt -> p -> IO CPublicKeyPtr
publicKeyImport Ptr CUChar
dataPtr CUInt
cs p
_ = Ptr CUChar -> CUInt -> IO CPublicKeyPtr
dhtPublickeyImportC Ptr CUChar
dataPtr CUInt
cs

foreign import ccall "dht_publickey_delete" dhtPublickeyDeleteC :: CPublicKeyPtr -> IO ()

delete :: CPublicKey -> Dht ()
delete :: CPublicKey -> Dht ()
delete = IO () -> Dht ()
forall a. IO a -> Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Dht ()) -> (CPublicKey -> IO ()) -> CPublicKey -> Dht ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CPublicKeyPtr -> IO ()
dhtPublickeyDeleteC (CPublicKeyPtr -> IO ())
-> (CPublicKey -> CPublicKeyPtr) -> CPublicKey -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CPublicKey -> CPublicKeyPtr
_publicKeyPtr

foreign import ccall "dht_publickey_export" dhtPublickeyExportC :: CPublicKeyPtr -> Ptr CChar -> Ptr CUInt -> IO CInt

export :: CPublicKey -> MaybeT Dht String
export :: CPublicKey -> MaybeT Dht String
export (CPublicKey CPublicKeyPtr
pPtr) = CPublicKeyPtr
-> Maybe String -> DataExportation () -> MaybeT Dht String
forall a.
Ptr a -> Maybe String -> DataExportation a -> MaybeT Dht String
Crypto.export CPublicKeyPtr
pPtr Maybe String
forall a. Maybe a
Nothing DataExportation ()
forall {p}. CPublicKeyPtr -> Ptr CChar -> Ptr CUInt -> p -> IO CInt
publicKeyExport
  where
    publicKeyExport :: CPublicKeyPtr -> Ptr CChar -> Ptr CUInt -> p -> IO CInt
publicKeyExport CPublicKeyPtr
pPtr' Ptr CChar
bytesPtr Ptr CUInt
sPtr p
_ = CPublicKeyPtr -> Ptr CChar -> Ptr CUInt -> IO CInt
dhtPublickeyExportC CPublicKeyPtr
pPtr' Ptr CChar
bytesPtr Ptr CUInt
sPtr

foreign import ccall "wr_dht_publickey_get_id" dhtPublickeyGetIdC :: CPublicKeyPtr -> CInfoHashPtr -> IO ()

idFromPublicKey :: CPublicKey -> Dht InfoHash
idFromPublicKey :: CPublicKey -> Dht InfoHash
idFromPublicKey (CPublicKey CPublicKeyPtr
cPtr) = IO String -> Dht String
forall a. IO a -> Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((Ptr CInfoHash -> IO String) -> IO String
forall b. (Ptr CInfoHash -> IO b) -> IO b
withCInfohash Ptr CInfoHash -> IO String
strFromInfoHash) Dht String -> (String -> InfoHash) -> Dht InfoHash
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> InfoHash
InfoHash
  where strFromInfoHash :: Ptr CInfoHash -> IO String
strFromInfoHash Ptr CInfoHash
hPtr = do
          CPublicKeyPtr -> Ptr CInfoHash -> IO ()
dhtPublickeyGetIdC CPublicKeyPtr
cPtr Ptr CInfoHash
hPtr
          Ptr CInfoHash -> IO String
infoHashToString Ptr CInfoHash
hPtr

foreign import ccall "wr_dht_publickey_get_long_id" dhtPublickeyGetLongIdC :: CPublicKeyPtr -> CPKIdPtr -> IO ()

pkIdFromPublicKey :: CPublicKey -> Dht PKId
pkIdFromPublicKey :: CPublicKey -> Dht PKId
pkIdFromPublicKey (CPublicKey CPublicKeyPtr
cPtr) = IO String -> Dht String
forall a. IO a -> Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((Ptr CPKId -> IO String) -> IO String
forall b. (Ptr CPKId -> IO b) -> IO b
withCPKId Ptr CPKId -> IO String
strFromPkId) Dht String -> (String -> PKId) -> Dht PKId
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> PKId
PKId
  where strFromPkId :: Ptr CPKId -> IO String
strFromPkId Ptr CPKId
pkidPtr = do
          CPublicKeyPtr -> Ptr CPKId -> IO ()
dhtPublickeyGetLongIdC CPublicKeyPtr
cPtr Ptr CPKId
pkidPtr
          Ptr CPKId -> IO String
pkIdPtrToString Ptr CPKId
pkidPtr

foreign import ccall "dht_publickey_check_signature"
  dhtPublickeyCheckSignatureC :: CPublicKeyPtr -> Ptr CChar -> CUInt -> Ptr CChar -> CUInt -> IO CBool

checkSignature :: CPublicKey -> BS.ByteString -> BS.ByteString -> Dht Bool
checkSignature :: CPublicKey -> ByteString -> ByteString -> Dht Bool
checkSignature (CPublicKey CPublicKeyPtr
pPtr) ByteString
dataBs ByteString
sigBs = IO Bool -> Dht Bool
forall a. IO a -> Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Dht Bool) -> IO Bool -> Dht Bool
forall a b. (a -> b) -> a -> b
$ (Ptr CChar -> Ptr CChar -> IO Bool) -> IO Bool
forall {b}. (Ptr CChar -> Ptr CChar -> IO b) -> IO b
withArrays Ptr CChar -> Ptr CChar -> IO Bool
check
  where
    check :: Ptr CChar -> Ptr CChar -> IO Bool
check Ptr CChar
dataPtr Ptr CChar
sigPtr = CPublicKeyPtr
-> Ptr CChar -> CUInt -> Ptr CChar -> CUInt -> IO CBool
dhtPublickeyCheckSignatureC CPublicKeyPtr
pPtr Ptr CChar
dataPtr CUInt
dataSize Ptr CChar
sigPtr CUInt
sigSize IO CBool -> (CBool -> Bool) -> IO Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool
    withArrays :: (Ptr CChar -> Ptr CChar -> IO b) -> IO b
withArrays Ptr CChar -> Ptr CChar -> IO b
f         = [CChar] -> (Ptr CChar -> IO b) -> IO b
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [CChar]
dataArray ((Ptr CChar -> IO b) -> IO b) -> (Ptr CChar -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
dataPtr -> [CChar] -> (Ptr CChar -> IO b) -> IO b
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [CChar]
sigArray (Ptr CChar -> Ptr CChar -> IO b
f Ptr CChar
dataPtr)
    dataArray :: [CChar]
dataArray            = (Word8 -> CChar) -> [Word8] -> [CChar]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> CChar
castCharToCChar (Char -> CChar) -> (Word8 -> Char) -> Word8 -> CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
BSI.w2c) ([Word8] -> [CChar]) -> [Word8] -> [CChar]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack ByteString
dataBs
    sigArray :: [CChar]
sigArray             = (Word8 -> CChar) -> [Word8] -> [CChar]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> CChar
castCharToCChar (Char -> CChar) -> (Word8 -> Char) -> Word8 -> CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
BSI.w2c) ([Word8] -> [CChar]) -> [Word8] -> [CChar]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack ByteString
sigBs
    dataSize :: CUInt
dataSize             = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ [CChar] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CChar]
dataArray
    sigSize :: CUInt
sigSize              = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ [CChar] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CChar]
sigArray

foreign import ccall "dht_publickey_encrypt" dhtPublickeyEncryptC :: CPublicKeyPtr -> Ptr CChar -> CUInt -> IO CBlobPtr

encrypt :: CPublicKey -> BS.ByteString -> Dht BS.ByteString
encrypt :: CPublicKey -> ByteString -> Dht ByteString
encrypt (CPublicKey CPublicKeyPtr
pPtr) ByteString
dataBs = do
  let
    dataArray :: [CChar]
dataArray = (Word8 -> CChar) -> [Word8] -> [CChar]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> CChar
castCharToCChar (Char -> CChar) -> (Word8 -> Char) -> Word8 -> CChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
BSI.w2c) ([Word8] -> [CChar]) -> [Word8] -> [CChar]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack ByteString
dataBs
    dataSize :: CUInt
dataSize  = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ [CChar] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CChar]
dataArray
  CPublicKeyPtr
blobPtr        <- IO CPublicKeyPtr -> Dht CPublicKeyPtr
forall a. IO a -> Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CPublicKeyPtr -> Dht CPublicKeyPtr)
-> IO CPublicKeyPtr -> Dht CPublicKeyPtr
forall a b. (a -> b) -> a -> b
$ [CChar] -> (Ptr CChar -> IO CPublicKeyPtr) -> IO CPublicKeyPtr
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [CChar]
dataArray ((Ptr CChar -> IO CPublicKeyPtr) -> IO CPublicKeyPtr)
-> (Ptr CChar -> IO CPublicKeyPtr) -> IO CPublicKeyPtr
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
dataPtr -> CPublicKeyPtr -> Ptr CChar -> CUInt -> IO CPublicKeyPtr
dhtPublickeyEncryptC CPublicKeyPtr
pPtr Ptr CChar
dataPtr CUInt
dataSize
  ByteString
encryptedBytes <- CPublicKeyPtr -> Dht ByteString
viewBlob CPublicKeyPtr
blobPtr
  IO () -> Dht ()
forall a. IO a -> Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Dht ()) -> IO () -> Dht ()
forall a b. (a -> b) -> a -> b
$ CPublicKeyPtr -> IO ()
forall a. Ptr a -> IO ()
free CPublicKeyPtr
blobPtr
  ByteString -> Dht ByteString
forall a. a -> Dht a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
encryptedBytes

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