{-|
  Module      : OpenDHT.Internal.Crypto
  Description : Internal crypto bindings
  Copyright   : (c) Simon Désaulniers, 2025
  License     : GPL-3

  Maintainer  : sim.desaulniers@gmail.com
-}

module OpenDHT.Internal.Crypto where

import Data.Foldable
import qualified Data.ByteString as BS

import Control.Monad
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.Alloc
import Foreign.Storable

import OpenDHT.Types

type CPassWordPtr      = Ptr CChar
type COutputString     = Ptr CChar
type CInputDataPtr     = Ptr CUChar
type DataImportation a = CInputDataPtr -> CUInt -> Maybe CPassWordPtr -> IO (Ptr a)
type DataExportation a = Ptr a -> COutputString -> Ptr CUInt -> Maybe CPassWordPtr -> IO CInt

withMaybePassword :: Maybe String -> (Maybe CPassWordPtr -> IO a) -> IO a
withMaybePassword :: forall a. Maybe String -> (Maybe CPassWordPtr -> IO a) -> IO a
withMaybePassword Maybe String
mPassword Maybe CPassWordPtr -> IO a
f = do
  Maybe CPassWordPtr
mPassPtr <- Maybe String
-> (String -> IO CPassWordPtr) -> IO (Maybe CPassWordPtr)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe String
mPassword (IO CPassWordPtr -> IO CPassWordPtr
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CPassWordPtr -> IO CPassWordPtr)
-> (String -> IO CPassWordPtr) -> String -> IO CPassWordPtr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IO CPassWordPtr
forall a. Int -> IO (Ptr a)
mallocBytes (Int -> IO CPassWordPtr)
-> (String -> Int) -> String -> IO CPassWordPtr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length)
  a
a        <- Maybe CPassWordPtr -> IO a
f Maybe CPassWordPtr
mPassPtr
  Maybe CPassWordPtr -> (CPassWordPtr -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe CPassWordPtr
mPassPtr CPassWordPtr -> IO ()
forall a. Ptr a -> IO ()
free
  a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

fromBytes :: BS.ByteString -> Maybe String -> DataImportation a -> MaybeT Dht (Ptr a)
fromBytes :: forall a.
ByteString
-> Maybe String -> DataImportation a -> MaybeT Dht (Ptr a)
fromBytes ByteString
dataBs Maybe String
mPassword DataImportation a
dataImport = do
  let
    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
    withDataAndPass :: Int -> (Ptr a -> CUInt -> Maybe CPassWordPtr -> IO b) -> IO b
withDataAndPass Int
size Ptr a -> CUInt -> Maybe CPassWordPtr -> IO b
f = Int -> (Ptr a -> IO b) -> IO b
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
size ((Ptr a -> IO b) -> IO b) -> (Ptr a -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \ Ptr a
dataPtr  -> Maybe String -> (Maybe CPassWordPtr -> IO b) -> IO b
forall a. Maybe String -> (Maybe CPassWordPtr -> IO a) -> IO a
withMaybePassword Maybe String
mPassword
                                              ((Maybe CPassWordPtr -> IO b) -> IO b)
-> (Maybe CPassWordPtr -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \ Maybe CPassWordPtr
mPassPtr -> Ptr a -> CUInt -> Maybe CPassWordPtr -> IO b
f Ptr a
dataPtr CUInt
cs Maybe CPassWordPtr
mPassPtr
  Ptr a
pPtr <- IO (Ptr a) -> MaybeT Dht (Ptr a)
forall a. IO a -> MaybeT Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr a) -> MaybeT Dht (Ptr a))
-> IO (Ptr a) -> MaybeT Dht (Ptr a)
forall a b. (a -> b) -> a -> b
$ Int -> DataImportation a -> IO (Ptr a)
forall {a} {b}.
Storable a =>
Int -> (Ptr a -> CUInt -> Maybe CPassWordPtr -> IO b) -> IO b
withDataAndPass Int
s DataImportation a
dataImport
  Bool -> MaybeT Dht ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Ptr a
pPtr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr a
forall a. Ptr a
nullPtr)
  Ptr a -> MaybeT Dht (Ptr a)
forall a. a -> MaybeT Dht a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
pPtr

export :: Ptr a -> Maybe String -> DataExportation a -> MaybeT Dht String
export :: forall a.
Ptr a -> Maybe String -> DataExportation a -> MaybeT Dht String
export Ptr a
pPtr Maybe String
mPassword DataExportation a
dataExport = do
  let withSizedArray :: Int -> (Ptr a -> Ptr a -> Maybe CPassWordPtr -> IO a) -> m a
withSizedArray Int
s Ptr a -> Ptr a -> Maybe CPassWordPtr -> IO a
f = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ (Ptr a -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr a -> IO a) -> IO a) -> (Ptr a -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ Ptr a
sPtr -> do
        Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
sPtr (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s)
        Int -> (Ptr a -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
s ((Ptr a -> IO a) -> IO a) -> (Ptr a -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ Ptr a
bytesPtr -> Maybe String -> (Maybe CPassWordPtr -> IO a) -> IO a
forall a. Maybe String -> (Maybe CPassWordPtr -> IO a) -> IO a
withMaybePassword Maybe String
mPassword ((Maybe CPassWordPtr -> IO a) -> IO a)
-> (Maybe CPassWordPtr -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ Maybe CPassWordPtr
mPassPtr -> Ptr a -> Ptr a -> Maybe CPassWordPtr -> IO a
f Ptr a
sPtr Ptr a
bytesPtr Maybe CPassWordPtr
mPassPtr
  -- First, test to get the correct value for the size parameter.
  (CInt
err, CUInt
s') <- Int
-> (Ptr CUInt
    -> CPassWordPtr -> Maybe CPassWordPtr -> IO (CInt, CUInt))
-> MaybeT Dht (CInt, CUInt)
forall {m :: * -> *} {a} {a} {a}.
(MonadIO m, Num a, Storable a, Storable a) =>
Int -> (Ptr a -> Ptr a -> Maybe CPassWordPtr -> IO a) -> m a
withSizedArray Int
0 ((Ptr CUInt
  -> CPassWordPtr -> Maybe CPassWordPtr -> IO (CInt, CUInt))
 -> MaybeT Dht (CInt, CUInt))
-> (Ptr CUInt
    -> CPassWordPtr -> Maybe CPassWordPtr -> IO (CInt, CUInt))
-> MaybeT Dht (CInt, CUInt)
forall a b. (a -> b) -> a -> b
$ \ Ptr CUInt
sPtr CPassWordPtr
bytesPtr Maybe CPassWordPtr
mPassPtr -> do
    CInt
err <- DataExportation a
dataExport Ptr a
pPtr CPassWordPtr
bytesPtr Ptr CUInt
sPtr Maybe CPassWordPtr
mPassPtr
    CUInt
s'  <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
sPtr -- According to GNUTls' documentation for the underlying function called by
    (CInt, CUInt) -> IO (CInt, CUInt)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt
err, CUInt
s') -- OpenDHT, gnutls_x509_privkey_export_pkcs8, upon GNUTLS_E_SHORT_MEMORY_BUFFER (-51)
                     -- error the size parameter would be updated with the correct value needed for the
  Bool -> MaybeT Dht ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (CInt
err CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== -CInt
51) -- function to succeed.
  Int
-> (Ptr CUInt -> CPassWordPtr -> Maybe CPassWordPtr -> IO String)
-> MaybeT Dht String
forall {m :: * -> *} {a} {a} {a}.
(MonadIO m, Num a, Storable a, Storable a) =>
Int -> (Ptr a -> Ptr a -> Maybe CPassWordPtr -> IO a) -> m a
withSizedArray (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
s') ((Ptr CUInt -> CPassWordPtr -> Maybe CPassWordPtr -> IO String)
 -> MaybeT Dht String)
-> (Ptr CUInt -> CPassWordPtr -> Maybe CPassWordPtr -> IO String)
-> MaybeT Dht String
forall a b. (a -> b) -> a -> b
$ \ Ptr CUInt
sPtr CPassWordPtr
bytesPtr Maybe CPassWordPtr
passPtr -> do
    CInt
c <- DataExportation a
dataExport Ptr a
pPtr CPassWordPtr
bytesPtr Ptr CUInt
sPtr Maybe CPassWordPtr
passPtr
    Bool -> IO ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (CInt
c CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0)
    [CChar]
ccharArray <- Int -> CPassWordPtr -> IO [CChar]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
s') CPassWordPtr
bytesPtr
    String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ (CChar -> Char) -> [CChar] -> String
forall a b. (a -> b) -> [a] -> [b]
map CChar -> Char
castCCharToChar [CChar]
ccharArray

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