diff --git a/src/Simplex/Messaging/Names/Record.hs b/src/Simplex/Messaging/Names/Record.hs index 461bec16e..ed77eca20 100644 --- a/src/Simplex/Messaging/Names/Record.hs +++ b/src/Simplex/Messaging/Names/Record.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DerivingVia #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} @@ -11,6 +13,9 @@ module Simplex.Messaging.Names.Record NameResponse (..), NameRegistration (..), NamePricing (..), + NameTerms (..), + TermsDoc (..), + ZstdTerms (..), USDCents (..), NameReservedReason (..), ) @@ -19,6 +24,7 @@ where import Data.Aeson (FromJSON (..), ToJSON (..)) import qualified Data.Aeson as J import qualified Data.Aeson.TH as JQ +import Data.ByteString (ByteString) import Data.Int (Int64) import Data.Map.Strict (Map) import Data.Text (Text) @@ -85,7 +91,11 @@ data NameRegistration nameRecord :: NameRecord } | -- | Held by nobody, and registrable now. - NRAvailable {pricing :: NamePricing} + NRAvailable + { pricing :: NamePricing, + -- | absent only from a router before v24 + nameTerms :: Maybe NameTerms + } | -- | Held back by the registry, and not for sale at its price. NRReserved {reservedReason :: NameReservedReason} deriving (Eq, Show) @@ -101,6 +111,27 @@ data NamePricing = NamePricing } deriving (Eq, Show) +-- | The terms a buyer of the name accepts, which the name policy keeps. +data NameTerms + = -- | the general terms + NTGeneral {termsDoc :: TermsDoc} + | -- | a community name's community terms, which include the general ones + NTCommunity {termsDoc :: TermsDoc} + deriving (Eq, Show) + +-- | Terms as the name policy keeps them: a link to one file at one commit, whose keccak256 a buyer accepts. +data TermsDoc = TermsDoc + { -- | ends in #sha256= of the file + termsLink :: Text, + -- | the file in one zstd frame, when it fits the answer + termsZstd :: Maybe ZstdTerms + } + deriving (Eq, Show) + +newtype ZstdTerms = ZstdTerms ByteString + deriving newtype (Eq, Show, StrEncoding) + deriving (ToJSON, FromJSON) via (StrJSON "ZstdTerms" ZstdTerms) + -- | Why the registry holds a name back. data NameReservedReason = -- | held for SimpleX @@ -137,6 +168,10 @@ instance FromJSON NameReservedReason where $(JQ.deriveJSON defaultJSON ''NamePricing) +$(JQ.deriveJSON defaultJSON ''TermsDoc) + +$(JQ.deriveJSON (taggedObjectJSON $ dropPrefix "NT") ''NameTerms) + -- taggedObjectJSON, not sumTypeJSON: this JSON is the RNAME payload and the -- resolver contract, so it must not vary with the swift build flag. $(JQ.deriveJSON (taggedObjectJSON $ dropPrefix "NR") ''NameRegistration) diff --git a/tests/RSLVTests.hs b/tests/RSLVTests.hs index 0d096bccb..e9b931314 100644 --- a/tests/RSLVTests.hs +++ b/tests/RSLVTests.hs @@ -191,7 +191,7 @@ testRslvAvailable = testSMPClient @TLS $ \h -> do (corrId, _entId, resp) <- sendRslv h "na01" (domain "ghost.simplex") corrId `shouldBe` CorrId "na01" - resp `shouldBe` Right (RNAME (resolved (NRAvailable testPricing))) + resp `shouldBe` Right (RNAME (resolved (NRAvailable testPricing Nothing))) testRslvReserved :: HasTestEnv => IO () testRslvReserved = diff --git a/tests/SMPNamesTests.hs b/tests/SMPNamesTests.hs index 7f28a0b34..452c99428 100644 --- a/tests/SMPNamesTests.hs +++ b/tests/SMPNamesTests.hs @@ -163,7 +163,7 @@ availabilitySpec = do answers heldBackBody . resolved $ NRRegistered {expires = Just (RoundedSystemTime 1813853483), graceUntil = Just (RoundedSystemTime 1821629483), reservedReason_ = Just NRRInternal, nameRecord = testNameRecord} it "an unregistered name answers with the price" $ - answers availableBody (resolved NRAvailable {pricing = testPricing}) + answers availableBody (resolved NRAvailable {pricing = testPricing, nameTerms = Nothing}) it "reserved carries the reason and no price" $ answers reservedBody (resolved $ NRReserved NRRTrademark) -- losing the reservation would offer a name that cannot be registered @@ -175,7 +175,7 @@ availabilitySpec = do (\a -> J.eitherDecodeStrict (LB.toStrict (J.encode a)) `shouldBe` Right a) [ registeredAlice, NRRegistered {expires = Nothing, graceUntil = Nothing, reservedReason_ = Just NRRInternal, nameRecord = testNameRecord}, - NRAvailable {pricing = testPricing}, + NRAvailable {pricing = testPricing, nameTerms = Nothing}, NRReserved NRRInternal, NRReserved NRRTrademark, NRReserved NRRCommunity,