{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
module OpenDHT.DhtRunner (
DhtRunner
, DhtRunnerM
, runDhtRunnerM
, DhtRunnerConfig (..)
, dhtConfig
, proxyServer
, pushNodeId
, pushToken
, pushTopic
, pushPlatform
, peerDiscovery
, peerPublish
, serverCa
, clientIdentity
, logging
, DhtSecureConfig (..)
, nodeConfig
, nodeId
, DhtIdentity (..)
, privatekey
, certificate
, DhtNodeConfig (..)
, nodeIdHash
, network
, isBootstrap
, maintainStorage
, persistPath
, GetCallback
, ValueCallback
, DoneCallback
, ShutdownCallback
, OpToken
, OpTokenMap
, getNodeIdHash
, getPublicKeyID
, getPermanentMetaValues
, getListenTokens
, run
, runConfig
, isRunning
, bootstrap
, get
, put
, cancelPut
, listen
, cancelListen
) where
import System.Random
import Data.Maybe
import Data.Default
import Data.Word
import Data.Functor
import qualified Data.List as List
import Data.Map ( Map
)
import qualified Data.Map as Map
import qualified Data.ByteString as BS
import Control.Lens
import Control.Monad
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Class
import Control.Monad.IO.Class
import Control.Monad.Reader
import Control.Concurrent.STM.TVar
import Control.Concurrent.STM
import Control.Concurrent.MVar
import Foreign.Ptr
import Foreign.Storable
import Foreign.C.Types
import Foreign.C.String
import Foreign.Marshal.Utils
import Foreign.Marshal.Alloc
import OpenDHT.Types
import OpenDHT.InfoHash
import OpenDHT.Value
import OpenDHT.PrivateKey
import OpenDHT.Certificate
import OpenDHT.Internal.Value
import OpenDHT.Internal.DhtRunner
import OpenDHT.Internal.InfoHash
import qualified OpenDHT.Internal.Certificate as Certificate
import OpenDHT.Internal.Certificate (CCertificate (..))
import qualified OpenDHT.Internal.PrivateKey as PrivateKey
import OpenDHT.Internal.PrivateKey (CPrivateKey (..))
type CDhtRunnerPtr = Ptr ()
type COpTokenPtr = Ptr ()
newtype DhtRunner = DhtRunner { DhtRunner -> CDhtRunnerPtr
_dhtRunnerPtr :: CDhtRunnerPtr }
newtype OpToken = OpToken { OpToken -> CDhtRunnerPtr
_opTokenPtr :: COpTokenPtr }
deriving OpToken -> OpToken -> Bool
(OpToken -> OpToken -> Bool)
-> (OpToken -> OpToken -> Bool) -> Eq OpToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpToken -> OpToken -> Bool
== :: OpToken -> OpToken -> Bool
$c/= :: OpToken -> OpToken -> Bool
/= :: OpToken -> OpToken -> Bool
Eq
type OpTokenMap = Map InfoHash [OpToken]
data DhtRunnerState = DhtRunnerState
{ DhtRunnerState -> DhtRunner
_dhtRunner :: DhtRunner
, DhtRunnerState -> Map InfoHash [OpToken]
_listenTokens :: OpTokenMap
, DhtRunnerState -> [Value]
_permanentValues :: [Value]
}
makeLenses ''DhtRunnerState
data DhtIdentity = DhtIdentity { DhtIdentity -> PrivateKey
_privatekey :: PrivateKey
, DhtIdentity -> Certificate
_certificate :: Certificate
}
makeLenses ''DhtIdentity
instance Default DhtIdentity where
def :: DhtIdentity
def = DhtIdentity { _privatekey :: PrivateKey
_privatekey = Certificate -> String -> PrivateKey
PrivateKey Certificate
BS.empty String
""
, _certificate :: Certificate
_certificate = Certificate
BS.empty
}
data DhtNodeConfig = DhtNodeConfig
{ DhtNodeConfig -> Maybe InfoHash
_nodeIdHash :: Maybe InfoHash
, DhtNodeConfig -> Word32
_network :: Word32
, DhtNodeConfig -> Bool
_isBootstrap :: Bool
, DhtNodeConfig -> Bool
_maintainStorage :: Bool
, DhtNodeConfig -> String
_persistPath :: String
}
makeLenses ''DhtNodeConfig
instance Default DhtNodeConfig where
def :: DhtNodeConfig
def = DhtNodeConfig { _nodeIdHash :: Maybe InfoHash
_nodeIdHash = Maybe InfoHash
forall a. Maybe a
Nothing
, _network :: Word32
_network = Word32
0
, _isBootstrap :: Bool
_isBootstrap = Bool
False
, _maintainStorage :: Bool
_maintainStorage = Bool
False
, _persistPath :: String
_persistPath = String
""
}
data DhtSecureConfig = DhtSecureConfig { DhtSecureConfig -> DhtNodeConfig
_nodeConfig :: DhtNodeConfig
, DhtSecureConfig -> DhtIdentity
_nodeId :: DhtIdentity
}
makeLenses ''DhtSecureConfig
instance Default DhtSecureConfig where
def :: DhtSecureConfig
def = DhtNodeConfig -> DhtIdentity -> DhtSecureConfig
DhtSecureConfig DhtNodeConfig
forall a. Default a => a
def DhtIdentity
forall a. Default a => a
def
data DhtRunnerConfig = DhtRunnerConfig
{ DhtRunnerConfig -> DhtSecureConfig
_dhtConfig :: DhtSecureConfig
, DhtRunnerConfig -> String
_proxyServer :: String
, DhtRunnerConfig -> String
_pushNodeId :: String
, DhtRunnerConfig -> String
_pushToken :: String
, DhtRunnerConfig -> String
_pushTopic :: String
, DhtRunnerConfig -> String
_pushPlatform :: String
, DhtRunnerConfig -> Bool
_peerDiscovery :: Bool
, DhtRunnerConfig -> Bool
_peerPublish :: Bool
, DhtRunnerConfig -> Certificate
_serverCa :: BS.ByteString
, DhtRunnerConfig -> DhtIdentity
_clientIdentity :: DhtIdentity
, DhtRunnerConfig -> Bool
_logging :: Bool
}
makeLenses ''DhtRunnerConfig
instance Default DhtRunnerConfig where
def :: DhtRunnerConfig
def = DhtRunnerConfig { _dhtConfig :: DhtSecureConfig
_dhtConfig = DhtSecureConfig
forall a. Default a => a
def
, _proxyServer :: String
_proxyServer = String
""
, _pushNodeId :: String
_pushNodeId = String
""
, _pushToken :: String
_pushToken = String
""
, _pushTopic :: String
_pushTopic = String
""
, _pushPlatform :: String
_pushPlatform = String
""
, _peerDiscovery :: Bool
_peerDiscovery = Bool
False
, _peerPublish :: Bool
_peerPublish = Bool
False
, _serverCa :: Certificate
_serverCa = Certificate
BS.empty
, _clientIdentity :: DhtIdentity
_clientIdentity = DhtIdentity
forall a. Default a => a
def
, _logging :: Bool
_logging = Bool
False
}
newtype DhtRunnerM m a = DhtRunnerM { forall (m :: * -> *) a.
DhtRunnerM m a -> ReaderT (TVar DhtRunnerState) m a
unwrapDhtRunnerM :: ReaderT (TVar DhtRunnerState) m a }
deriving ((forall a b. (a -> b) -> DhtRunnerM m a -> DhtRunnerM m b)
-> (forall a b. a -> DhtRunnerM m b -> DhtRunnerM m a)
-> Functor (DhtRunnerM m)
forall a b. a -> DhtRunnerM m b -> DhtRunnerM m a
forall a b. (a -> b) -> DhtRunnerM m a -> DhtRunnerM m b
forall (m :: * -> *) a b.
Functor m =>
a -> DhtRunnerM m b -> DhtRunnerM m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> DhtRunnerM m a -> DhtRunnerM m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> DhtRunnerM m a -> DhtRunnerM m b
fmap :: forall a b. (a -> b) -> DhtRunnerM m a -> DhtRunnerM m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> DhtRunnerM m b -> DhtRunnerM m a
<$ :: forall a b. a -> DhtRunnerM m b -> DhtRunnerM m a
Functor, Functor (DhtRunnerM m)
Functor (DhtRunnerM m)
-> (forall a. a -> DhtRunnerM m a)
-> (forall a b.
DhtRunnerM m (a -> b) -> DhtRunnerM m a -> DhtRunnerM m b)
-> (forall a b c.
(a -> b -> c)
-> DhtRunnerM m a -> DhtRunnerM m b -> DhtRunnerM m c)
-> (forall a b. DhtRunnerM m a -> DhtRunnerM m b -> DhtRunnerM m b)
-> (forall a b. DhtRunnerM m a -> DhtRunnerM m b -> DhtRunnerM m a)
-> Applicative (DhtRunnerM m)
forall a. a -> DhtRunnerM m a
forall a b. DhtRunnerM m a -> DhtRunnerM m b -> DhtRunnerM m a
forall a b. DhtRunnerM m a -> DhtRunnerM m b -> DhtRunnerM m b
forall a b.
DhtRunnerM m (a -> b) -> DhtRunnerM m a -> DhtRunnerM m b
forall a b c.
(a -> b -> c) -> DhtRunnerM m a -> DhtRunnerM m b -> DhtRunnerM m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {m :: * -> *}. Applicative m => Functor (DhtRunnerM m)
forall (m :: * -> *) a. Applicative m => a -> DhtRunnerM m a
forall (m :: * -> *) a b.
Applicative m =>
DhtRunnerM m a -> DhtRunnerM m b -> DhtRunnerM m a
forall (m :: * -> *) a b.
Applicative m =>
DhtRunnerM m a -> DhtRunnerM m b -> DhtRunnerM m b
forall (m :: * -> *) a b.
Applicative m =>
DhtRunnerM m (a -> b) -> DhtRunnerM m a -> DhtRunnerM m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> DhtRunnerM m a -> DhtRunnerM m b -> DhtRunnerM m c
$cpure :: forall (m :: * -> *) a. Applicative m => a -> DhtRunnerM m a
pure :: forall a. a -> DhtRunnerM m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
DhtRunnerM m (a -> b) -> DhtRunnerM m a -> DhtRunnerM m b
<*> :: forall a b.
DhtRunnerM m (a -> b) -> DhtRunnerM m a -> DhtRunnerM m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> DhtRunnerM m a -> DhtRunnerM m b -> DhtRunnerM m c
liftA2 :: forall a b c.
(a -> b -> c) -> DhtRunnerM m a -> DhtRunnerM m b -> DhtRunnerM m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
DhtRunnerM m a -> DhtRunnerM m b -> DhtRunnerM m b
*> :: forall a b. DhtRunnerM m a -> DhtRunnerM m b -> DhtRunnerM m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
DhtRunnerM m a -> DhtRunnerM m b -> DhtRunnerM m a
<* :: forall a b. DhtRunnerM m a -> DhtRunnerM m b -> DhtRunnerM m a
Applicative, Applicative (DhtRunnerM m)
Applicative (DhtRunnerM m)
-> (forall a b.
DhtRunnerM m a -> (a -> DhtRunnerM m b) -> DhtRunnerM m b)
-> (forall a b. DhtRunnerM m a -> DhtRunnerM m b -> DhtRunnerM m b)
-> (forall a. a -> DhtRunnerM m a)
-> Monad (DhtRunnerM m)
forall a. a -> DhtRunnerM m a
forall a b. DhtRunnerM m a -> DhtRunnerM m b -> DhtRunnerM m b
forall a b.
DhtRunnerM m a -> (a -> DhtRunnerM m b) -> DhtRunnerM m b
forall {m :: * -> *}. Monad m => Applicative (DhtRunnerM m)
forall (m :: * -> *) a. Monad m => a -> DhtRunnerM m a
forall (m :: * -> *) a b.
Monad m =>
DhtRunnerM m a -> DhtRunnerM m b -> DhtRunnerM m b
forall (m :: * -> *) a b.
Monad m =>
DhtRunnerM m a -> (a -> DhtRunnerM m b) -> DhtRunnerM m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
DhtRunnerM m a -> (a -> DhtRunnerM m b) -> DhtRunnerM m b
>>= :: forall a b.
DhtRunnerM m a -> (a -> DhtRunnerM m b) -> DhtRunnerM m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
DhtRunnerM m a -> DhtRunnerM m b -> DhtRunnerM m b
>> :: forall a b. DhtRunnerM m a -> DhtRunnerM m b -> DhtRunnerM m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> DhtRunnerM m a
return :: forall a. a -> DhtRunnerM m a
Monad, Monad (DhtRunnerM m)
Monad (DhtRunnerM m)
-> (forall a. IO a -> DhtRunnerM m a) -> MonadIO (DhtRunnerM m)
forall a. IO a -> DhtRunnerM m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (DhtRunnerM m)
forall (m :: * -> *) a. MonadIO m => IO a -> DhtRunnerM m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> DhtRunnerM m a
liftIO :: forall a. IO a -> DhtRunnerM m a
MonadIO, MonadReader (TVar DhtRunnerState))
instance MonadTrans DhtRunnerM where
lift :: forall (m :: * -> *) a. Monad m => m a -> DhtRunnerM m a
lift = ReaderT (TVar DhtRunnerState) m a -> DhtRunnerM m a
forall (m :: * -> *) a.
ReaderT (TVar DhtRunnerState) m a -> DhtRunnerM m a
DhtRunnerM (ReaderT (TVar DhtRunnerState) m a -> DhtRunnerM m a)
-> (m a -> ReaderT (TVar DhtRunnerState) m a)
-> m a
-> DhtRunnerM m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT (TVar DhtRunnerState) m a
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (TVar DhtRunnerState) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
type GetCallback = Value
-> IO Bool
type ValueCallback = Value
-> Bool
-> IO Bool
type DoneCallback = Bool
-> IO ()
type ShutdownCallback = IO ()
deleteListenToken :: InfoHash
-> OpToken
-> DhtRunnerState
-> DhtRunnerState
deleteListenToken :: InfoHash -> OpToken -> DhtRunnerState -> DhtRunnerState
deleteListenToken InfoHash
h OpToken
token s :: DhtRunnerState
s@(DhtRunnerState DhtRunner
_ Map InfoHash [OpToken]
ltokens [Value]
_) = DhtRunnerState
-> ([OpToken] -> DhtRunnerState)
-> Maybe [OpToken]
-> DhtRunnerState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DhtRunnerState
s [OpToken] -> DhtRunnerState
fromNewTokens Maybe [OpToken]
mSplitAtToken
where
mSplitAtToken :: Maybe [OpToken]
mSplitAtToken = Map InfoHash [OpToken] -> Maybe [OpToken]
forall {s}.
(IxValue s ~ [OpToken], Index s ~ InfoHash, At s) =>
s -> Maybe [OpToken]
withTokenOrNothing Map InfoHash [OpToken]
ltokens
fromNewTokens :: [OpToken] -> DhtRunnerState
fromNewTokens [] = DhtRunnerState
s DhtRunnerState
-> (DhtRunnerState -> DhtRunnerState) -> DhtRunnerState
forall a b. a -> (a -> b) -> b
& (Map InfoHash [OpToken] -> Identity (Map InfoHash [OpToken]))
-> DhtRunnerState -> Identity DhtRunnerState
Lens' DhtRunnerState (Map InfoHash [OpToken])
listenTokens ((Map InfoHash [OpToken] -> Identity (Map InfoHash [OpToken]))
-> DhtRunnerState -> Identity DhtRunnerState)
-> (Map InfoHash [OpToken] -> Map InfoHash [OpToken])
-> DhtRunnerState
-> DhtRunnerState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ InfoHash -> Map InfoHash [OpToken] -> Map InfoHash [OpToken]
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete InfoHash
h
fromNewTokens [OpToken]
newTokens = DhtRunnerState
s DhtRunnerState
-> (DhtRunnerState -> DhtRunnerState) -> DhtRunnerState
forall a b. a -> (a -> b) -> b
& (Map InfoHash [OpToken] -> Identity (Map InfoHash [OpToken]))
-> DhtRunnerState -> Identity DhtRunnerState
Lens' DhtRunnerState (Map InfoHash [OpToken])
listenTokens ((Map InfoHash [OpToken] -> Identity (Map InfoHash [OpToken]))
-> DhtRunnerState -> Identity DhtRunnerState)
-> (Map InfoHash [OpToken] -> Map InfoHash [OpToken])
-> DhtRunnerState
-> DhtRunnerState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ InfoHash
-> [OpToken] -> Map InfoHash [OpToken] -> Map InfoHash [OpToken]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert InfoHash
h [OpToken]
newTokens
withTokenOrNothing :: s -> Maybe [OpToken]
withTokenOrNothing s
tmap = do
[OpToken]
tokens <- s
tmap s
-> Getting (Maybe [OpToken]) s (Maybe [OpToken]) -> Maybe [OpToken]
forall s a. s -> Getting a s a -> a
^. Index s -> Lens' s (Maybe (IxValue s))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index s
InfoHash
h
Int
i <- OpToken -> [OpToken] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
List.elemIndex OpToken
token [OpToken]
tokens
case Int -> [OpToken] -> ([OpToken], [OpToken])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [OpToken]
tokens of
([OpToken]
beg, OpToken
_:[OpToken]
end) -> [OpToken] -> Maybe [OpToken]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ([OpToken] -> Maybe [OpToken]) -> [OpToken] -> Maybe [OpToken]
forall a b. (a -> b) -> a -> b
$ [OpToken]
beg [OpToken] -> [OpToken] -> [OpToken]
forall a. [a] -> [a] -> [a]
++ [OpToken]
end
([OpToken]
_, []) -> String -> Maybe [OpToken]
forall a. HasCallStack => String -> a
error String
"cancelListen: the token list should not have been empty."
fromGetCallBack :: GetCallback -> CGetCallback
fromGetCallBack :: GetCallback -> CGetCallback
fromGetCallBack GetCallback
gcb CDhtRunnerPtr
vPtr CDhtRunnerPtr
_ = do
Value
v <- Dht Value -> IO Value
forall a. Dht a -> IO a
unDht (Dht Value -> IO Value) -> Dht Value -> IO Value
forall a b. (a -> b) -> a -> b
$ CDhtRunnerPtr -> Dht Value
storedValueFromCValuePtr CDhtRunnerPtr
vPtr
Bool -> CBool
forall a. Num a => Bool -> a
fromBool (Bool -> CBool) -> IO Bool -> IO CBool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GetCallback
gcb Value
v
fromValueCallBack :: InfoHash
-> TVar (Maybe OpToken)
-> TVar DhtRunnerState
-> ValueCallback
-> CValueCallback
fromValueCallBack :: InfoHash
-> TVar (Maybe OpToken)
-> TVar DhtRunnerState
-> ValueCallback
-> CValueCallback
fromValueCallBack InfoHash
h TVar (Maybe OpToken)
tTVar TVar DhtRunnerState
dhtStateTV ValueCallback
vcb CDhtRunnerPtr
vPtr CBool
expired CDhtRunnerPtr
_ = do
OpToken
token <- STM OpToken -> IO OpToken
forall a. STM a -> IO a
atomically (STM OpToken -> IO OpToken) -> STM OpToken -> IO OpToken
forall a b. (a -> b) -> a -> b
$ do
Maybe OpToken
mt <- TVar (Maybe OpToken) -> STM (Maybe OpToken)
forall a. TVar a -> STM a
readTVar TVar (Maybe OpToken)
tTVar
Bool -> STM ()
check (Bool -> STM ()) -> Bool -> STM ()
forall a b. (a -> b) -> a -> b
$ Maybe OpToken -> Bool
forall a. Maybe a -> Bool
isJust Maybe OpToken
mt
OpToken -> STM OpToken
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OpToken -> STM OpToken) -> OpToken -> STM OpToken
forall a b. (a -> b) -> a -> b
$ Maybe OpToken -> OpToken
forall a. HasCallStack => Maybe a -> a
fromJust Maybe OpToken
mt
Value
v <- Dht Value -> IO Value
forall a. Dht a -> IO a
unDht (Dht Value -> IO Value) -> Dht Value -> IO Value
forall a b. (a -> b) -> a -> b
$ CDhtRunnerPtr -> Dht Value
storedValueFromCValuePtr CDhtRunnerPtr
vPtr
Bool
toContinue <- ValueCallback
vcb Value
v (CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool CBool
expired)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
toContinue (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar DhtRunnerState -> (DhtRunnerState -> DhtRunnerState) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar DhtRunnerState
dhtStateTV ((DhtRunnerState -> DhtRunnerState) -> STM ())
-> (DhtRunnerState -> DhtRunnerState) -> STM ()
forall a b. (a -> b) -> a -> b
$ InfoHash -> OpToken -> DhtRunnerState -> DhtRunnerState
deleteListenToken InfoHash
h OpToken
token
CBool -> IO CBool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CBool -> IO CBool) -> CBool -> IO CBool
forall a b. (a -> b) -> a -> b
$ Bool -> CBool
forall a. Num a => Bool -> a
fromBool Bool
toContinue
fromDoneCallback :: DoneCallback -> CDoneCallback
fromDoneCallback :: DoneCallback -> CDoneCallback
fromDoneCallback DoneCallback
dcb CBool
successC CDhtRunnerPtr
_ = do
DoneCallback
dcb (CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool CBool
successC)
fromShutdownCallback :: ShutdownCallback -> CShutdownCallback
fromShutdownCallback :: IO () -> CShutdownCallback
fromShutdownCallback = IO () -> CShutdownCallback
forall a b. a -> b -> a
const
foreign import ccall "dht_runner_new" dhtRunnerNewC :: IO CDhtRunnerPtr
initialize :: Dht DhtRunner
initialize :: Dht DhtRunner
initialize = CDhtRunnerPtr -> DhtRunner
DhtRunner (CDhtRunnerPtr -> DhtRunner) -> Dht CDhtRunnerPtr -> Dht DhtRunner
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CDhtRunnerPtr -> Dht CDhtRunnerPtr
forall a. IO a -> Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO CDhtRunnerPtr
dhtRunnerNewC
foreign import ccall "dht_runner_delete" dhtRunnerDeleteC :: CDhtRunnerPtr -> IO ()
delete :: DhtRunner -> Dht ()
delete :: DhtRunner -> Dht ()
delete = IO () -> Dht ()
forall a. IO a -> Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Dht ()) -> (DhtRunner -> IO ()) -> DhtRunner -> Dht ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShutdownCallback
dhtRunnerDeleteC CShutdownCallback
-> (DhtRunner -> CDhtRunnerPtr) -> DhtRunner -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DhtRunner -> CDhtRunnerPtr
_dhtRunnerPtr
foreign import ccall "dht_op_token_delete" dhtOpTokenDeleteC :: COpTokenPtr -> IO ()
deleteOpToken :: OpToken -> Dht ()
deleteOpToken :: OpToken -> Dht ()
deleteOpToken = IO () -> Dht ()
forall a. IO a -> Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Dht ()) -> (OpToken -> IO ()) -> OpToken -> Dht ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CShutdownCallback
dhtOpTokenDeleteC CShutdownCallback -> (OpToken -> CDhtRunnerPtr) -> OpToken -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpToken -> CDhtRunnerPtr
_opTokenPtr
runDhtRunnerM :: ShutdownCallback
-> DhtRunnerM Dht ()
-> IO ()
runDhtRunnerM :: IO () -> DhtRunnerM Dht () -> IO ()
runDhtRunnerM IO ()
scb DhtRunnerM Dht ()
runnerAction = Dht () -> IO ()
forall a. Dht a -> IO a
unDht (Dht () -> IO ()) -> Dht () -> IO ()
forall a b. (a -> b) -> a -> b
$ Dht DhtRunner
initialize Dht DhtRunner -> (DhtRunner -> Dht ()) -> Dht ()
forall a b. Dht a -> (a -> Dht b) -> Dht b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ DhtRunner
dhtrunner -> do
MVar ()
mv <- IO (MVar ()) -> Dht (MVar ())
forall a. IO a -> Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MVar ()) -> Dht (MVar ())) -> IO (MVar ()) -> Dht (MVar ())
forall a b. (a -> b) -> a -> b
$ () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()
let
initialDhtRunnerState :: DhtRunnerState
initialDhtRunnerState = DhtRunnerState { _dhtRunner :: DhtRunner
_dhtRunner = DhtRunner
dhtrunner
, _listenTokens :: Map InfoHash [OpToken]
_listenTokens = Map InfoHash [OpToken]
forall k a. Map k a
Map.empty
, _permanentValues :: [Value]
_permanentValues = []
}
scbWrapped :: IO ()
scbWrapped = IO ()
scb IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
mv
TVar DhtRunnerState
dhtRunnerStateTV <- IO (TVar DhtRunnerState) -> Dht (TVar DhtRunnerState)
forall a. IO a -> Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TVar DhtRunnerState) -> Dht (TVar DhtRunnerState))
-> IO (TVar DhtRunnerState) -> Dht (TVar DhtRunnerState)
forall a b. (a -> b) -> a -> b
$ DhtRunnerState -> IO (TVar DhtRunnerState)
forall a. a -> IO (TVar a)
newTVarIO DhtRunnerState
initialDhtRunnerState
ReaderT (TVar DhtRunnerState) Dht ()
-> TVar DhtRunnerState -> Dht ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (DhtRunnerM Dht () -> ReaderT (TVar DhtRunnerState) Dht ()
forall (m :: * -> *) a.
DhtRunnerM m a -> ReaderT (TVar DhtRunnerState) m a
unwrapDhtRunnerM (DhtRunnerM Dht ()
runnerAction DhtRunnerM Dht () -> DhtRunnerM Dht () -> DhtRunnerM Dht ()
forall a b.
DhtRunnerM Dht a -> DhtRunnerM Dht b -> DhtRunnerM Dht b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO () -> DhtRunnerM Dht ()
shutdown IO ()
scbWrapped)) TVar DhtRunnerState
dhtRunnerStateTV
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
$ MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
mv ()
DhtRunner -> Dht ()
delete DhtRunner
dhtrunner
let emptyDhtRunnerState :: DhtRunnerState
emptyDhtRunnerState = DhtRunnerState { _dhtRunner :: DhtRunner
_dhtRunner = CDhtRunnerPtr -> DhtRunner
DhtRunner CDhtRunnerPtr
forall a. Ptr a
nullPtr
, _listenTokens :: Map InfoHash [OpToken]
_listenTokens = Map InfoHash [OpToken]
forall k a. Map k a
Map.empty
, _permanentValues :: [Value]
_permanentValues = []
}
DhtRunnerState
finalDhtRunnerState <- IO DhtRunnerState -> Dht DhtRunnerState
forall a. IO a -> Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DhtRunnerState -> Dht DhtRunnerState)
-> IO DhtRunnerState -> Dht DhtRunnerState
forall a b. (a -> b) -> a -> b
$ STM DhtRunnerState -> IO DhtRunnerState
forall a. STM a -> IO a
atomically (STM DhtRunnerState -> IO DhtRunnerState)
-> STM DhtRunnerState -> IO DhtRunnerState
forall a b. (a -> b) -> a -> b
$ TVar DhtRunnerState -> DhtRunnerState -> STM DhtRunnerState
forall a. TVar a -> a -> STM a
swapTVar TVar DhtRunnerState
dhtRunnerStateTV DhtRunnerState
emptyDhtRunnerState
[OpToken] -> (OpToken -> Dht ()) -> Dht ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map InfoHash [OpToken] -> [(InfoHash, [OpToken])]
forall k a. Map k a -> [(k, a)]
Map.toList (DhtRunnerState
finalDhtRunnerStateDhtRunnerState
-> Getting
(Map InfoHash [OpToken]) DhtRunnerState (Map InfoHash [OpToken])
-> Map InfoHash [OpToken]
forall s a. s -> Getting a s a -> a
^.Getting
(Map InfoHash [OpToken]) DhtRunnerState (Map InfoHash [OpToken])
Lens' DhtRunnerState (Map InfoHash [OpToken])
listenTokens) [(InfoHash, [OpToken])]
-> Getting [OpToken] [(InfoHash, [OpToken])] [OpToken] -> [OpToken]
forall s a. s -> Getting a s a -> a
^. ((InfoHash, [OpToken]) -> Const [OpToken] (InfoHash, [OpToken]))
-> [(InfoHash, [OpToken])]
-> Const [OpToken] [(InfoHash, [OpToken])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (((InfoHash, [OpToken]) -> Const [OpToken] (InfoHash, [OpToken]))
-> [(InfoHash, [OpToken])]
-> Const [OpToken] [(InfoHash, [OpToken])])
-> (([OpToken] -> Const [OpToken] [OpToken])
-> (InfoHash, [OpToken]) -> Const [OpToken] (InfoHash, [OpToken]))
-> Getting [OpToken] [(InfoHash, [OpToken])] [OpToken]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([OpToken] -> Const [OpToken] [OpToken])
-> (InfoHash, [OpToken]) -> Const [OpToken] (InfoHash, [OpToken])
forall s t a b. Field2 s t a b => Lens s t a b
Lens
(InfoHash, [OpToken]) (InfoHash, [OpToken]) [OpToken] [OpToken]
_2) OpToken -> Dht ()
deleteOpToken
getDhtRunner :: DhtRunnerM Dht DhtRunner
getDhtRunner :: DhtRunnerM Dht DhtRunner
getDhtRunner = DhtRunnerM Dht (TVar DhtRunnerState)
forall r (m :: * -> *). MonadReader r m => m r
ask DhtRunnerM Dht (TVar DhtRunnerState)
-> (TVar DhtRunnerState -> DhtRunnerM Dht DhtRunnerState)
-> DhtRunnerM Dht DhtRunnerState
forall a b.
DhtRunnerM Dht a -> (a -> DhtRunnerM Dht b) -> DhtRunnerM Dht b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO DhtRunnerState -> DhtRunnerM Dht DhtRunnerState
forall a. IO a -> DhtRunnerM Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DhtRunnerState -> DhtRunnerM Dht DhtRunnerState)
-> (TVar DhtRunnerState -> IO DhtRunnerState)
-> TVar DhtRunnerState
-> DhtRunnerM Dht DhtRunnerState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar DhtRunnerState -> IO DhtRunnerState
forall a. TVar a -> IO a
readTVarIO DhtRunnerM Dht DhtRunnerState
-> (DhtRunnerState -> DhtRunner) -> DhtRunnerM Dht DhtRunner
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> DhtRunnerState -> DhtRunner
_dhtRunner
infohashFromDhtRunner :: (CDhtRunnerPtr -> CInfoHashPtr -> IO ()) -> DhtRunnerM Dht InfoHash
infohashFromDhtRunner :: (CDhtRunnerPtr -> CInfoHashPtr -> IO ()) -> DhtRunnerM Dht InfoHash
infohashFromDhtRunner CDhtRunnerPtr -> CInfoHashPtr -> IO ()
f = DhtRunnerM Dht DhtRunner
getDhtRunner DhtRunnerM Dht DhtRunner
-> (DhtRunner -> DhtRunnerM Dht String) -> DhtRunnerM Dht String
forall a b.
DhtRunnerM Dht a -> (a -> DhtRunnerM Dht b) -> DhtRunnerM Dht b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DhtRunner -> DhtRunnerM Dht String
forall {m :: * -> *}. MonadIO m => DhtRunner -> m String
fromDhtRunner DhtRunnerM Dht String
-> (String -> InfoHash) -> DhtRunnerM Dht InfoHash
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> InfoHash
InfoHash
where fromDhtRunner :: DhtRunner -> m String
fromDhtRunner DhtRunner
dhtrunner = IO String -> m String
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ (CInfoHashPtr -> IO String) -> IO String
forall b. (CInfoHashPtr -> IO b) -> IO b
withCInfohash ((CInfoHashPtr -> IO String) -> IO String)
-> (CInfoHashPtr -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \ CInfoHashPtr
hPtr -> do
CDhtRunnerPtr -> CInfoHashPtr -> IO ()
f (DhtRunner -> CDhtRunnerPtr
_dhtRunnerPtr DhtRunner
dhtrunner) CInfoHashPtr
hPtr
CInfoHashPtr -> IO String
infoHashToString CInfoHashPtr
hPtr
foreign import ccall "wr_dht_runner_get_node_id" dhtRunnerGetNodeIdC :: CDhtRunnerPtr -> CInfoHashPtr -> IO ()
getNodeIdHash :: DhtRunnerM Dht InfoHash
getNodeIdHash :: DhtRunnerM Dht InfoHash
getNodeIdHash = (CDhtRunnerPtr -> CInfoHashPtr -> IO ()) -> DhtRunnerM Dht InfoHash
infohashFromDhtRunner CDhtRunnerPtr -> CInfoHashPtr -> IO ()
dhtRunnerGetNodeIdC
foreign import ccall "wr_dht_runner_get_id" dhtRunnerGetIdC :: CDhtRunnerPtr -> CInfoHashPtr -> IO ()
getPublicKeyID :: DhtRunnerM Dht InfoHash
getPublicKeyID :: DhtRunnerM Dht InfoHash
getPublicKeyID = (CDhtRunnerPtr -> CInfoHashPtr -> IO ()) -> DhtRunnerM Dht InfoHash
infohashFromDhtRunner CDhtRunnerPtr -> CInfoHashPtr -> IO ()
dhtRunnerGetIdC
getPermanentMetaValues :: DhtRunnerM Dht [Value]
getPermanentMetaValues :: DhtRunnerM Dht [Value]
getPermanentMetaValues = DhtRunnerM Dht (TVar DhtRunnerState)
forall r (m :: * -> *). MonadReader r m => m r
ask DhtRunnerM Dht (TVar DhtRunnerState)
-> (TVar DhtRunnerState -> DhtRunnerM Dht DhtRunnerState)
-> DhtRunnerM Dht DhtRunnerState
forall a b.
DhtRunnerM Dht a -> (a -> DhtRunnerM Dht b) -> DhtRunnerM Dht b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO DhtRunnerState -> DhtRunnerM Dht DhtRunnerState
forall a. IO a -> DhtRunnerM Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DhtRunnerState -> DhtRunnerM Dht DhtRunnerState)
-> (TVar DhtRunnerState -> IO DhtRunnerState)
-> TVar DhtRunnerState
-> DhtRunnerM Dht DhtRunnerState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar DhtRunnerState -> IO DhtRunnerState
forall a. TVar a -> IO a
readTVarIO DhtRunnerM Dht DhtRunnerState
-> (DhtRunnerState -> [Value]) -> DhtRunnerM Dht [Value]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> DhtRunnerState -> [Value]
_permanentValues
getListenTokens :: DhtRunnerM Dht OpTokenMap
getListenTokens :: DhtRunnerM Dht (Map InfoHash [OpToken])
getListenTokens = DhtRunnerM Dht (TVar DhtRunnerState)
forall r (m :: * -> *). MonadReader r m => m r
ask DhtRunnerM Dht (TVar DhtRunnerState)
-> (TVar DhtRunnerState -> DhtRunnerM Dht DhtRunnerState)
-> DhtRunnerM Dht DhtRunnerState
forall a b.
DhtRunnerM Dht a -> (a -> DhtRunnerM Dht b) -> DhtRunnerM Dht b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO DhtRunnerState -> DhtRunnerM Dht DhtRunnerState
forall a. IO a -> DhtRunnerM Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DhtRunnerState -> DhtRunnerM Dht DhtRunnerState)
-> (TVar DhtRunnerState -> IO DhtRunnerState)
-> TVar DhtRunnerState
-> DhtRunnerM Dht DhtRunnerState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar DhtRunnerState -> IO DhtRunnerState
forall a. TVar a -> IO a
readTVarIO DhtRunnerM Dht DhtRunnerState
-> (DhtRunnerState -> Map InfoHash [OpToken])
-> DhtRunnerM Dht (Map InfoHash [OpToken])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> DhtRunnerState -> Map InfoHash [OpToken]
_listenTokens
foreign import ccall "dht_runner_run" dhtRunnerRunC :: CDhtRunnerPtr -> CInt -> IO CInt
run :: Word16
-> DhtRunnerM Dht ()
run :: Word16 -> DhtRunnerM Dht ()
run Word16
port = do
DhtRunner
dhtrunner <- DhtRunnerM Dht DhtRunner
getDhtRunner
DhtRunnerM Dht CInt -> DhtRunnerM Dht ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (DhtRunnerM Dht CInt -> DhtRunnerM Dht ())
-> DhtRunnerM Dht CInt -> DhtRunnerM Dht ()
forall a b. (a -> b) -> a -> b
$ IO CInt -> DhtRunnerM Dht CInt
forall a. IO a -> DhtRunnerM Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> DhtRunnerM Dht CInt) -> IO CInt -> DhtRunnerM Dht CInt
forall a b. (a -> b) -> a -> b
$ CDhtRunnerPtr -> CInt -> IO CInt
dhtRunnerRunC (DhtRunner -> CDhtRunnerPtr
_dhtRunnerPtr DhtRunner
dhtrunner) (Word16 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
port)
withDhtRunnerConfig :: DhtRunnerConfig -> (Ptr CDhtRunnerConfig -> Dht a) -> Dht a
withDhtRunnerConfig :: forall a.
DhtRunnerConfig -> (Ptr CDhtRunnerConfig -> Dht a) -> Dht a
withDhtRunnerConfig DhtRunnerConfig
dhtConf Ptr CDhtRunnerConfig -> Dht a
dhtActionWithConfig = IO a -> Dht a
forall a. IO a -> Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Dht a) -> IO a -> Dht a
forall a b. (a -> b) -> a -> b
$
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString (DhtRunnerConfig
dhtConfDhtRunnerConfig -> Getting String DhtRunnerConfig String -> String
forall s a. s -> Getting a s a -> a
^.Getting String DhtRunnerConfig String
Lens' DhtRunnerConfig String
proxyServer) ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ CString
proxyServerPtr ->
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString (DhtRunnerConfig
dhtConfDhtRunnerConfig -> Getting String DhtRunnerConfig String -> String
forall s a. s -> Getting a s a -> a
^.Getting String DhtRunnerConfig String
Lens' DhtRunnerConfig String
pushNodeId) ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ CString
pushNodeIdPtr ->
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString (DhtRunnerConfig
dhtConfDhtRunnerConfig -> Getting String DhtRunnerConfig String -> String
forall s a. s -> Getting a s a -> a
^.Getting String DhtRunnerConfig String
Lens' DhtRunnerConfig String
pushToken) ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ CString
pushTokenPtr ->
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString (DhtRunnerConfig
dhtConfDhtRunnerConfig -> Getting String DhtRunnerConfig String -> String
forall s a. s -> Getting a s a -> a
^.Getting String DhtRunnerConfig String
Lens' DhtRunnerConfig String
pushTopic) ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ CString
pushTopicPtr ->
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString (DhtRunnerConfig
dhtConfDhtRunnerConfig -> Getting String DhtRunnerConfig String -> String
forall s a. s -> Getting a s a -> a
^.Getting String DhtRunnerConfig String
Lens' DhtRunnerConfig String
pushPlatform) ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ CString
pushPlatformPtr ->
(Ptr CDhtIdentity -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDhtIdentity -> IO a) -> IO a)
-> (Ptr CDhtIdentity -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ Ptr CDhtIdentity
clientIdentityPtr ->
(Ptr CDhtSecureConfig -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDhtSecureConfig -> IO a) -> IO a)
-> (Ptr CDhtSecureConfig -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ Ptr CDhtSecureConfig
dhtConfigPtr ->
(Ptr CDhtNodeConfig -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDhtNodeConfig -> IO a) -> IO a)
-> (Ptr CDhtNodeConfig -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ Ptr CDhtNodeConfig
nodeConfigPtr ->
(Ptr CDhtIdentity -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDhtIdentity -> IO a) -> IO a)
-> (Ptr CDhtIdentity -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ Ptr CDhtIdentity
nodeIdPtr ->
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString (DhtRunnerConfig
dhtConfDhtRunnerConfig -> Getting String DhtRunnerConfig String -> String
forall s a. s -> Getting a s a -> a
^.(DhtSecureConfig -> Const String DhtSecureConfig)
-> DhtRunnerConfig -> Const String DhtRunnerConfig
Lens' DhtRunnerConfig DhtSecureConfig
dhtConfig((DhtSecureConfig -> Const String DhtSecureConfig)
-> DhtRunnerConfig -> Const String DhtRunnerConfig)
-> ((String -> Const String String)
-> DhtSecureConfig -> Const String DhtSecureConfig)
-> Getting String DhtRunnerConfig String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(DhtNodeConfig -> Const String DhtNodeConfig)
-> DhtSecureConfig -> Const String DhtSecureConfig
Lens' DhtSecureConfig DhtNodeConfig
nodeConfig((DhtNodeConfig -> Const String DhtNodeConfig)
-> DhtSecureConfig -> Const String DhtSecureConfig)
-> ((String -> Const String String)
-> DhtNodeConfig -> Const String DhtNodeConfig)
-> (String -> Const String String)
-> DhtSecureConfig
-> Const String DhtSecureConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(String -> Const String String)
-> DhtNodeConfig -> Const String DhtNodeConfig
Lens' DhtNodeConfig String
persistPath) ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ CString
persistPathPtr ->
(CInfoHashPtr -> IO a) -> IO a
forall b. (CInfoHashPtr -> IO b) -> IO b
withCInfohash ((CInfoHashPtr -> IO a) -> IO a) -> (CInfoHashPtr -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ CInfoHashPtr
nodeIdHashPtr ->
String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString (Maybe InfoHash -> String
forall a. Show a => a -> String
show (Maybe InfoHash -> String) -> Maybe InfoHash -> String
forall a b. (a -> b) -> a -> b
$ DhtRunnerConfig
dhtConfDhtRunnerConfig
-> Getting (Maybe InfoHash) DhtRunnerConfig (Maybe InfoHash)
-> Maybe InfoHash
forall s a. s -> Getting a s a -> a
^.(DhtSecureConfig -> Const (Maybe InfoHash) DhtSecureConfig)
-> DhtRunnerConfig -> Const (Maybe InfoHash) DhtRunnerConfig
Lens' DhtRunnerConfig DhtSecureConfig
dhtConfig((DhtSecureConfig -> Const (Maybe InfoHash) DhtSecureConfig)
-> DhtRunnerConfig -> Const (Maybe InfoHash) DhtRunnerConfig)
-> ((Maybe InfoHash -> Const (Maybe InfoHash) (Maybe InfoHash))
-> DhtSecureConfig -> Const (Maybe InfoHash) DhtSecureConfig)
-> Getting (Maybe InfoHash) DhtRunnerConfig (Maybe InfoHash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(DhtNodeConfig -> Const (Maybe InfoHash) DhtNodeConfig)
-> DhtSecureConfig -> Const (Maybe InfoHash) DhtSecureConfig
Lens' DhtSecureConfig DhtNodeConfig
nodeConfig((DhtNodeConfig -> Const (Maybe InfoHash) DhtNodeConfig)
-> DhtSecureConfig -> Const (Maybe InfoHash) DhtSecureConfig)
-> ((Maybe InfoHash -> Const (Maybe InfoHash) (Maybe InfoHash))
-> DhtNodeConfig -> Const (Maybe InfoHash) DhtNodeConfig)
-> (Maybe InfoHash -> Const (Maybe InfoHash) (Maybe InfoHash))
-> DhtSecureConfig
-> Const (Maybe InfoHash) DhtSecureConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe InfoHash -> Const (Maybe InfoHash) (Maybe InfoHash))
-> DhtNodeConfig -> Const (Maybe InfoHash) DhtNodeConfig
Lens' DhtNodeConfig (Maybe InfoHash)
nodeIdHash) ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ CString
nodeIdHashStrPtr ->
(Ptr CDhtRunnerConfig -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDhtRunnerConfig -> IO a) -> IO a)
-> (Ptr CDhtRunnerConfig -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ Ptr CDhtRunnerConfig
dhtRunnerConfigPtr ->
Dht a -> IO a
forall a. Dht a -> IO a
unDht (Dht a -> IO a) -> Dht a -> IO a
forall a b. (a -> b) -> a -> b
$ do
(CCertificate CDhtRunnerPtr
serverCaPtr) <- Certificate -> Dht CCertificate
Certificate.fromBytes (Certificate -> Dht CCertificate)
-> Certificate -> Dht CCertificate
forall a b. (a -> b) -> a -> b
$ DhtRunnerConfig
dhtConf DhtRunnerConfig
-> Getting Certificate DhtRunnerConfig Certificate -> Certificate
forall s a. s -> Getting a s a -> a
^. Getting Certificate DhtRunnerConfig Certificate
Lens' DhtRunnerConfig Certificate
serverCa
Maybe CPrivateKey
mClientIdentityPvkPtr <- MaybeT Dht CPrivateKey -> Dht (Maybe CPrivateKey)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Dht CPrivateKey -> Dht (Maybe CPrivateKey))
-> MaybeT Dht CPrivateKey -> Dht (Maybe CPrivateKey)
forall a b. (a -> b) -> a -> b
$ Certificate -> String -> MaybeT Dht CPrivateKey
PrivateKey.fromBytes (DhtRunnerConfig
dhtConf DhtRunnerConfig
-> Getting Certificate DhtRunnerConfig Certificate -> Certificate
forall s a. s -> Getting a s a -> a
^. (DhtIdentity -> Const Certificate DhtIdentity)
-> DhtRunnerConfig -> Const Certificate DhtRunnerConfig
Lens' DhtRunnerConfig DhtIdentity
clientIdentity ((DhtIdentity -> Const Certificate DhtIdentity)
-> DhtRunnerConfig -> Const Certificate DhtRunnerConfig)
-> ((Certificate -> Const Certificate Certificate)
-> DhtIdentity -> Const Certificate DhtIdentity)
-> Getting Certificate DhtRunnerConfig Certificate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrivateKey -> Const Certificate PrivateKey)
-> DhtIdentity -> Const Certificate DhtIdentity
Lens' DhtIdentity PrivateKey
privatekey ((PrivateKey -> Const Certificate PrivateKey)
-> DhtIdentity -> Const Certificate DhtIdentity)
-> ((Certificate -> Const Certificate Certificate)
-> PrivateKey -> Const Certificate PrivateKey)
-> (Certificate -> Const Certificate Certificate)
-> DhtIdentity
-> Const Certificate DhtIdentity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Certificate -> Const Certificate Certificate)
-> PrivateKey -> Const Certificate PrivateKey
Traversal' PrivateKey Certificate
pvkData)
(DhtRunnerConfig
dhtConf DhtRunnerConfig -> Getting String DhtRunnerConfig String -> String
forall s a. s -> Getting a s a -> a
^. (DhtIdentity -> Const String DhtIdentity)
-> DhtRunnerConfig -> Const String DhtRunnerConfig
Lens' DhtRunnerConfig DhtIdentity
clientIdentity ((DhtIdentity -> Const String DhtIdentity)
-> DhtRunnerConfig -> Const String DhtRunnerConfig)
-> ((String -> Const String String)
-> DhtIdentity -> Const String DhtIdentity)
-> Getting String DhtRunnerConfig String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrivateKey -> Const String PrivateKey)
-> DhtIdentity -> Const String DhtIdentity
Lens' DhtIdentity PrivateKey
privatekey ((PrivateKey -> Const String PrivateKey)
-> DhtIdentity -> Const String DhtIdentity)
-> ((String -> Const String String)
-> PrivateKey -> Const String PrivateKey)
-> (String -> Const String String)
-> DhtIdentity
-> Const String DhtIdentity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Const String String)
-> PrivateKey -> Const String PrivateKey
Traversal' PrivateKey String
pvkPassword)
(CCertificate CDhtRunnerPtr
clientIdentityCertPtr) <- Certificate -> Dht CCertificate
Certificate.fromBytes (DhtRunnerConfig
dhtConf DhtRunnerConfig
-> Getting Certificate DhtRunnerConfig Certificate -> Certificate
forall s a. s -> Getting a s a -> a
^. (DhtIdentity -> Const Certificate DhtIdentity)
-> DhtRunnerConfig -> Const Certificate DhtRunnerConfig
Lens' DhtRunnerConfig DhtIdentity
clientIdentity ((DhtIdentity -> Const Certificate DhtIdentity)
-> DhtRunnerConfig -> Const Certificate DhtRunnerConfig)
-> ((Certificate -> Const Certificate Certificate)
-> DhtIdentity -> Const Certificate DhtIdentity)
-> Getting Certificate DhtRunnerConfig Certificate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Certificate -> Const Certificate Certificate)
-> DhtIdentity -> Const Certificate DhtIdentity
Lens' DhtIdentity Certificate
certificate)
Maybe CPrivateKey
mNodeIdentityPvkPtr <- MaybeT Dht CPrivateKey -> Dht (Maybe CPrivateKey)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT Dht CPrivateKey -> Dht (Maybe CPrivateKey))
-> MaybeT Dht CPrivateKey -> Dht (Maybe CPrivateKey)
forall a b. (a -> b) -> a -> b
$ Certificate -> String -> MaybeT Dht CPrivateKey
PrivateKey.fromBytes (DhtRunnerConfig
dhtConf DhtRunnerConfig
-> Getting Certificate DhtRunnerConfig Certificate -> Certificate
forall s a. s -> Getting a s a -> a
^. (DhtSecureConfig -> Const Certificate DhtSecureConfig)
-> DhtRunnerConfig -> Const Certificate DhtRunnerConfig
Lens' DhtRunnerConfig DhtSecureConfig
dhtConfig ((DhtSecureConfig -> Const Certificate DhtSecureConfig)
-> DhtRunnerConfig -> Const Certificate DhtRunnerConfig)
-> ((Certificate -> Const Certificate Certificate)
-> DhtSecureConfig -> Const Certificate DhtSecureConfig)
-> Getting Certificate DhtRunnerConfig Certificate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DhtIdentity -> Const Certificate DhtIdentity)
-> DhtSecureConfig -> Const Certificate DhtSecureConfig
Lens' DhtSecureConfig DhtIdentity
nodeId ((DhtIdentity -> Const Certificate DhtIdentity)
-> DhtSecureConfig -> Const Certificate DhtSecureConfig)
-> ((Certificate -> Const Certificate Certificate)
-> DhtIdentity -> Const Certificate DhtIdentity)
-> (Certificate -> Const Certificate Certificate)
-> DhtSecureConfig
-> Const Certificate DhtSecureConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrivateKey -> Const Certificate PrivateKey)
-> DhtIdentity -> Const Certificate DhtIdentity
Lens' DhtIdentity PrivateKey
privatekey ((PrivateKey -> Const Certificate PrivateKey)
-> DhtIdentity -> Const Certificate DhtIdentity)
-> ((Certificate -> Const Certificate Certificate)
-> PrivateKey -> Const Certificate PrivateKey)
-> (Certificate -> Const Certificate Certificate)
-> DhtIdentity
-> Const Certificate DhtIdentity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Certificate -> Const Certificate Certificate)
-> PrivateKey -> Const Certificate PrivateKey
Traversal' PrivateKey Certificate
pvkData)
(DhtRunnerConfig
dhtConf DhtRunnerConfig -> Getting String DhtRunnerConfig String -> String
forall s a. s -> Getting a s a -> a
^. (DhtSecureConfig -> Const String DhtSecureConfig)
-> DhtRunnerConfig -> Const String DhtRunnerConfig
Lens' DhtRunnerConfig DhtSecureConfig
dhtConfig ((DhtSecureConfig -> Const String DhtSecureConfig)
-> DhtRunnerConfig -> Const String DhtRunnerConfig)
-> ((String -> Const String String)
-> DhtSecureConfig -> Const String DhtSecureConfig)
-> Getting String DhtRunnerConfig String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DhtIdentity -> Const String DhtIdentity)
-> DhtSecureConfig -> Const String DhtSecureConfig
Lens' DhtSecureConfig DhtIdentity
nodeId ((DhtIdentity -> Const String DhtIdentity)
-> DhtSecureConfig -> Const String DhtSecureConfig)
-> ((String -> Const String String)
-> DhtIdentity -> Const String DhtIdentity)
-> (String -> Const String String)
-> DhtSecureConfig
-> Const String DhtSecureConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrivateKey -> Const String PrivateKey)
-> DhtIdentity -> Const String DhtIdentity
Lens' DhtIdentity PrivateKey
privatekey ((PrivateKey -> Const String PrivateKey)
-> DhtIdentity -> Const String DhtIdentity)
-> ((String -> Const String String)
-> PrivateKey -> Const String PrivateKey)
-> (String -> Const String String)
-> DhtIdentity
-> Const String DhtIdentity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Const String String)
-> PrivateKey -> Const String PrivateKey
Traversal' PrivateKey String
pvkPassword)
(CCertificate CDhtRunnerPtr
nodeIdentityCertPtr) <- Certificate -> Dht CCertificate
Certificate.fromBytes (DhtRunnerConfig
dhtConf DhtRunnerConfig
-> Getting Certificate DhtRunnerConfig Certificate -> Certificate
forall s a. s -> Getting a s a -> a
^. (DhtSecureConfig -> Const Certificate DhtSecureConfig)
-> DhtRunnerConfig -> Const Certificate DhtRunnerConfig
Lens' DhtRunnerConfig DhtSecureConfig
dhtConfig ((DhtSecureConfig -> Const Certificate DhtSecureConfig)
-> DhtRunnerConfig -> Const Certificate DhtRunnerConfig)
-> ((Certificate -> Const Certificate Certificate)
-> DhtSecureConfig -> Const Certificate DhtSecureConfig)
-> Getting Certificate DhtRunnerConfig Certificate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DhtIdentity -> Const Certificate DhtIdentity)
-> DhtSecureConfig -> Const Certificate DhtSecureConfig
Lens' DhtSecureConfig DhtIdentity
nodeId ((DhtIdentity -> Const Certificate DhtIdentity)
-> DhtSecureConfig -> Const Certificate DhtSecureConfig)
-> ((Certificate -> Const Certificate Certificate)
-> DhtIdentity -> Const Certificate DhtIdentity)
-> (Certificate -> Const Certificate Certificate)
-> DhtSecureConfig
-> Const Certificate DhtSecureConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Certificate -> Const Certificate Certificate)
-> DhtIdentity -> Const Certificate DhtIdentity
Lens' DhtIdentity Certificate
certificate)
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
$ do
Ptr CDhtSecureConfig -> CDhtSecureConfig -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CDhtSecureConfig
dhtConfigPtr (CDhtSecureConfig -> IO ()) -> CDhtSecureConfig -> IO ()
forall a b. (a -> b) -> a -> b
$ CDhtSecureConfig { _nodeIdC :: Ptr CDhtIdentity
_nodeIdC = Ptr CDhtIdentity
nodeIdPtr
, _nodeConfigC :: Ptr CDhtNodeConfig
_nodeConfigC = Ptr CDhtNodeConfig
nodeConfigPtr
}
Ptr CDhtIdentity -> CDhtIdentity -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CDhtIdentity
nodeIdPtr (CDhtIdentity -> IO ()) -> CDhtIdentity -> IO ()
forall a b. (a -> b) -> a -> b
$ CDhtIdentity { _privatekeyC :: CDhtRunnerPtr
_privatekeyC = CDhtRunnerPtr
-> (CPrivateKey -> CDhtRunnerPtr)
-> Maybe CPrivateKey
-> CDhtRunnerPtr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CDhtRunnerPtr
forall a. Ptr a
nullPtr CPrivateKey -> CDhtRunnerPtr
_privateKeyPtr Maybe CPrivateKey
mNodeIdentityPvkPtr
, _certificateC :: CDhtRunnerPtr
_certificateC = CDhtRunnerPtr
nodeIdentityCertPtr
}
CInfoHashPtr -> CString -> IO ()
dhtInfohashFromHexC CInfoHashPtr
nodeIdHashPtr CString
nodeIdHashStrPtr
Ptr CDhtNodeConfig -> CDhtNodeConfig -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CDhtNodeConfig
nodeConfigPtr (CDhtNodeConfig -> IO ()) -> CDhtNodeConfig -> IO ()
forall a b. (a -> b) -> a -> b
$ CDhtNodeConfig { _persistPathC :: CString
_persistPathC = CString
persistPathPtr
, _nodeIdHashC :: CInfoHashPtr
_nodeIdHashC = CInfoHashPtr
nodeIdHashPtr
, _networkC :: CUInt
_networkC = Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> CUInt) -> Word32 -> CUInt
forall a b. (a -> b) -> a -> b
$ DhtRunnerConfig
dhtConf DhtRunnerConfig -> Getting Word32 DhtRunnerConfig Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. (DhtSecureConfig -> Const Word32 DhtSecureConfig)
-> DhtRunnerConfig -> Const Word32 DhtRunnerConfig
Lens' DhtRunnerConfig DhtSecureConfig
dhtConfig ((DhtSecureConfig -> Const Word32 DhtSecureConfig)
-> DhtRunnerConfig -> Const Word32 DhtRunnerConfig)
-> ((Word32 -> Const Word32 Word32)
-> DhtSecureConfig -> Const Word32 DhtSecureConfig)
-> Getting Word32 DhtRunnerConfig Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DhtNodeConfig -> Const Word32 DhtNodeConfig)
-> DhtSecureConfig -> Const Word32 DhtSecureConfig
Lens' DhtSecureConfig DhtNodeConfig
nodeConfig ((DhtNodeConfig -> Const Word32 DhtNodeConfig)
-> DhtSecureConfig -> Const Word32 DhtSecureConfig)
-> ((Word32 -> Const Word32 Word32)
-> DhtNodeConfig -> Const Word32 DhtNodeConfig)
-> (Word32 -> Const Word32 Word32)
-> DhtSecureConfig
-> Const Word32 DhtSecureConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Const Word32 Word32)
-> DhtNodeConfig -> Const Word32 DhtNodeConfig
Lens' DhtNodeConfig Word32
network
, _maintainStorageC :: Bool
_maintainStorageC = DhtRunnerConfig
dhtConf DhtRunnerConfig -> Getting Bool DhtRunnerConfig Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (DhtSecureConfig -> Const Bool DhtSecureConfig)
-> DhtRunnerConfig -> Const Bool DhtRunnerConfig
Lens' DhtRunnerConfig DhtSecureConfig
dhtConfig ((DhtSecureConfig -> Const Bool DhtSecureConfig)
-> DhtRunnerConfig -> Const Bool DhtRunnerConfig)
-> ((Bool -> Const Bool Bool)
-> DhtSecureConfig -> Const Bool DhtSecureConfig)
-> Getting Bool DhtRunnerConfig Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DhtNodeConfig -> Const Bool DhtNodeConfig)
-> DhtSecureConfig -> Const Bool DhtSecureConfig
Lens' DhtSecureConfig DhtNodeConfig
nodeConfig ((DhtNodeConfig -> Const Bool DhtNodeConfig)
-> DhtSecureConfig -> Const Bool DhtSecureConfig)
-> ((Bool -> Const Bool Bool)
-> DhtNodeConfig -> Const Bool DhtNodeConfig)
-> (Bool -> Const Bool Bool)
-> DhtSecureConfig
-> Const Bool DhtSecureConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> DhtNodeConfig -> Const Bool DhtNodeConfig
Lens' DhtNodeConfig Bool
maintainStorage
, _isBootstrapC :: Bool
_isBootstrapC = DhtRunnerConfig
dhtConf DhtRunnerConfig -> Getting Bool DhtRunnerConfig Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (DhtSecureConfig -> Const Bool DhtSecureConfig)
-> DhtRunnerConfig -> Const Bool DhtRunnerConfig
Lens' DhtRunnerConfig DhtSecureConfig
dhtConfig ((DhtSecureConfig -> Const Bool DhtSecureConfig)
-> DhtRunnerConfig -> Const Bool DhtRunnerConfig)
-> ((Bool -> Const Bool Bool)
-> DhtSecureConfig -> Const Bool DhtSecureConfig)
-> Getting Bool DhtRunnerConfig Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DhtNodeConfig -> Const Bool DhtNodeConfig)
-> DhtSecureConfig -> Const Bool DhtSecureConfig
Lens' DhtSecureConfig DhtNodeConfig
nodeConfig ((DhtNodeConfig -> Const Bool DhtNodeConfig)
-> DhtSecureConfig -> Const Bool DhtSecureConfig)
-> ((Bool -> Const Bool Bool)
-> DhtNodeConfig -> Const Bool DhtNodeConfig)
-> (Bool -> Const Bool Bool)
-> DhtSecureConfig
-> Const Bool DhtSecureConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> DhtNodeConfig -> Const Bool DhtNodeConfig
Lens' DhtNodeConfig Bool
isBootstrap
}
Ptr CDhtIdentity -> CDhtIdentity -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CDhtIdentity
clientIdentityPtr (CDhtIdentity -> IO ()) -> CDhtIdentity -> IO ()
forall a b. (a -> b) -> a -> b
$ CDhtIdentity { _privatekeyC :: CDhtRunnerPtr
_privatekeyC = CDhtRunnerPtr
-> (CPrivateKey -> CDhtRunnerPtr)
-> Maybe CPrivateKey
-> CDhtRunnerPtr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CDhtRunnerPtr
forall a. Ptr a
nullPtr CPrivateKey -> CDhtRunnerPtr
_privateKeyPtr Maybe CPrivateKey
mClientIdentityPvkPtr
, _certificateC :: CDhtRunnerPtr
_certificateC = CDhtRunnerPtr
clientIdentityCertPtr
}
Ptr CDhtRunnerConfig -> CDhtRunnerConfig -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CDhtRunnerConfig
dhtRunnerConfigPtr (CDhtRunnerConfig -> IO ()) -> CDhtRunnerConfig -> IO ()
forall a b. (a -> b) -> a -> b
$ CDhtRunnerConfig { _dhtConfigC :: Ptr CDhtSecureConfig
_dhtConfigC = Ptr CDhtSecureConfig
dhtConfigPtr
, _threadedC :: Bool
_threadedC = Bool
True
, _proxyServerC :: CString
_proxyServerC = CString
proxyServerPtr
, _pushNodeIdC :: CString
_pushNodeIdC = CString
pushNodeIdPtr
, _pushTokenC :: CString
_pushTokenC = CString
pushTokenPtr
, _pushTopicC :: CString
_pushTopicC = CString
pushTopicPtr
, _pushPlatformC :: CString
_pushPlatformC = CString
pushPlatformPtr
, _peerDiscoveryC :: Bool
_peerDiscoveryC = DhtRunnerConfig
dhtConf DhtRunnerConfig -> Getting Bool DhtRunnerConfig Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool DhtRunnerConfig Bool
Lens' DhtRunnerConfig Bool
peerDiscovery
, _peerPublishC :: Bool
_peerPublishC = DhtRunnerConfig
dhtConf DhtRunnerConfig -> Getting Bool DhtRunnerConfig Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool DhtRunnerConfig Bool
Lens' DhtRunnerConfig Bool
peerPublish
, _serverCaC :: CDhtRunnerPtr
_serverCaC = CDhtRunnerPtr
serverCaPtr
, _clientIdentityC :: Ptr CDhtIdentity
_clientIdentityC = Ptr CDhtIdentity
clientIdentityPtr
, _loggingC :: Bool
_loggingC = DhtRunnerConfig
dhtConf DhtRunnerConfig -> Getting Bool DhtRunnerConfig Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool DhtRunnerConfig Bool
Lens' DhtRunnerConfig Bool
logging
}
Ptr CDhtRunnerConfig -> Dht a
dhtActionWithConfig Ptr CDhtRunnerConfig
dhtRunnerConfigPtr
foreign import ccall "wr_dht_runner_run_config" dhtRunnerRunConfigC :: CDhtRunnerPtr -> CShort -> Ptr CDhtRunnerConfig -> IO CInt
runConfig :: Word16
-> DhtRunnerConfig
-> DhtRunnerM Dht ()
runConfig :: Word16 -> DhtRunnerConfig -> DhtRunnerM Dht ()
runConfig Word16
port DhtRunnerConfig
config = do
DhtRunner
dhtrunner <- DhtRunnerM Dht DhtRunner
getDhtRunner
Dht () -> DhtRunnerM Dht ()
forall (m :: * -> *) a. Monad m => m a -> DhtRunnerM m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Dht () -> DhtRunnerM Dht ()) -> Dht () -> DhtRunnerM Dht ()
forall a b. (a -> b) -> a -> b
$ DhtRunnerConfig -> (Ptr CDhtRunnerConfig -> Dht ()) -> Dht ()
forall a.
DhtRunnerConfig -> (Ptr CDhtRunnerConfig -> Dht a) -> Dht a
withDhtRunnerConfig DhtRunnerConfig
config ((Ptr CDhtRunnerConfig -> Dht ()) -> Dht ())
-> (Ptr CDhtRunnerConfig -> Dht ()) -> Dht ()
forall a b. (a -> b) -> a -> b
$ \ Ptr CDhtRunnerConfig
configPtr -> do
Dht CInt -> Dht ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Dht CInt -> Dht ()) -> Dht CInt -> Dht ()
forall a b. (a -> b) -> a -> b
$ IO CInt -> Dht CInt
forall a. IO a -> Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> Dht CInt) -> IO CInt -> Dht CInt
forall a b. (a -> b) -> a -> b
$ CDhtRunnerPtr -> CShort -> Ptr CDhtRunnerConfig -> IO CInt
dhtRunnerRunConfigC (DhtRunner -> CDhtRunnerPtr
_dhtRunnerPtr DhtRunner
dhtrunner) (Word16 -> CShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
port) Ptr CDhtRunnerConfig
configPtr
foreign import ccall "dht_runner_is_running" dhtRunnerIsRunningC :: CDhtRunnerPtr -> IO CBool
isRunning :: DhtRunnerM Dht Bool
isRunning :: DhtRunnerM Dht Bool
isRunning = DhtRunnerM Dht DhtRunner
getDhtRunner DhtRunnerM Dht DhtRunner
-> (DhtRunner -> DhtRunnerM Dht Bool) -> DhtRunnerM Dht Bool
forall a b.
DhtRunnerM Dht a -> (a -> DhtRunnerM Dht b) -> DhtRunnerM Dht b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO Bool -> DhtRunnerM Dht Bool
forall a. IO a -> DhtRunnerM Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> DhtRunnerM Dht Bool)
-> (DhtRunner -> IO Bool) -> DhtRunner -> DhtRunnerM Dht Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CBool -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO CBool -> IO Bool)
-> (DhtRunner -> IO CBool) -> DhtRunner -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDhtRunnerPtr -> IO CBool
dhtRunnerIsRunningC (CDhtRunnerPtr -> IO CBool)
-> (DhtRunner -> CDhtRunnerPtr) -> DhtRunner -> IO CBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DhtRunner -> CDhtRunnerPtr
_dhtRunnerPtr
foreign import ccall "dht_runner_bootstrap" dhtRunnerBootstrapC :: CDhtRunnerPtr -> Ptr CChar -> Ptr CChar -> IO ()
bootstrap :: String
-> String
-> DhtRunnerM Dht ()
bootstrap :: String -> String -> DhtRunnerM Dht ()
bootstrap String
addr String
port = do
DhtRunner
dhtrunner <- DhtRunnerM Dht DhtRunner
getDhtRunner
IO () -> DhtRunnerM Dht ()
forall a. IO a -> DhtRunnerM Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DhtRunnerM Dht ()) -> IO () -> DhtRunnerM Dht ()
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
addr ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
addrCPtr ->
String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
port ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
portCPtr -> CDhtRunnerPtr -> CString -> CString -> IO ()
dhtRunnerBootstrapC (DhtRunner -> CDhtRunnerPtr
_dhtRunnerPtr DhtRunner
dhtrunner) CString
addrCPtr CString
portCPtr
foreign import ccall "dht_runner_get"
dhtRunnerGetC :: CDhtRunnerPtr -> CInfoHashPtr -> FunPtr CGetCallback -> FunPtr CDoneCallback -> Ptr () -> IO ()
get :: InfoHash
-> GetCallback
-> DoneCallback
-> DhtRunnerM Dht ()
get :: InfoHash -> GetCallback -> DoneCallback -> DhtRunnerM Dht ()
get InfoHash
h GetCallback
gcb DoneCallback
dcb = DhtRunnerM Dht DhtRunner
getDhtRunner DhtRunnerM Dht DhtRunner
-> (DhtRunner -> DhtRunnerM Dht ()) -> DhtRunnerM Dht ()
forall a b.
DhtRunnerM Dht a -> (a -> DhtRunnerM Dht b) -> DhtRunnerM Dht b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ DhtRunner
dhtrunner -> IO () -> DhtRunnerM Dht ()
forall a. IO a -> DhtRunnerM Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DhtRunnerM Dht ()) -> IO () -> DhtRunnerM Dht ()
forall a b. (a -> b) -> a -> b
$ do
String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString (InfoHash -> String
forall a. Show a => a -> String
show InfoHash
h) ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
hStrPtr -> (CInfoHashPtr -> IO ()) -> IO ()
forall b. (CInfoHashPtr -> IO b) -> IO b
withCInfohash ((CInfoHashPtr -> IO ()) -> IO ())
-> (CInfoHashPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CInfoHashPtr
hPtr -> () -> CShutdownCallback -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with () (CShutdownCallback -> IO ()) -> CShutdownCallback -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CDhtRunnerPtr
userdataPtr -> do
CInfoHashPtr -> CString -> IO ()
dhtInfohashFromHexC CInfoHashPtr
hPtr CString
hStrPtr
FunPtr CGetCallback
gcbCWrapped <- CGetCallback -> IO (FunPtr CGetCallback)
wrapGetCallbackC (CGetCallback -> IO (FunPtr CGetCallback))
-> CGetCallback -> IO (FunPtr CGetCallback)
forall a b. (a -> b) -> a -> b
$ GetCallback -> CGetCallback
fromGetCallBack GetCallback
gcb
FunPtr CDoneCallback
dcbCWrapped <- CDoneCallback -> IO (FunPtr CDoneCallback)
wrapDoneCallbackC (CDoneCallback -> IO (FunPtr CDoneCallback))
-> CDoneCallback -> IO (FunPtr CDoneCallback)
forall a b. (a -> b) -> a -> b
$ DoneCallback -> CDoneCallback
fromDoneCallback DoneCallback
dcb
CDhtRunnerPtr
-> CInfoHashPtr
-> FunPtr CGetCallback
-> FunPtr CDoneCallback
-> CShutdownCallback
dhtRunnerGetC (DhtRunner -> CDhtRunnerPtr
_dhtRunnerPtr DhtRunner
dhtrunner) CInfoHashPtr
hPtr FunPtr CGetCallback
gcbCWrapped FunPtr CDoneCallback
dcbCWrapped CDhtRunnerPtr
userdataPtr
foreign import ccall "dht_runner_put"
dhtRunnerPutC :: CDhtRunnerPtr -> CInfoHashPtr -> CValuePtr -> FunPtr CDoneCallback -> Ptr () -> CBool -> IO ()
put :: InfoHash
-> Value
-> DoneCallback
-> Bool
-> DhtRunnerM Dht Word64
put :: InfoHash -> Value -> DoneCallback -> Bool -> DhtRunnerM Dht Word64
put InfoHash
h (InputValue Certificate
vbs String
usertype) DoneCallback
dcb Bool
permanent = DhtRunnerM Dht (TVar DhtRunnerState)
forall r (m :: * -> *). MonadReader r m => m r
ask DhtRunnerM Dht (TVar DhtRunnerState)
-> (TVar DhtRunnerState -> DhtRunnerM Dht Word64)
-> DhtRunnerM Dht Word64
forall a b.
DhtRunnerM Dht a -> (a -> DhtRunnerM Dht b) -> DhtRunnerM Dht b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ TVar DhtRunnerState
dhtRunnerStateTV -> do
DhtRunner
dhtrunner <- DhtRunnerM Dht DhtRunner
getDhtRunner
IO Word64 -> DhtRunnerM Dht Word64
forall a. IO a -> DhtRunnerM Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> DhtRunnerM Dht Word64)
-> IO Word64 -> DhtRunnerM Dht Word64
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO Word64) -> IO Word64
forall a. String -> (CString -> IO a) -> IO a
withCString (InfoHash -> String
forall a. Show a => a -> String
show InfoHash
h) ((CString -> IO Word64) -> IO Word64)
-> (CString -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \ CString
hStrPtr -> (CInfoHashPtr -> IO Word64) -> IO Word64
forall b. (CInfoHashPtr -> IO b) -> IO b
withCInfohash ((CInfoHashPtr -> IO Word64) -> IO Word64)
-> (CInfoHashPtr -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \ CInfoHashPtr
hPtr -> () -> (CDhtRunnerPtr -> IO Word64) -> IO Word64
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with () ((CDhtRunnerPtr -> IO Word64) -> IO Word64)
-> (CDhtRunnerPtr -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \ CDhtRunnerPtr
userdataPtr -> do
CInfoHashPtr -> CString -> IO ()
dhtInfohashFromHexC CInfoHashPtr
hPtr CString
hStrPtr
FunPtr CDoneCallback
dcbCWrapped <- CDoneCallback -> IO (FunPtr CDoneCallback)
wrapDoneCallbackC (CDoneCallback -> IO (FunPtr CDoneCallback))
-> CDoneCallback -> IO (FunPtr CDoneCallback)
forall a b. (a -> b) -> a -> b
$ DoneCallback -> CDoneCallback
fromDoneCallback DoneCallback
dcb
Word64
randomVID <- IO Word64
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
Dht () -> IO ()
forall a. Dht a -> IO a
unDht (Dht () -> IO ()) -> Dht () -> IO ()
forall a b. (a -> b) -> a -> b
$ Certificate -> Word64 -> (CDhtRunnerPtr -> Dht ()) -> Dht ()
withValuePtrFromBytes Certificate
vbs Word64
randomVID ((CDhtRunnerPtr -> Dht ()) -> Dht ())
-> (CDhtRunnerPtr -> Dht ()) -> Dht ()
forall a b. (a -> b) -> a -> b
$ \ CDhtRunnerPtr
vPtr -> do
Value
metav <- CDhtRunnerPtr -> Dht Value
metaValueFromCValuePtr CDhtRunnerPtr
vPtr
Bool -> Dht () -> Dht ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
permanent (Dht () -> Dht ()) -> Dht () -> Dht ()
forall a b. (a -> b) -> a -> b
$ 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
$ STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$
TVar DhtRunnerState -> (DhtRunnerState -> DhtRunnerState) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar DhtRunnerState
dhtRunnerStateTV ((DhtRunnerState -> DhtRunnerState) -> STM ())
-> (DhtRunnerState -> DhtRunnerState) -> STM ()
forall a b. (a -> b) -> a -> b
$ \ DhtRunnerState
s -> DhtRunnerState
s DhtRunnerState
-> (DhtRunnerState -> DhtRunnerState) -> DhtRunnerState
forall a b. a -> (a -> b) -> b
& ([Value] -> Identity [Value])
-> DhtRunnerState -> Identity DhtRunnerState
Lens' DhtRunnerState [Value]
permanentValues (([Value] -> Identity [Value])
-> DhtRunnerState -> Identity DhtRunnerState)
-> ([Value] -> [Value]) -> DhtRunnerState -> DhtRunnerState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Value
metavValue -> [Value] -> [Value]
forall a. a -> [a] -> [a]
:)
CDhtRunnerPtr -> String -> Dht ()
setValueUserType CDhtRunnerPtr
vPtr String
usertype
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
$ CDhtRunnerPtr
-> CInfoHashPtr
-> CDhtRunnerPtr
-> FunPtr CDoneCallback
-> CDhtRunnerPtr
-> CBool
-> IO ()
dhtRunnerPutC (DhtRunner -> CDhtRunnerPtr
_dhtRunnerPtr DhtRunner
dhtrunner) CInfoHashPtr
hPtr CDhtRunnerPtr
vPtr FunPtr CDoneCallback
dcbCWrapped CDhtRunnerPtr
userdataPtr (Bool -> CBool
forall a. Num a => Bool -> a
fromBool Bool
permanent)
Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
randomVID
put InfoHash
_ Value
_ DoneCallback
_ Bool
_ = String -> DhtRunnerM Dht Word64
forall a. HasCallStack => String -> a
error String
"DhtRunner.put needs to be fed an InputValue!"
foreign import ccall "dht_runner_cancel_put" dhtRunnerCancelPutC :: CDhtRunnerPtr -> CInfoHashPtr -> CULLong -> IO ()
cancelPut :: InfoHash
-> Word64
-> DhtRunnerM Dht ()
cancelPut :: InfoHash -> Word64 -> DhtRunnerM Dht ()
cancelPut InfoHash
h Word64
vid = DhtRunnerM Dht (TVar DhtRunnerState)
forall r (m :: * -> *). MonadReader r m => m r
ask DhtRunnerM Dht (TVar DhtRunnerState)
-> (TVar DhtRunnerState -> DhtRunnerM Dht ()) -> DhtRunnerM Dht ()
forall a b.
DhtRunnerM Dht a -> (a -> DhtRunnerM Dht b) -> DhtRunnerM Dht b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ TVar DhtRunnerState
dhtRunnerStateTV -> do
DhtRunner
dhtrunner <- DhtRunnerM Dht DhtRunner
getDhtRunner
IO () -> DhtRunnerM Dht ()
forall a. IO a -> DhtRunnerM Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DhtRunnerM Dht ()) -> IO () -> DhtRunnerM Dht ()
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString (InfoHash -> String
forall a. Show a => a -> String
show InfoHash
h) ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
hStrPtr -> (CInfoHashPtr -> IO ()) -> IO ()
forall b. (CInfoHashPtr -> IO b) -> IO b
withCInfohash ((CInfoHashPtr -> IO ()) -> IO ())
-> (CInfoHashPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CInfoHashPtr
hPtr -> do
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar DhtRunnerState -> (DhtRunnerState -> DhtRunnerState) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar DhtRunnerState
dhtRunnerStateTV ((DhtRunnerState -> DhtRunnerState) -> STM ())
-> (DhtRunnerState -> DhtRunnerState) -> STM ()
forall a b. (a -> b) -> a -> b
$ \ DhtRunnerState
s -> DhtRunnerState
s DhtRunnerState
-> (DhtRunnerState -> DhtRunnerState) -> DhtRunnerState
forall a b. a -> (a -> b) -> b
& ([Value] -> Identity [Value])
-> DhtRunnerState -> Identity DhtRunnerState
Lens' DhtRunnerState [Value]
permanentValues (([Value] -> Identity [Value])
-> DhtRunnerState -> Identity DhtRunnerState)
-> ([Value] -> [Value]) -> DhtRunnerState -> DhtRunnerState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Value -> Bool) -> [Value] -> [Value]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/=Word64
vid) (Word64 -> Bool) -> (Value -> Word64) -> Value -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Word64
_valueId)
CInfoHashPtr -> CString -> IO ()
dhtInfohashFromHexC CInfoHashPtr
hPtr CString
hStrPtr
CDhtRunnerPtr -> CInfoHashPtr -> CULLong -> IO ()
dhtRunnerCancelPutC (DhtRunner -> CDhtRunnerPtr
_dhtRunnerPtr DhtRunner
dhtrunner) CInfoHashPtr
hPtr (Word64 -> CULLong
CULLong Word64
vid)
foreign import ccall "dht_runner_listen"
dhtRunnerListenC :: CDhtRunnerPtr -> CInfoHashPtr -> FunPtr CValueCallback -> FunPtr CShutdownCallback -> Ptr () -> IO (Ptr ())
listen :: InfoHash
-> ValueCallback
-> ShutdownCallback
-> DhtRunnerM Dht OpToken
listen :: InfoHash -> ValueCallback -> IO () -> DhtRunnerM Dht OpToken
listen InfoHash
h ValueCallback
vcb IO ()
scb = DhtRunnerM Dht (TVar DhtRunnerState)
forall r (m :: * -> *). MonadReader r m => m r
ask DhtRunnerM Dht (TVar DhtRunnerState)
-> (TVar DhtRunnerState -> DhtRunnerM Dht OpToken)
-> DhtRunnerM Dht OpToken
forall a b.
DhtRunnerM Dht a -> (a -> DhtRunnerM Dht b) -> DhtRunnerM Dht b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ TVar DhtRunnerState
dhtRunnerStateTV -> do
DhtRunner
dhtrunner <- DhtRunnerM Dht DhtRunner
getDhtRunner
TVar (Maybe OpToken)
tokenTVar <- IO (TVar (Maybe OpToken)) -> DhtRunnerM Dht (TVar (Maybe OpToken))
forall a. IO a -> DhtRunnerM Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TVar (Maybe OpToken))
-> DhtRunnerM Dht (TVar (Maybe OpToken)))
-> IO (TVar (Maybe OpToken))
-> DhtRunnerM Dht (TVar (Maybe OpToken))
forall a b. (a -> b) -> a -> b
$ Maybe OpToken -> IO (TVar (Maybe OpToken))
forall a. a -> IO (TVar a)
newTVarIO Maybe OpToken
forall a. Maybe a
Nothing
OpToken
token <- IO OpToken -> DhtRunnerM Dht OpToken
forall a. IO a -> DhtRunnerM Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO OpToken -> DhtRunnerM Dht OpToken)
-> IO OpToken -> DhtRunnerM Dht OpToken
forall a b. (a -> b) -> a -> b
$ do
String -> (CString -> IO OpToken) -> IO OpToken
forall a. String -> (CString -> IO a) -> IO a
withCString (InfoHash -> String
forall a. Show a => a -> String
show InfoHash
h) ((CString -> IO OpToken) -> IO OpToken)
-> (CString -> IO OpToken) -> IO OpToken
forall a b. (a -> b) -> a -> b
$ \ CString
hStrPtr -> (CInfoHashPtr -> IO OpToken) -> IO OpToken
forall b. (CInfoHashPtr -> IO b) -> IO b
withCInfohash ((CInfoHashPtr -> IO OpToken) -> IO OpToken)
-> (CInfoHashPtr -> IO OpToken) -> IO OpToken
forall a b. (a -> b) -> a -> b
$ \ CInfoHashPtr
hPtr -> () -> (CDhtRunnerPtr -> IO OpToken) -> IO OpToken
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with () ((CDhtRunnerPtr -> IO OpToken) -> IO OpToken)
-> (CDhtRunnerPtr -> IO OpToken) -> IO OpToken
forall a b. (a -> b) -> a -> b
$ \ CDhtRunnerPtr
userdataPtr -> do
CInfoHashPtr -> CString -> IO ()
dhtInfohashFromHexC CInfoHashPtr
hPtr CString
hStrPtr
FunPtr CValueCallback
vcbCWrapped <- CValueCallback -> IO (FunPtr CValueCallback)
wrapValueCallbackC (CValueCallback -> IO (FunPtr CValueCallback))
-> CValueCallback -> IO (FunPtr CValueCallback)
forall a b. (a -> b) -> a -> b
$ InfoHash
-> TVar (Maybe OpToken)
-> TVar DhtRunnerState
-> ValueCallback
-> CValueCallback
fromValueCallBack InfoHash
h TVar (Maybe OpToken)
tokenTVar TVar DhtRunnerState
dhtRunnerStateTV ValueCallback
vcb
FunPtr CShutdownCallback
scbCWrapped <- CShutdownCallback -> IO (FunPtr CShutdownCallback)
wrapShutdownCallbackC (CShutdownCallback -> IO (FunPtr CShutdownCallback))
-> CShutdownCallback -> IO (FunPtr CShutdownCallback)
forall a b. (a -> b) -> a -> b
$ IO () -> CShutdownCallback
fromShutdownCallback IO ()
scb
OpToken
t <- CDhtRunnerPtr -> OpToken
OpToken (CDhtRunnerPtr -> OpToken) -> IO CDhtRunnerPtr -> IO OpToken
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CDhtRunnerPtr
-> CInfoHashPtr
-> FunPtr CValueCallback
-> FunPtr CShutdownCallback
-> CDhtRunnerPtr
-> IO CDhtRunnerPtr
dhtRunnerListenC (DhtRunner -> CDhtRunnerPtr
_dhtRunnerPtr DhtRunner
dhtrunner) CInfoHashPtr
hPtr FunPtr CValueCallback
vcbCWrapped FunPtr CShutdownCallback
scbCWrapped CDhtRunnerPtr
userdataPtr
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (Maybe OpToken) -> Maybe OpToken -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (Maybe OpToken)
tokenTVar (OpToken -> Maybe OpToken
forall a. a -> Maybe a
Just OpToken
t)
OpToken -> IO OpToken
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return OpToken
t
IO () -> DhtRunnerM Dht ()
forall a. IO a -> DhtRunnerM Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DhtRunnerM Dht ()) -> IO () -> DhtRunnerM Dht ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar DhtRunnerState -> (DhtRunnerState -> DhtRunnerState) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar DhtRunnerState
dhtRunnerStateTV ((DhtRunnerState -> DhtRunnerState) -> STM ())
-> (DhtRunnerState -> DhtRunnerState) -> STM ()
forall a b. (a -> b) -> a -> b
$ \ DhtRunnerState
s ->
let
mtokens :: Maybe [OpToken]
mtokens = DhtRunnerState
s DhtRunnerState
-> Getting (Maybe [OpToken]) DhtRunnerState (Maybe [OpToken])
-> Maybe [OpToken]
forall s a. s -> Getting a s a -> a
^. (Map InfoHash [OpToken]
-> Const (Maybe [OpToken]) (Map InfoHash [OpToken]))
-> DhtRunnerState -> Const (Maybe [OpToken]) DhtRunnerState
Lens' DhtRunnerState (Map InfoHash [OpToken])
listenTokens ((Map InfoHash [OpToken]
-> Const (Maybe [OpToken]) (Map InfoHash [OpToken]))
-> DhtRunnerState -> Const (Maybe [OpToken]) DhtRunnerState)
-> ((Maybe [OpToken] -> Const (Maybe [OpToken]) (Maybe [OpToken]))
-> Map InfoHash [OpToken]
-> Const (Maybe [OpToken]) (Map InfoHash [OpToken]))
-> Getting (Maybe [OpToken]) DhtRunnerState (Maybe [OpToken])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map InfoHash [OpToken])
-> Lens'
(Map InfoHash [OpToken]) (Maybe (IxValue (Map InfoHash [OpToken])))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map InfoHash [OpToken])
InfoHash
h
newTokens :: [OpToken]
newTokens = [OpToken]
-> ([OpToken] -> [OpToken]) -> Maybe [OpToken] -> [OpToken]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [OpToken
token] (OpToken
tokenOpToken -> [OpToken] -> [OpToken]
forall a. a -> [a] -> [a]
:) Maybe [OpToken]
mtokens
in DhtRunnerState
s DhtRunnerState
-> (DhtRunnerState -> DhtRunnerState) -> DhtRunnerState
forall a b. a -> (a -> b) -> b
& (Map InfoHash [OpToken] -> Identity (Map InfoHash [OpToken]))
-> DhtRunnerState -> Identity DhtRunnerState
Lens' DhtRunnerState (Map InfoHash [OpToken])
listenTokens ((Map InfoHash [OpToken] -> Identity (Map InfoHash [OpToken]))
-> DhtRunnerState -> Identity DhtRunnerState)
-> (Map InfoHash [OpToken] -> Map InfoHash [OpToken])
-> DhtRunnerState
-> DhtRunnerState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ InfoHash
-> [OpToken] -> Map InfoHash [OpToken] -> Map InfoHash [OpToken]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert InfoHash
h [OpToken]
newTokens
OpToken -> DhtRunnerM Dht OpToken
forall a. a -> DhtRunnerM Dht a
forall (m :: * -> *) a. Monad m => a -> m a
return OpToken
token
foreign import ccall "dht_runner_cancel_listen" dhtRunnerCancelListenC :: CDhtRunnerPtr -> CInfoHashPtr -> COpTokenPtr -> IO ()
cancelListen :: InfoHash
-> OpToken
-> MaybeT (DhtRunnerM Dht) ()
cancelListen :: InfoHash -> OpToken -> MaybeT (DhtRunnerM Dht) ()
cancelListen InfoHash
h OpToken
t = do
DhtRunner
dhtrunner <- DhtRunnerM Dht DhtRunner -> MaybeT (DhtRunnerM Dht) DhtRunner
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift DhtRunnerM Dht DhtRunner
getDhtRunner
TVar DhtRunnerState
dhtRunnerStateTV <- MaybeT (DhtRunnerM Dht) (TVar DhtRunnerState)
forall r (m :: * -> *). MonadReader r m => m r
ask
IO () -> MaybeT (DhtRunnerM Dht) ()
forall a. IO a -> MaybeT (DhtRunnerM Dht) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT (DhtRunnerM Dht) ())
-> IO () -> MaybeT (DhtRunnerM Dht) ()
forall a b. (a -> b) -> a -> b
$ String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString (InfoHash -> String
forall a. Show a => a -> String
show InfoHash
h) ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
hStrPtr -> (CInfoHashPtr -> IO ()) -> IO ()
forall b. (CInfoHashPtr -> IO b) -> IO b
withCInfohash ((CInfoHashPtr -> IO ()) -> IO ())
-> (CInfoHashPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CInfoHashPtr
hPtr -> do
CInfoHashPtr -> CString -> IO ()
dhtInfohashFromHexC CInfoHashPtr
hPtr CString
hStrPtr
CDhtRunnerPtr -> CInfoHashPtr -> CShutdownCallback
dhtRunnerCancelListenC (DhtRunner -> CDhtRunnerPtr
_dhtRunnerPtr DhtRunner
dhtrunner) CInfoHashPtr
hPtr (OpToken -> CDhtRunnerPtr
_opTokenPtr OpToken
t)
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar DhtRunnerState -> (DhtRunnerState -> DhtRunnerState) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar DhtRunnerState
dhtRunnerStateTV ((DhtRunnerState -> DhtRunnerState) -> STM ())
-> (DhtRunnerState -> DhtRunnerState) -> STM ()
forall a b. (a -> b) -> a -> b
$ InfoHash -> OpToken -> DhtRunnerState -> DhtRunnerState
deleteListenToken InfoHash
h OpToken
t
foreign import ccall "dht_runner_shutdown" dhtRunnerShutdownC :: CDhtRunnerPtr -> FunPtr CShutdownCallback -> Ptr () -> IO ()
shutdown :: ShutdownCallback
-> DhtRunnerM Dht ()
shutdown :: IO () -> DhtRunnerM Dht ()
shutdown IO ()
scb = do
DhtRunner
dhtrunner <- DhtRunnerM Dht DhtRunner
getDhtRunner
IO () -> DhtRunnerM Dht ()
forall a. IO a -> DhtRunnerM Dht a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DhtRunnerM Dht ()) -> IO () -> DhtRunnerM Dht ()
forall a b. (a -> b) -> a -> b
$ () -> CShutdownCallback -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with () (CShutdownCallback -> IO ()) -> CShutdownCallback -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CDhtRunnerPtr
userdataPtr -> do
FunPtr CShutdownCallback
scbCWrapped <- CShutdownCallback -> IO (FunPtr CShutdownCallback)
wrapShutdownCallbackC (CShutdownCallback -> IO (FunPtr CShutdownCallback))
-> CShutdownCallback -> IO (FunPtr CShutdownCallback)
forall a b. (a -> b) -> a -> b
$ IO () -> CShutdownCallback
fromShutdownCallback IO ()
scb
CDhtRunnerPtr -> FunPtr CShutdownCallback -> CShutdownCallback
dhtRunnerShutdownC (DhtRunner -> CDhtRunnerPtr
_dhtRunnerPtr DhtRunner
dhtrunner) FunPtr CShutdownCallback
scbCWrapped CDhtRunnerPtr
userdataPtr