Skip to content
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
32 changes: 29 additions & 3 deletions interop/kad-dht-node/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,10 @@
--
-- All logging goes to stderr. Stdout is reserved for the final pass/fail report.
--
-- Every role registers the Identify handlers. dotnet-libp2p awaits
-- @\/ipfs\/id\/1.0.0@ on every outbound connection before its dial resolves, so
-- a node that does not serve it is undialable from dotnet.
--
-- Environment variables:
-- ROLE - "bootstrap", "provider", or "querier"
-- TEST_KEY - hex key namespacing Redis coordination keys
Expand Down Expand Up @@ -38,7 +42,7 @@
import System.Timeout (timeout)
import qualified Database.Redis as Redis

import LibP2P

Check warning on line 45 in interop/kad-dht-node/Main.hs

View workflow job for this annotation

GitHub Actions / build

The import of ‘Switch, switchClose’
( Multiaddr (..)
, PeerId
, Protocol (..)
Expand All @@ -62,7 +66,7 @@
import LibP2P.DHT
( DHTMode (..)
, DHTNode (..)
, ProviderEntry (..)

Check warning on line 69 in interop/kad-dht-node/Main.hs

View workflow job for this annotation

GitHub Actions / build

The import of ‘ProviderEntry’ from module ‘LibP2P.DHT’ is redundant
, newDHTNode
, registerDHTHandler
)
Expand All @@ -70,6 +74,7 @@
import LibP2P.DHT.Lookup (bootstrap, iterativeGetValue)
import LibP2P.DHT.Message (DHTRecord (..))
import LibP2P.DHT.Validator (Validator (..), namespacedValidator, pkValidator)
import LibP2P.Protocol.Identify (registerIdentifyHandlers)

------------------------------------------------------------------------------
-- Constants
Expand Down Expand Up @@ -99,6 +104,25 @@
hPutStrLn stderr $ "Unknown ROLE: " ++ other
exitFailure

------------------------------------------------------------------------------
-- Interop value contract
------------------------------------------------------------------------------

-- | Payload this node stores under the @/example/data/@ key.
--
-- The other implementations in the suite store @"hello from <impl> client"@
-- (py: @"hello from py client"@, dotnet: @"hello from dotnet client"@), so a
-- querier written against an exact payload can never read their records.
interopValue :: String
interopValue = "hello from haskell client"

-- | Substring every implementation's payload shares.
--
-- Queriers match on this marker rather than the full payload so that a record
-- published by any implementation is accepted.
interopMarker :: ByteString
interopMarker = BS8.pack "hello from"

------------------------------------------------------------------------------
-- Bootstrap role
------------------------------------------------------------------------------
Expand All @@ -109,6 +133,7 @@
tcp <- newTCPTransport
sw <- newSwitch pid kp
addTransport sw tcp
registerIdentifyHandlers sw
dhtNode0 <- newDHTNode sw DHTServer
-- The interop contract stores values in the /example/ namespace, so
-- configure the server to validate that namespace before serving PUT_VALUE.
Expand Down Expand Up @@ -145,6 +170,7 @@
tcp <- newTCPTransport
sw <- newSwitch pid kp
addTransport sw tcp
registerIdentifyHandlers sw
dhtNode0 <- newDHTNode sw DHTServer
let dhtNode = dhtNode0 { dhtValidator = makeInteropValidator }
registerDHTHandler dhtNode
Expand Down Expand Up @@ -195,7 +221,7 @@
-- Build channel/value keys matching Python reference
let channelKey = "interop-test-key-" ++ testKey
valueKey = "/example/data/" ++ testKey
value = testKey ++ "-value"
value = interopValue
validator = makeInteropValidator

-- Provide the channel key
Expand Down Expand Up @@ -226,6 +252,7 @@
tcp <- newTCPTransport
sw <- newSwitch pid kp
addTransport sw tcp
registerIdentifyHandlers sw
dhtNode <- newDHTNode sw DHTClient

-- Build Redis keys
Expand Down Expand Up @@ -277,7 +304,6 @@
-- Build query keys
let channelKey = "interop-test-key-" ++ testKey
valueKey = "/example/data/" ++ testKey
expectedValue = testKey ++ "-value"
validator = makeInteropValidator

-- Test 1: findProviders
Expand All @@ -289,7 +315,7 @@
logInfo $ "Querying getValue for key: " ++ valueKey
getResult <- iterativeGetValue dhtNode validator (BS8.pack valueKey)
let valueOk = case getResult of
Right rec -> recValue rec == BS8.pack expectedValue
Right rec -> interopMarker `BS8.isInfixOf` recValue rec
Left _ -> False

-- Print result
Expand Down
Loading