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

  Maintainer  : sim.desaulniers@gmail.com
-}

module OpenDHT.Internal.Value where

import Data.Maybe
import Data.Word
import Data.Functor
import qualified Data.ByteString as BS

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

import Foreign.Ptr (Ptr, nullPtr)
import Foreign.C.Types
import Foreign.C.String
import Foreign.Storable
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array

import OpenDHT.Types
import OpenDHT.Internal.Blob
import OpenDHT.InfoHash
import OpenDHT.PublicKey
import OpenDHT.Internal.InfoHash
import OpenDHT.Internal.PublicKey

type CValuePtr = Ptr ()


data Value = StoredValue { Value -> ByteString
_valueData        :: BS.ByteString -- ^ The data to store onto the DHT.
                         , Value -> Word64
_valueId          :: Word64        -- ^ The unique identifier of the value taken randomly
                                                              --   from the bits space \(\{0,1\}^{64}\).
                         , Value -> PublicKey
_valueOwner       :: PublicKey     -- ^ The owner's public key. If the data was signed, this
                                                              --   field should contain the exported key.
                         , Value -> InfoHash
_valueRecipientId :: InfoHash      -- ^ The hash of the public key to which the value is
                                                              --   dedicated when the value is encrypted. Otherwise,
                                                              --   it's the empty InfoHash.
                         , Value -> String
_valueUserType    :: String        -- ^ A user defined field for labelling values.
                         }
           | MetaValue   { _valueId          :: Word64        -- ^
                         , _valueOwner       :: PublicKey     -- ^
                         , _valueRecipientId :: InfoHash      -- ^
                         , _valueUserType    :: String        -- ^
                         }
           | InputValue  { _valueData        :: BS.ByteString -- ^
                         , _valueUserType    :: String        -- ^
                         }

foreign import ccall "dht_value_with_id_new" dhtValueWithIdNewC :: Ptr CUChar -> CULong -> CULong -> IO CValuePtr
foreign import ccall "dht_value_unref" dhtValueUnref            :: CValuePtr -> IO ()

{-| Build an OpenDHT Value from a string of bytes.
-}
withValuePtrFromBytes :: BS.ByteString -> Word64 -> (CValuePtr -> Dht ()) -> Dht ()
withValuePtrFromBytes :: ByteString -> Word64 -> (CPublicKeyPtr -> Dht ()) -> Dht ()
withValuePtrFromBytes ByteString
bs Word64
vid CPublicKeyPtr -> Dht ()
f = 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
$ [CUChar] -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray ((Word8 -> CUChar) -> [Word8] -> [CUChar]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> CUChar
CUChar ([Word8] -> [CUChar]) -> [Word8] -> [CUChar]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack ByteString
bs) ((Ptr CUChar -> IO ()) -> IO ()) -> (Ptr CUChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr CUChar
ptrBytes -> do
  CPublicKeyPtr
vPtr <- Ptr CUChar -> CULong -> CULong -> IO CPublicKeyPtr
dhtValueWithIdNewC Ptr CUChar
ptrBytes (Int -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CULong) -> Int -> CULong
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bs) (Word64 -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
vid)
  Dht () -> IO ()
forall a. Dht a -> IO a
unDht (Dht () -> IO ()) -> Dht () -> IO ()
forall a b. (a -> b) -> a -> b
$ CPublicKeyPtr -> Dht ()
f CPublicKeyPtr
vPtr
  CPublicKeyPtr -> IO ()
dhtValueUnref CPublicKeyPtr
vPtr

foreign import ccall "dht_value_new_from_string" dhtValueNewFromStringC :: Ptr CChar -> IO CValuePtr

{-| Build an OpenDHT Value from a string of characters.
-}
valuePtrFromString :: String -> Dht CValuePtr
valuePtrFromString :: String -> Dht CPublicKeyPtr
valuePtrFromString String
s = 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
$ String -> (CString -> IO CPublicKeyPtr) -> IO CPublicKeyPtr
forall a. String -> (CString -> IO a) -> IO a
withCString String
s CString -> IO CPublicKeyPtr
dhtValueNewFromStringC

-- foreign import ccall "dht_value_ref" dhtValueRefC :: CValuePtr -> IO CValuePtr
foreign import ccall "dht_value_unref" dhtValueUnrefC :: CValuePtr -> IO ()

{-| Delete the C reference to the OpenDHT Value pointed to by the pointer.
-}
unref :: CValuePtr -> Dht ()
unref :: CPublicKeyPtr -> Dht ()
unref CPublicKeyPtr
vPtr = 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 ()
dhtValueUnrefC CPublicKeyPtr
vPtr

foreign import ccall "wr_dht_value_get_data" dhtValueGetDataC :: Ptr DataView -> CValuePtr -> IO ()

{-| Get the data from the OpenDHT value. This is the actual bytes stored by the
   user.
-}
getValueData :: CValuePtr -> Dht BS.ByteString
getValueData :: CPublicKeyPtr -> Dht ByteString
getValueData CPublicKeyPtr
vPtr = IO ByteString -> Dht ByteString
forall a. IO a -> Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> Dht ByteString)
-> IO ByteString -> Dht ByteString
forall a b. (a -> b) -> a -> b
$ do
  Ptr DataView
dvPtr <- IO (Ptr DataView)
forall a. Storable a => IO (Ptr a)
malloc
  Ptr DataView -> CPublicKeyPtr -> IO ()
dhtValueGetDataC Ptr DataView
dvPtr CPublicKeyPtr
vPtr
  DataView
dv <- Ptr DataView -> IO DataView
forall a. Storable a => Ptr a -> IO a
peek Ptr DataView
dvPtr
  Ptr DataView -> IO ()
forall a. Ptr a -> IO ()
free Ptr DataView
dvPtr
  DataView -> IO ByteString
bytesFromDataView DataView
dv

foreign import ccall "dht_value_get_id" dhtValueGetIdC :: CValuePtr -> IO CULong

{-| Get the id of an OpenDHT value. This field is a metadata.
-}
getValueId :: CValuePtr -> Dht Word64
getValueId :: CPublicKeyPtr -> Dht Word64
getValueId = IO Word64 -> Dht Word64
forall a. IO a -> Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> Dht Word64)
-> (CPublicKeyPtr -> IO Word64) -> CPublicKeyPtr -> Dht Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CPublicKeyPtr -> IO CULong
dhtValueGetIdC (CPublicKeyPtr -> IO CULong)
-> (CULong -> IO Word64) -> CPublicKeyPtr -> IO Word64
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> IO Word64) -> (CULong -> Word64) -> CULong -> IO Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

foreign import ccall "dht_value_get_owner" dhtValueGetOwnerC :: CValuePtr -> IO CPublicKeyPtr

getValueOwner :: CValuePtr -> Dht CPublicKeyPtr
getValueOwner :: CPublicKeyPtr -> Dht CPublicKeyPtr
getValueOwner = IO CPublicKeyPtr -> Dht CPublicKeyPtr
forall a. IO a -> Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CPublicKeyPtr -> Dht CPublicKeyPtr)
-> (CPublicKeyPtr -> IO CPublicKeyPtr)
-> CPublicKeyPtr
-> Dht CPublicKeyPtr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CPublicKeyPtr -> IO CPublicKeyPtr
dhtValueGetOwnerC

foreign import ccall "wr_dht_value_get_recipient" dhtValueGetRecipientC :: CInfoHashPtr -> CValuePtr -> IO ()

{-| Get the recipient of an OpenDHT value. This field is a metadata.
-}
getValueRecipientId :: CValuePtr -> Dht InfoHash
getValueRecipientId :: CPublicKeyPtr -> Dht InfoHash
getValueRecipientId CPublicKeyPtr
vptr = Dht String
getRecipientHashString Dht String -> (String -> InfoHash) -> Dht InfoHash
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> InfoHash
InfoHash
  where getRecipientHashString :: Dht String
getRecipientHashString = IO String -> Dht String
forall a. IO a -> Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> Dht String) -> IO String -> Dht String
forall a b. (a -> b) -> a -> b
$ do
          Ptr CInfoHash
hPtr <- IO (Ptr CInfoHash)
forall a. Storable a => IO (Ptr a)
malloc
          Ptr CInfoHash -> CPublicKeyPtr -> IO ()
dhtValueGetRecipientC Ptr CInfoHash
hPtr CPublicKeyPtr
vptr
          String
hstr <- Ptr CInfoHash -> IO String
infoHashToString Ptr CInfoHash
hPtr
          Ptr CInfoHash -> IO ()
forall a. Ptr a -> IO ()
free Ptr CInfoHash
hPtr
          String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
hstr

getOwnerPublicKey :: CValuePtr -> Dht PublicKey
getOwnerPublicKey :: CPublicKeyPtr -> Dht PublicKey
getOwnerPublicKey CPublicKeyPtr
vptr = do
  CPublicKeyPtr
opkPtr <- CPublicKeyPtr -> Dht CPublicKeyPtr
getValueOwner CPublicKeyPtr
vptr
  Maybe String
mStr <- MaybeT Dht String -> Dht (Maybe String)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Dht String -> Dht (Maybe String))
-> MaybeT Dht String -> Dht (Maybe String)
forall a b. (a -> b) -> a -> b
$ do
    Bool -> MaybeT Dht ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (CPublicKeyPtr
opkPtr CPublicKeyPtr -> CPublicKeyPtr -> Bool
forall a. Eq a => a -> a -> Bool
/= CPublicKeyPtr
forall a. Ptr a
nullPtr)
    CPublicKey -> MaybeT Dht String
export (CPublicKeyPtr -> CPublicKey
CPublicKey CPublicKeyPtr
opkPtr)
  PublicKey -> Dht PublicKey
forall a. a -> Dht a
forall (m :: * -> *) a. Monad m => a -> m a
return (PublicKey -> Dht PublicKey) -> PublicKey -> Dht PublicKey
forall a b. (a -> b) -> a -> b
$ String -> PublicKey
ExportedKey (String -> PublicKey) -> String -> PublicKey
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
mStr

foreign import ccall "dht_value_get_user_type" dhtValueGetUserTypeC  :: CValuePtr -> IO (Ptr CChar)

{-| Get the user-type of an OpenDHT value. This field is a metadata.
-}
getValueUserType :: CValuePtr -> Dht String
getValueUserType :: CPublicKeyPtr -> Dht String
getValueUserType = IO String -> Dht String
forall a. IO a -> Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> Dht String)
-> (CPublicKeyPtr -> IO String) -> CPublicKeyPtr -> Dht String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CPublicKeyPtr -> IO CString
dhtValueGetUserTypeC (CPublicKeyPtr -> IO CString)
-> (CString -> IO String) -> CPublicKeyPtr -> IO String
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> CString -> IO String
peekCString)

foreign import ccall "dht_value_set_user_type" dhtValueSetUserTypeC  :: CValuePtr -> Ptr CChar -> IO ()

{-| Set the user-type of an OpenDHT value.
-}
setValueUserType :: CValuePtr -> String -> Dht ()
setValueUserType :: CPublicKeyPtr -> String -> Dht ()
setValueUserType CPublicKeyPtr
vptr String
s = 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
$ String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
s ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
cstr -> CPublicKeyPtr -> CString -> IO ()
dhtValueSetUserTypeC CPublicKeyPtr
vptr CString
cstr

storedValueFromCValuePtr :: CValuePtr -> Dht Value
storedValueFromCValuePtr :: CPublicKeyPtr -> Dht Value
storedValueFromCValuePtr CPublicKeyPtr
vPtr = ByteString -> Word64 -> PublicKey -> InfoHash -> String -> Value
StoredValue (ByteString -> Word64 -> PublicKey -> InfoHash -> String -> Value)
-> Dht ByteString
-> Dht (Word64 -> PublicKey -> InfoHash -> String -> Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CPublicKeyPtr -> Dht ByteString
getValueData        CPublicKeyPtr
vPtr
                                            Dht (Word64 -> PublicKey -> InfoHash -> String -> Value)
-> Dht Word64 -> Dht (PublicKey -> InfoHash -> String -> Value)
forall a b. Dht (a -> b) -> Dht a -> Dht b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CPublicKeyPtr -> Dht Word64
getValueId          CPublicKeyPtr
vPtr
                                            Dht (PublicKey -> InfoHash -> String -> Value)
-> Dht PublicKey -> Dht (InfoHash -> String -> Value)
forall a b. Dht (a -> b) -> Dht a -> Dht b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CPublicKeyPtr -> Dht PublicKey
getOwnerPublicKey   CPublicKeyPtr
vPtr
                                            Dht (InfoHash -> String -> Value)
-> Dht InfoHash -> Dht (String -> Value)
forall a b. Dht (a -> b) -> Dht a -> Dht b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CPublicKeyPtr -> Dht InfoHash
getValueRecipientId CPublicKeyPtr
vPtr
                                            Dht (String -> Value) -> Dht String -> Dht Value
forall a b. Dht (a -> b) -> Dht a -> Dht b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CPublicKeyPtr -> Dht String
getValueUserType    CPublicKeyPtr
vPtr

metaValueFromCValuePtr :: CValuePtr -> Dht Value
metaValueFromCValuePtr :: CPublicKeyPtr -> Dht Value
metaValueFromCValuePtr CPublicKeyPtr
vPtr = Word64 -> PublicKey -> InfoHash -> String -> Value
MetaValue (Word64 -> PublicKey -> InfoHash -> String -> Value)
-> Dht Word64 -> Dht (PublicKey -> InfoHash -> String -> Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CPublicKeyPtr -> Dht Word64
getValueId          CPublicKeyPtr
vPtr
                                        Dht (PublicKey -> InfoHash -> String -> Value)
-> Dht PublicKey -> Dht (InfoHash -> String -> Value)
forall a b. Dht (a -> b) -> Dht a -> Dht b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CPublicKeyPtr -> Dht PublicKey
getOwnerPublicKey   CPublicKeyPtr
vPtr
                                        Dht (InfoHash -> String -> Value)
-> Dht InfoHash -> Dht (String -> Value)
forall a b. Dht (a -> b) -> Dht a -> Dht b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CPublicKeyPtr -> Dht InfoHash
getValueRecipientId CPublicKeyPtr
vPtr
                                        Dht (String -> Value) -> Dht String -> Dht Value
forall a b. Dht (a -> b) -> Dht a -> Dht b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CPublicKeyPtr -> Dht String
getValueUserType    CPublicKeyPtr
vPtr

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