From 73dbd34866e987fe2b050be79121fba60a7355c0 Mon Sep 17 00:00:00 2001 From: Daniel Sharifi Date: Wed, 13 Sep 2023 14:22:02 +0000 Subject: [PATCH] feat: [IC-1247] Add replica signatures to Query responses --- Cargo.lock | 29 +-- hs/spec_compliance/BUILD.bazel | 2 + hs/spec_compliance/src/IC/Test/Agent.hs | 145 +++++++++++++-- .../src/IC/Test/Agent/SafeCalls.hs | 20 +-- .../src/IC/Test/Agent/UnsafeCalls.hs | 16 +- hs/spec_compliance/src/IC/Test/Options.hs | 18 +- hs/spec_compliance/src/IC/Test/Spec.hs | 168 ++++++++++-------- .../src/IC/Test/Spec/CanisterVersion.hs | 2 +- hs/spec_compliance/src/IC/Test/Spec/Utils.hs | 23 +-- hs/spec_compliance/src/IC/Types.hs | 2 +- rs/execution_environment/src/query_handler.rs | 5 +- rs/http_endpoints/public/src/lib.rs | 7 +- rs/http_endpoints/public/src/query.rs | 108 ++++++++--- rs/http_endpoints/public/tests/common/mod.rs | 13 +- .../public/tests/load_shed_test.rs | 15 +- rs/http_endpoints/public/tests/test.rs | 26 +-- rs/interfaces/src/crypto.rs | 9 +- rs/interfaces/src/execution_environment.rs | 3 +- rs/replica/src/setup_ic_stack.rs | 1 + rs/tests/src/spec_compliance.rs | 8 +- rs/types/types/src/crypto/hash.rs | 5 + rs/types/types/src/crypto/sign.rs | 18 +- rs/types/types/src/messages.rs | 5 +- rs/types/types/src/messages/http.rs | 96 +++++++++- rs/types/types/src/messages/http/tests.rs | 82 +++++++-- 25 files changed, 608 insertions(+), 218 deletions(-) diff --git a/Cargo.lock b/Cargo.lock index b2c1f56f960..f8bde76360a 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -1508,15 +1508,16 @@ dependencies = [ [[package]] name = "candid" -version = "0.9.5" +version = "0.9.6" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "762aa04e3a889d47a1773b74ee3b13438a9bc895954fff79ebf7f308c3744a6c" +checksum = "88f6eec0ae850e006ef0fe306f362884d370624094ec55a6a26de18b251774be" dependencies = [ "anyhow", "binread", "byteorder", "candid_derive", "codespan-reporting", + "convert_case 0.6.0", "crc32fast", "data-encoding", "hex", @@ -1538,9 +1539,9 @@ dependencies = [ [[package]] name = "candid_derive" -version = "0.6.2" +version = "0.6.3" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "810b3bd60244f282090652ffc7c30a9d23892e72dfe443e46ee55569044f7dd5" +checksum = "158403ea38fab5904ae47a5d67eb7047650a91681407f5ccbcbcabc4f4ffb489" dependencies = [ "lazy_static", "proc-macro2 1.0.66", @@ -12064,7 +12065,7 @@ dependencies = [ "petgraph", "pico-args", "regex", - "regex-syntax 0.7.4", + "regex-syntax 0.7.5", "string_cache", "term 0.7.0", "tiny-keccak", @@ -15017,9 +15018,9 @@ checksum = "456c603be3e8d448b072f410900c09faf164fbce2d480456f50eea6e25f9c848" [[package]] name = "regex-syntax" -version = "0.7.4" +version = "0.7.5" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e5ea92a5b6195c6ef2a0295ea818b312502c6fc94dde986c5553242e18fd4ce2" +checksum = "dbb5fb1acd8a1a18b3dd5be62d25485eb770e05afb408a9627d14d451bae12da" [[package]] name = "registry-canister" @@ -16558,7 +16559,7 @@ version = "0.25.0" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "290d54ea6f91c969195bdbcd7442c8c2a2ba87da8bf60a7ee86a235d4bc1e125" dependencies = [ - "strum_macros 0.25.2", + "strum_macros 0.25.1", ] [[package]] @@ -16601,9 +16602,9 @@ dependencies = [ [[package]] name = "strum_macros" -version = "0.25.2" +version = "0.25.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ad8d03b598d3d0fff69bf533ee3ef19b8eeb342729596df84bcc7e1f96ec4059" +checksum = "6069ca09d878a33f883cc06aaa9718ede171841d3832450354410b718b097232" dependencies = [ "heck 0.4.1", "proc-macro2 1.0.66", @@ -17063,18 +17064,18 @@ checksum = "222a222a5bfe1bba4a77b45ec488a741b3cb8872e5e499451fd7d0129c9c7c3d" [[package]] name = "thiserror" -version = "1.0.47" +version = "1.0.48" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "97a802ec30afc17eee47b2855fc72e0c4cd62be9b4efe6591edde0ec5bd68d8f" +checksum = "9d6d7a740b8a666a7e828dd00da9c0dc290dff53154ea77ac109281de90589b7" dependencies = [ "thiserror-impl", ] [[package]] name = "thiserror-impl" -version = "1.0.47" +version = "1.0.48" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6bb623b56e39ab7dcd4b1b98bb6c8f8d907ed255b18de254088016b27a8ee19b" +checksum = "49922ecae66cc8a249b77e68d1d0623c1b2c514f0060c27cdc68bd62a1219d35" dependencies = [ "proc-macro2 1.0.66", "quote 1.0.31", diff --git a/hs/spec_compliance/BUILD.bazel b/hs/spec_compliance/BUILD.bazel index eed6e9c3102..45682285761 100644 --- a/hs/spec_compliance/BUILD.bazel +++ b/hs/spec_compliance/BUILD.bazel @@ -789,6 +789,7 @@ haskell_library( ":IC-Crypto", ":IC-Crypto-DER", ":IC-Crypto-DER_BLS", + ":IC-Crypto-Ed25519", ":IC-HTTP-CBOR", ":IC-HTTP-GenR", ":IC-HTTP-GenR-Parse", @@ -798,6 +799,7 @@ haskell_library( ":IC-Id-Fresh", ":IC-Management", ":IC-Test-Options", + ":IC-Types", ":IC-Version", "@haskell-candid//:candid", "@miracl-core//:lib", diff --git a/hs/spec_compliance/src/IC/Test/Agent.hs b/hs/spec_compliance/src/IC/Test/Agent.hs index 71d1601c336..b3244c7d503 100644 --- a/hs/spec_compliance/src/IC/Test/Agent.hs +++ b/hs/spec_compliance/src/IC/Test/Agent.hs @@ -33,6 +33,8 @@ module IC.Test.Agent IC00', ReqResponse (..), ReqStatus (..), + NodeSignature (..), + QueryResponse (..), AgentConfig (..), DelegationCanisterRangeCheck (..), addExpiry, @@ -84,7 +86,9 @@ module IC.Test.Agent isNoErrReject, isPendingOrProcessing, isReject, + isQueryReject, isReply, + isQueryReply, isResponded, okCBOR, otherSK, @@ -135,7 +139,8 @@ import qualified Data.ByteString.Lazy as BS import Data.Char import Data.Default.Class (def) import qualified Data.HashMap.Lazy as HM -import Data.List (nub) +import Data.List (find, nub) +import Data.Maybe (fromJust) import Data.Row import qualified Data.Row.Variants as V import qualified Data.Text as T @@ -156,6 +161,7 @@ import IC.Certificate.Value import IC.Crypto import qualified IC.Crypto.DER as DER import qualified IC.Crypto.DER_BLS as DER_BLS +import qualified IC.Crypto.Ed25519 as Ed25519 import IC.HTTP.CBOR (decode, encode) import IC.HTTP.GenR import IC.HTTP.GenR.Parse @@ -165,6 +171,7 @@ import IC.Id.Forms import IC.Id.Fresh import IC.Management import IC.Test.Options +import IC.Types (rawEntityId) import IC.Version import Network.Connection import Network.HTTP.Client @@ -202,7 +209,8 @@ cborToBlobPair r = assertFailure $ "Expected list of pairs, got: " <> show r -- * Agent configuration data AgentSubnetConfig = AgentSubnetConfig - { tc_node_addresses :: [String], + { tc_subnet_id :: Blob, + tc_node_addresses :: [String], tc_canister_ranges :: [(W.Word64, W.Word64)] } @@ -264,10 +272,10 @@ preFlight os = do let Httpbin httpbin = lookupOption os let PollTimeout to = lookupOption os let AllowSelfSignedCerts allow_self_signed_certs = lookupOption os - let TestSubnet (_, _, _, test_ranges, test_nodes) = lookupOption os - let test_agent_subnet_config = AgentSubnetConfig (map (fixUrl "node") test_nodes) test_ranges - let PeerSubnet (_, _, _, peer_ranges, peer_nodes) = lookupOption os - let peer_agent_subnet_config = AgentSubnetConfig (map (fixUrl "node") peer_nodes) peer_ranges + let TestSubnet (test_id, _, _, test_ranges, test_nodes) = lookupOption os + let test_agent_subnet_config = AgentSubnetConfig (rawEntityId test_id) (map (fixUrl "node") test_nodes) test_ranges + let PeerSubnet (peer_id, _, _, peer_ranges, peer_nodes) = lookupOption os + let peer_agent_subnet_config = AgentSubnetConfig (rawEntityId peer_id) (map (fixUrl "node") peer_nodes) peer_ranges makeAgentConfig allow_self_signed_certs ep [test_agent_subnet_config, peer_agent_subnet_config] httpbin to -- Yes, implicit arguments are frowned upon. But they are also very useful. @@ -286,6 +294,9 @@ endPoint = tc_endPoint agentConfig subnets :: (HasAgentConfig) => [AgentSubnetConfig] subnets = tc_subnets agentConfig +root_subnet :: (HasAgentConfig) => AgentSubnetConfig +root_subnet = fromJust $ find (any (\(a, b) -> wordToId' a <= wordToId' 0 && wordToId' 0 <= wordToId' b) . tc_canister_ranges) subnets + agentManager :: (HasAgentConfig) => Manager agentManager = tc_manager agentConfig @@ -390,9 +401,16 @@ senderOf :: GenR -> Blob senderOf (GRec hm) | Just (GBlob id) <- HM.lookup "sender" hm = id senderOf _ = anonymousUser +addNonceExpiryEnv' :: GenR -> IO (Blob, GenR) +addNonceExpiryEnv' req = do + req <- addNonce req >>= addExpiry + env <- envelopeFor (senderOf req) req + return (requestId req, env) + addNonceExpiryEnv :: GenR -> IO GenR addNonceExpiryEnv req = do - addNonce req >>= addExpiry >>= envelopeFor (senderOf req) + (_, req) <- addNonceExpiryEnv' req + return req envelopeFor :: Blob -> GenR -> IO GenR envelopeFor u content | u == anonymousUser = return $ rec ["content" =: content] @@ -483,9 +501,11 @@ sync_height cid = forM subnets $ \sub -> do -- | Add envelope to CBOR request, add a nonce and expiry if it is not there, -- post to "read", return decoded CBOR -queryCBOR :: (HasCallStack, HasAgentConfig) => Blob -> GenR -> IO GenR +queryCBOR :: (HasCallStack, HasAgentConfig) => Blob -> GenR -> IO (Blob, GenR) queryCBOR cid req = do - addNonceExpiryEnv req >>= postQueryCBOR cid >>= okCBOR + (rid, req) <- addNonceExpiryEnv' req + res <- postQueryCBOR cid req >>= okCBOR + return (rid, res) type HTTPErrOr a = Either (Int, String) a @@ -622,6 +642,12 @@ data ReqResponse = Reply Blob | Reject Natural T.Text (Maybe T.Text) data ReqStatus = Processing | Pending | Responded ReqResponse | UnknownStatus deriving (Eq, Show) +data NodeSignature = NodeSignature {node_sig_timestamp :: Natural, node_sig_signature :: Blob, node_sig_identity :: Blob} + deriving (Eq, Show) + +data QueryResponse = QueryReply Blob [NodeSignature] | QueryReject Natural T.Text (Maybe T.Text) [NodeSignature] + deriving (Eq, Show) + prettyPath :: [Blob] -> String prettyPath = concatMap (("/" ++) . shorten 15 . prettyBlob) @@ -768,19 +794,29 @@ callResponse = error_code <- optionalField text "error_code" return $ Reject code msg error_code -queryResponse :: GenR -> IO ReqResponse +queryResponse :: GenR -> IO QueryResponse queryResponse = asExceptT . record do s <- field text "status" case s of - "replied" -> - Reply <$> field (record (field blob "arg")) "reply" + "replied" -> do + reply <- field (record (field blob "arg")) "reply" + signatures <- field (listOf parseNodeSignature) "signatures" + return $ QueryReply reply signatures "rejected" -> do code <- field nat "reject_code" msg <- field text "reject_message" error_code <- optionalField text "error_code" - return $ Reject code msg error_code + signatures <- field (listOf parseNodeSignature) "signatures" + return $ QueryReject code msg error_code signatures _ -> throwError $ "Unexpected status " <> T.pack (show s) + where + parseNodeSignature :: Field NodeSignature + parseNodeSignature = record $ do + t <- field nat "timestamp" + s <- field blob "signature" + n <- field blob "identity" + return $ NodeSignature t s n isReject :: (HasCallStack) => [Natural] -> ReqResponse -> IO () isReject _ (Reply r) = @@ -790,6 +826,77 @@ isReject codes (Reject n msg _) = do ("Reject code " ++ show n ++ " not in " ++ show codes ++ "\n" ++ T.unpack msg) (n `elem` codes) +assertLen :: String -> Int -> BS.ByteString -> IO () +assertLen what len bs + | BS.length bs == fromIntegral len = return () + | otherwise = assertFailure $ what ++ " has wrong length " ++ show (BS.length bs) ++ ", expected " ++ show len + +checkQueryResponse :: (HasCallStack, HasAgentConfig) => Blob -> Blob -> QueryResponse -> IO () +checkQueryResponse cid rid r = do + cert <- getStateCert defaultUser cid [["subnet"]] + (subnet_id, ranges) <- + case cert_delegation cert of + Just d -> do + let subnet_id = del_subnet_id d + del_cert <- decodeCert' $ del_certificate d + ranges <- certValue @Blob del_cert ["subnet", subnet_id, "canister_ranges"] >>= asCBORBlobPairList + return (subnet_id, ranges) + Nothing -> do + let subnet_id = tc_subnet_id root_subnet + ranges <- certValue @Blob cert ["subnet", subnet_id, "canister_ranges"] >>= asCBORBlobPairList + return (subnet_id, ranges) + unless (checkCanisterIdInRanges' ranges cid) $ assertFailure $ "Canister range check failed" + let sigs = case r of + QueryReply _ sigs -> sigs + QueryReject _ _ _ sigs -> sigs + void $ forM sigs $ \sig -> case sig of + NodeSignature t s n -> do + der_pk <- certValue @Blob cert ["subnet", subnet_id, "node", n, "public_key"] + pk <- case DER.decode der_pk of + Left err -> assertFailure $ "Node public key is not DER-encoded: " ++ show err + Right (suite, pk) -> do + assertBool "Node public key is not Ed25519" $ case suite of + DER.Ed25519 -> True + _ -> False + return pk + let hash = case r of + QueryReply payload _ -> + requestId $ + rec + [ "status" =: GText "replied", + "reply" =: GBlob payload, + "timestamp" =: GNat t, + "request_id" =: GBlob rid + ] + QueryReject code msg error_code _ -> do + requestId $ + rec $ + [ "status" =: GText "rejected", + "reject_code" =: GNat code, + "reject_message" =: GText msg, + "timestamp" =: GNat t, + "request_id" =: GBlob rid + ] + ++ ["error_code" =: GText err | Just err <- [error_code]] + let msg = "\x0Bic-response" <> hash + assertLen "Ed25519 public key length" 32 pk + assertLen "Ed25519 signature length" 64 s + assertBool "Node signature verification failed" $ Ed25519.verify pk msg s + return () + +isQueryReject :: (HasCallStack, HasAgentConfig) => Blob -> [Natural] -> (Blob, QueryResponse) -> IO () +isQueryReject cid codes (rid, r) = do + checkQueryResponse cid rid r + aux r + where + aux (QueryReply r _) = + assertFailure $ "Expected reject, got reply:" ++ prettyBlob r + aux (QueryReject n msg _ sigs) = do + assertBool ("Number of signatures " ++ show (length sigs) ++ "is not equal to one") (length sigs == 1) + assertBool + ("Reject code " ++ show n ++ " not in " ++ show codes ++ "\n" ++ T.unpack msg) + (n `elem` codes) + isErr4xx :: (HasCallStack) => HTTPErrOr a -> IO () isErr4xx (Left (c, msg)) | 400 <= c && c < 500 = return () @@ -823,6 +930,18 @@ isReply (Reject n msg error_code) = where showErrCode ec = ", error_code: " ++ T.unpack ec +isQueryReply :: (HasCallStack, HasAgentConfig) => Blob -> (Blob, QueryResponse) -> IO Blob +isQueryReply cid (rid, r) = do + checkQueryResponse cid rid r + aux r + where + aux (QueryReply b sigs) = do + assertBool ("Number of signatures " ++ show (length sigs) ++ "is not equal to one") (length sigs == 1) + return b + aux (QueryReject n msg error_code _) = + assertFailure $ "Unexpected reject (code " ++ show n ++ (maybe "" showErrCode error_code) ++ "): " ++ T.unpack msg + showErrCode ec = ", error_code: " ++ T.unpack ec + -- Convenience decoders asWord32 :: (HasCallStack) => Blob -> IO Word32 diff --git a/hs/spec_compliance/src/IC/Test/Agent/SafeCalls.hs b/hs/spec_compliance/src/IC/Test/Agent/SafeCalls.hs index f70d4229a7d..b0bf61e34b5 100644 --- a/hs/spec_compliance/src/IC/Test/Agent/SafeCalls.hs +++ b/hs/spec_compliance/src/IC/Test/Agent/SafeCalls.hs @@ -189,8 +189,8 @@ ic_ecdsa_public_key' ic00 ecid canister_id path = ) ic_http_invalid_address_request' :: (HasAgentConfig) => IC00WithCycles -> TestSubnetConfig -> String -> Maybe W.Word64 -> Maybe (String, Blob) -> Blob -> IO ReqResponse -ic_http_invalid_address_request' ic00 (_, subnet_type, subnet_size, _, _) address max_response_bytes transform canister_id = - callIC' (ic00 $ http_request_fee request (subnet_type, subnet_size)) "" #http_request request +ic_http_invalid_address_request' ic00 (_, subnet_type, subnet_nodes, _, _) address max_response_bytes transform canister_id = + callIC' (ic00 $ http_request_fee request (subnet_type, fromIntegral $ length subnet_nodes)) "" #http_request request where request = empty @@ -208,8 +208,8 @@ ic_http_invalid_address_request' ic00 (_, subnet_type, subnet_size, _, _) addres .== (toTransformFn transform canister_id) ic_http_get_request' :: (HasAgentConfig) => IC00WithCycles -> TestSubnetConfig -> String -> String -> Maybe W.Word64 -> Maybe (String, Blob) -> Blob -> IO ReqResponse -ic_http_get_request' ic00 (_, subnet_type, subnet_size, _, _) proto path max_response_bytes transform canister_id = - callIC' (ic00 $ http_request_fee request (subnet_type, subnet_size)) "" #http_request request +ic_http_get_request' ic00 (_, subnet_type, subnet_nodes, _, _) proto path max_response_bytes transform canister_id = + callIC' (ic00 $ http_request_fee request (subnet_type, fromIntegral $ length subnet_nodes)) "" #http_request request where request = empty @@ -227,8 +227,8 @@ ic_http_get_request' ic00 (_, subnet_type, subnet_size, _, _) proto path max_res .== (toTransformFn transform canister_id) ic_http_post_request' :: (HasAgentConfig) => IC00WithCycles -> TestSubnetConfig -> String -> Maybe W.Word64 -> Maybe BS.ByteString -> Vec.Vector HttpHeader -> Maybe (String, Blob) -> Blob -> IO ReqResponse -ic_http_post_request' ic00 (_, subnet_type, subnet_size, _, _) path max_response_bytes body headers transform canister_id = - callIC' (ic00 $ http_request_fee request (subnet_type, subnet_size)) "" #http_request request +ic_http_post_request' ic00 (_, subnet_type, subnet_nodes, _, _) path max_response_bytes body headers transform canister_id = + callIC' (ic00 $ http_request_fee request (subnet_type, fromIntegral $ length subnet_nodes)) "" #http_request request where request = empty @@ -246,8 +246,8 @@ ic_http_post_request' ic00 (_, subnet_type, subnet_size, _, _) path max_response .== (toTransformFn transform canister_id) ic_http_head_request' :: (HasAgentConfig) => IC00WithCycles -> TestSubnetConfig -> String -> Maybe W.Word64 -> Maybe BS.ByteString -> Vec.Vector HttpHeader -> Maybe (String, Blob) -> Blob -> IO ReqResponse -ic_http_head_request' ic00 (_, subnet_type, subnet_size, _, _) path max_response_bytes body headers transform canister_id = - callIC' (ic00 $ http_request_fee request (subnet_type, subnet_size)) "" #http_request request +ic_http_head_request' ic00 (_, subnet_type, subnet_nodes, _, _) path max_response_bytes body headers transform canister_id = + callIC' (ic00 $ http_request_fee request (subnet_type, fromIntegral $ length subnet_nodes)) "" #http_request request where request = empty @@ -265,8 +265,8 @@ ic_http_head_request' ic00 (_, subnet_type, subnet_size, _, _) path max_response .== (toTransformFn transform canister_id) ic_long_url_http_request' :: (HasAgentConfig) => IC00WithCycles -> TestSubnetConfig -> String -> W.Word64 -> Maybe (String, Blob) -> Blob -> IO ReqResponse -ic_long_url_http_request' ic00 (_, subnet_type, subnet_size, _, _) proto len transform canister_id = - callIC' (ic00 $ http_request_fee request (subnet_type, subnet_size)) "" #http_request request +ic_long_url_http_request' ic00 (_, subnet_type, subnet_nodes, _, _) proto len transform canister_id = + callIC' (ic00 $ http_request_fee request (subnet_type, fromIntegral $ length subnet_nodes)) "" #http_request request where l = fromIntegral len - (length $ proto ++ httpbin ++ "/ascii/") path = take l $ repeat 'x' diff --git a/hs/spec_compliance/src/IC/Test/Agent/UnsafeCalls.hs b/hs/spec_compliance/src/IC/Test/Agent/UnsafeCalls.hs index 697397342d8..a13ba595f29 100644 --- a/hs/spec_compliance/src/IC/Test/Agent/UnsafeCalls.hs +++ b/hs/spec_compliance/src/IC/Test/Agent/UnsafeCalls.hs @@ -244,8 +244,8 @@ ic_http_get_request :: Maybe (String, Blob) -> Blob -> IO b -ic_http_get_request ic00 (_, subnet_type, subnet_size, _, _) path max_response_bytes transform canister_id = - callIC (ic00 $ http_request_fee request (subnet_type, subnet_size)) "" #http_request request +ic_http_get_request ic00 (_, subnet_type, subnet_nodes, _, _) path max_response_bytes transform canister_id = + callIC (ic00 $ http_request_fee request (subnet_type, fromIntegral $ length subnet_nodes)) "" #http_request request where request = empty @@ -274,8 +274,8 @@ ic_http_post_request :: Maybe (String, Blob) -> Blob -> IO b -ic_http_post_request ic00 (_, subnet_type, subnet_size, _, _) path max_response_bytes body headers transform canister_id = - callIC (ic00 $ http_request_fee request (subnet_type, subnet_size)) "" #http_request request +ic_http_post_request ic00 (_, subnet_type, subnet_nodes, _, _) path max_response_bytes body headers transform canister_id = + callIC (ic00 $ http_request_fee request (subnet_type, fromIntegral $ length subnet_nodes)) "" #http_request request where request = empty @@ -304,8 +304,8 @@ ic_http_head_request :: Maybe (String, Blob) -> Blob -> IO b -ic_http_head_request ic00 (_, subnet_type, subnet_size, _, _) path max_response_bytes body headers transform canister_id = - callIC (ic00 $ http_request_fee request (subnet_type, subnet_size)) "" #http_request request +ic_http_head_request ic00 (_, subnet_type, subnet_nodes, _, _) path max_response_bytes body headers transform canister_id = + callIC (ic00 $ http_request_fee request (subnet_type, fromIntegral $ length subnet_nodes)) "" #http_request request where request = empty @@ -333,8 +333,8 @@ ic_long_url_http_request :: Maybe (String, Blob) -> Blob -> IO b -ic_long_url_http_request ic00 (_, subnet_type, subnet_size, _, _) proto len transform canister_id = - callIC (ic00 $ http_request_fee request (subnet_type, subnet_size)) "" #http_request request +ic_long_url_http_request ic00 (_, subnet_type, subnet_nodes, _, _) proto len transform canister_id = + callIC (ic00 $ http_request_fee request (subnet_type, fromIntegral $ length subnet_nodes)) "" #http_request request where l = fromIntegral len - (length $ proto ++ httpbin ++ "/ascii/") path = take l $ repeat 'x' diff --git a/hs/spec_compliance/src/IC/Test/Options.hs b/hs/spec_compliance/src/IC/Test/Options.hs index 647b98cabc1..243ad19db54 100644 --- a/hs/spec_compliance/src/IC/Test/Options.hs +++ b/hs/spec_compliance/src/IC/Test/Options.hs @@ -1,6 +1,7 @@ module IC.Test.Options where import Codec.Candid (Principal (..), parsePrincipal) +import Control.Monad import qualified Data.ByteString.Lazy.UTF8 as BLU import Data.List import Data.Proxy @@ -73,22 +74,27 @@ allowSelfSignedCertsOption = Option (Proxy :: Proxy AllowSelfSignedCerts) -- TestSubnetConfig: helper functions -getSubnetIdFromNonce :: String -> EntityId -getSubnetIdFromNonce nonce = EntityId $ mkSelfAuthenticatingId $ toPublicKey $ createSecretKeyBLS $ BLU.fromString nonce +getEntityIdFromNonce :: String -> EntityId +getEntityIdFromNonce nonce = EntityId $ mkSelfAuthenticatingId $ toPublicKey $ createSecretKeyBLS $ BLU.fromString nonce defaultSysTestSubnetConfig :: TestSubnetConfig -defaultSysTestSubnetConfig = (getSubnetIdFromNonce "sk1", System, 1, [nth_canister_range 0], []) +defaultSysTestSubnetConfig = (getEntityIdFromNonce "sk1", System, [getEntityIdFromNonce "nk1"], [nth_canister_range 0], []) defaultAppTestSubnetConfig :: TestSubnetConfig -defaultAppTestSubnetConfig = (getSubnetIdFromNonce "sk2", Application, 1, [nth_canister_range 1], []) +defaultAppTestSubnetConfig = (getEntityIdFromNonce "sk2", Application, [getEntityIdFromNonce "nk2"], [nth_canister_range 1], []) readTestSubnetConfig :: Int -> ReadS TestSubnetConfig readTestSubnetConfig p x = do - ((id, typ, size, ranges, ns), z) <- (readsPrec p x :: [((String, SubnetType, W.Word64, [(W.Word64, W.Word64)], [String]), String)]) + ((id, typ, nids, ranges, ns), z) <- (readsPrec p x :: [((String, SubnetType, [String], [(W.Word64, W.Word64)], [String]), String)]) Principal b <- case parsePrincipal (T.pack id) of Left err -> error err Right p -> return p - return ((EntityId b, typ, size, ranges, ns), z) + nids <- forM nids $ \nid -> do + Principal b <- case parsePrincipal (T.pack nid) of + Left err -> error err + Right p -> return p + return $ EntityId b + return ((EntityId b, typ, nids, ranges, ns), z) -- Configuration: Test subnet diff --git a/hs/spec_compliance/src/IC/Test/Spec.hs b/hs/spec_compliance/src/IC/Test/Spec.hs index 2f7b000d3b7..c5e976ef126 100644 --- a/hs/spec_compliance/src/IC/Test/Spec.hs +++ b/hs/spec_compliance/src/IC/Test/Spec.hs @@ -60,8 +60,8 @@ import Test.Tasty.HUnit icTests :: TestSubnetConfig -> TestSubnetConfig -> AgentConfig -> TestTree icTests my_sub other_sub = - let (my_subnet_id_as_entity, my_type, _, ((ecid_as_word64, last_canister_id_as_word64) : _), _) = my_sub - in let (other_subnet_id_as_entity, _, _, ((other_ecid_as_word64, _) : _), _) = other_sub + let (my_subnet_id_as_entity, my_type, my_nodes, ((ecid_as_word64, last_canister_id_as_word64) : _), _) = my_sub + in let (other_subnet_id_as_entity, _, other_nodes, ((other_ecid_as_word64, _) : _), _) = other_sub in let my_subnet_id = rawEntityId my_subnet_id_as_entity in let other_subnet_id = rawEntityId other_subnet_id_as_entity in let my_is_root = isRootTestSubnet my_sub @@ -342,7 +342,7 @@ icTests my_sub other_sub = call' cid reply >>= isReject [5] step "Cannot call (query)?" - query' cid reply >>= isReject [5] + query' cid reply >>= isQueryReject ecid [5] step "Upgrade" upgrade cid $ setGlobal (i2b getStatus) @@ -407,7 +407,7 @@ icTests my_sub other_sub = call' cid reply >>= isReject [5] step "Cannot call (query)?" - query' cid reply >>= isReject [5] + query' cid reply >>= isQueryReject ecid [5] step "Release the held message" release @@ -425,7 +425,7 @@ icTests my_sub other_sub = call' cid reply >>= isReject [5] step "Cannot call (query)?" - query' cid reply >>= isReject [5], + query' cid reply >>= isQueryReject ecid [5], testCaseSteps "starting a stopping canister" $ \step -> do cid <- install ecid noop @@ -502,7 +502,7 @@ icTests my_sub other_sub = >>= isReject [3] step "Cannot call (query)?" - query' cid reply >>= isReject [3] + query' cid reply >>= isQueryReject ecid [3] step "Cannot query canister_status" ic_canister_status'' defaultUser cid >>= isErrOrReject [3, 5] @@ -595,31 +595,32 @@ icTests my_sub other_sub = >>= isErrOrReject [3], simpleTestCase "Call no non-existant query method" ecid $ \cid -> do - queryCBOR cid $ - rec - [ "request_type" =: GText "query", - "sender" =: GBlob defaultUser, - "canister_id" =: GBlob cid, - "method_name" =: GText "no_such_update", - "arg" =: GBlob "" - ] - >>= queryResponse - >>= isReject [3], + let cbor = + rec + [ "request_type" =: GText "query", + "sender" =: GBlob defaultUser, + "canister_id" =: GBlob cid, + "method_name" =: GText "no_such_update", + "arg" =: GBlob "" + ] + (rid, res) <- queryCBOR cid cbor + res <- queryResponse res + isQueryReject ecid [3] (rid, res), simpleTestCase "reject" ecid $ \cid -> call' cid (reject "ABCD") >>= isReject [4], simpleTestCase "reject (query)" ecid $ \cid -> - query' cid (reject "ABCD") >>= isReject [4], + query' cid (reject "ABCD") >>= isQueryReject ecid [4], simpleTestCase "No response" ecid $ \cid -> call' cid noop >>= isReject [5], simpleTestCase "No response does not rollback" ecid $ \cid -> do call'' cid (setGlobal "FOO") >>= isErrOrReject [5] query cid (replyData getGlobal) >>= is "FOO", simpleTestCase "No response (query)" ecid $ \cid -> - query' cid noop >>= isReject [5], + query' cid noop >>= isQueryReject ecid [5], simpleTestCase "Double reply" ecid $ \cid -> call' cid (reply >>> reply) >>= isReject [5], simpleTestCase "Double reply (query)" ecid $ \cid -> - query' cid (reply >>> reply) >>= isReject [5], + query' cid (reply >>> reply) >>= isQueryReject ecid [5], simpleTestCase "Reply data append after reply" ecid $ \cid -> call' cid (reply >>> replyDataAppend "foo") >>= isReject [5], simpleTestCase "Reply data append after reject" ecid $ \cid -> @@ -799,17 +800,17 @@ icTests my_sub other_sub = >>= is anonymousUser, simpleTestCase "query, sender explicit" ecid $ \cid -> do - queryCBOR cid $ - rec - [ "request_type" =: GText "query", - "canister_id" =: GBlob cid, - "sender" =: GBlob anonymousUser, - "method_name" =: GText "query", - "arg" =: GBlob (run (replyData caller)) - ] - >>= queryResponse - >>= isReply - >>= is anonymousUser + let cbor = + rec + [ "request_type" =: GText "query", + "canister_id" =: GBlob cid, + "sender" =: GBlob anonymousUser, + "method_name" =: GText "query", + "arg" =: GBlob (run (replyData caller)) + ] + (rid, res) <- queryCBOR cid cbor + res <- queryResponse res + isQueryReply ecid (rid, res) >>= is anonymousUser ], testGroup "state" @@ -884,7 +885,7 @@ icTests my_sub other_sub = ), "Q" =: twoContexts - ( reqResponse + ( queryResponse ( \prog -> do cid <- install ecid noop query' cid (prog >>> reply) @@ -959,6 +960,7 @@ icTests my_sub other_sub = -- context builder helpers httpResponse act = (act >=> is2xx >=> void . isReply, act >=> isErrOrReject [5]) reqResponse act = (act >=> void . isReply, act >=> isReject [5]) + queryResponse act = (act >=> void . isQueryReply ecid, act >=> isQueryReject ecid [5]) boolTest act = (act >=> is True, act >=> is False) twoContexts (aNT1, aT1) (aNT2, aT2) = (\p -> aNT1 p >> aNT2 p, \p -> aT1 p >> aT2 p) @@ -1212,7 +1214,7 @@ icTests my_sub other_sub = simpleTestCase "Call from query method traps (in update call)" ecid $ \cid -> callToQuery'' cid (inter_query cid defArgs) >>= is2xx >>= isReject [5], simpleTestCase "Call from query method traps (in query call)" ecid $ \cid -> - query' cid (inter_query cid defArgs) >>= isReject [5], + query' cid (inter_query cid defArgs) >>= isQueryReject ecid [5], simpleTestCase "Call from query method traps (in inter-canister-call)" ecid $ \cid -> do call cid $ @@ -1354,7 +1356,7 @@ icTests my_sub other_sub = step "Writing stable memory (failing)" call' cid (stableWrite (int 0) "FOO") >>= isReject [5] step "Set stable mem (failing, query)" - query' cid (stableWrite (int 0) "FOO") >>= isReject [5] + query' cid (stableWrite (int 0) "FOO") >>= isQueryReject ecid [5] step "Growing stable memory" call cid (replyData (i2b (stableGrow (int 1)))) >>= is "\x0\x0\x0\x0" @@ -1389,7 +1391,7 @@ icTests my_sub other_sub = call' cid (stable64Write (int64 0) "FOO") >>= isReject [5] step "Set stable mem (failing, query)" - query' cid (stable64Write (int64 0) "FOO") >>= isReject [5] + query' cid (stable64Write (int64 0) "FOO") >>= isQueryReject ecid [5] step "Growing stable memory" call cid (replyData (i64tob (stable64Grow (int64 1)))) >>= is "\x0\x0\x0\x0\x0\x0\x0\x0" @@ -1425,10 +1427,10 @@ icTests my_sub other_sub = query cid (replyData (i64tob stable64Size)) >>= is "\x01\x00\x01\x00\x0\x0\x0\x0" step "Using 32 bit API with large stable memory" - query' cid (ignore stableSize) >>= isReject [5] - query' cid (ignore $ stableGrow (int 1)) >>= isReject [5] - query' cid (stableWrite (int 0) "BAZ") >>= isReject [5] - query' cid (ignore $ stableRead (int 0) (int 3)) >>= isReject [5] + query' cid (ignore stableSize) >>= isQueryReject ecid [5] + query' cid (ignore $ stableGrow (int 1)) >>= isQueryReject ecid [5] + query' cid (stableWrite (int 0) "BAZ") >>= isQueryReject ecid [5] + query' cid (ignore $ stableRead (int 0) (int 3)) >>= isQueryReject ecid [5] step "Using 64 bit API with large stable memory" call cid (replyData (i64tob (stable64Grow (int64 1)))) >>= is "\x01\x00\x01\x00\x0\x0\x0\x0" @@ -1470,7 +1472,7 @@ icTests my_sub other_sub = res <- query cid (replyData $ i2b $ isController (bytes $ BS.replicate 29 0)) >>= asWord32 res @?= 0, simpleTestCase "argument is not a valid principal" ecid $ \cid -> do - query' cid (replyData $ i2b $ isController (bytes $ BS.replicate 30 0)) >>= isReject [5] + query' cid (replyData $ i2b $ isController (bytes $ BS.replicate 30 0)) >>= isQueryReject ecid [5] ], testGroup "upgrades" $ let installForUpgrade on_pre_upgrade = @@ -1642,7 +1644,7 @@ icTests my_sub other_sub = ic_uninstall ic00 cid -- should be http error, due to inspection call'' cid (replyData "Hi") >>= isNoErrReject [3] - query' cid (replyData "Hi") >>= isReject [3], + query' cid (replyData "Hi") >>= isQueryReject ecid [3], testCaseSteps "open call contexts are rejected" $ \step -> do cid <- install ecid noop @@ -1769,7 +1771,7 @@ icTests my_sub other_sub = simpleTestCase "Explicit trap" ecid $ \cid -> call' cid (trap "trapping") >>= isReject [5], simpleTestCase "Explicit trap (query)" ecid $ \cid -> do - query' cid (trap "trapping") >>= isReject [5] + query' cid (trap "trapping") >>= isQueryReject ecid [5] ], testCase "caller (in init)" $ do cid <- install ecid $ setGlobal caller @@ -1782,7 +1784,7 @@ icTests my_sub other_sub = cid <- create ecid install' cid pgm >>= isReject [5] -- canister does not exist - query' cid noop >>= isReject [3] + query' cid noop >>= isQueryReject ecid [3] in [ testCase "explicit trap" $ failInInit $ trap "trapping in install", testCase "call" $ failInInit $ inter_query "dummy" defArgs, testCase "reply" $ failInInit reply, @@ -1799,7 +1801,7 @@ icTests my_sub other_sub = simpleTestCase "non-existing (deleted) canister" ecid $ \cid -> do ic_stop_canister ic00 cid ic_delete_canister ic00 cid - query' cid reply >>= isReject [3], + query' cid reply >>= isQueryReject ecid [3], simpleTestCase "does not commit" ecid $ \cid -> do call_ cid (setGlobal "FOO" >>> reply) query cid (setGlobal "BAR" >>> replyData getGlobal) >>= is "BAR" @@ -1867,6 +1869,16 @@ icTests my_sub other_sub = cid <- create ecid cert <- getStateCert defaultUser cid [["time"]] void $ certValue @Natural cert ["time"], + testCase "can ask for /subnet" $ do + cert <- getStateCert defaultUser ecid [["subnet"]] + void $ certValue @Blob cert ["subnet", my_subnet_id, "public_key"] + void $ certValue @Blob cert ["subnet", my_subnet_id, "canister_ranges"] + void $ certValue @Blob cert ["subnet", other_subnet_id, "public_key"] + void $ certValue @Blob cert ["subnet", other_subnet_id, "canister_ranges"] + void $ forM my_nodes $ \nid -> do + void $ certValue @Blob cert ["subnet", my_subnet_id, "node", rawEntityId nid, "public_key"] + void $ forM other_nodes $ \nid -> do + certValueAbsent cert ["subnet", other_subnet_id, "node", rawEntityId nid, "public_key"], testCase "controller of empty canister" $ do cid <- create ecid cert <- getStateCert defaultUser cid [["canister", cid, "controllers"]] @@ -2116,7 +2128,7 @@ icTests my_sub other_sub = cid <- create noop let large = 2 ^ (65 :: Int) ic_top_up ic00 cid large - query' cid replyBalance >>= isReject [5] + query' cid replyBalance >>= isQueryReject ecid [5] queryBalance128 cid >>= isRoughly (large + fromIntegral def_cycles) ], testGroup "can use balance API" $ @@ -2631,17 +2643,17 @@ icTests my_sub other_sub = ] $ \(name, user, env) -> [ simpleTestCase (name ++ " in query") ecid $ \cid -> do - req <- - addExpiry $ - rec - [ "request_type" =: GText "query", - "sender" =: GBlob user, - "canister_id" =: GBlob cid, - "method_name" =: GText "query", - "arg" =: GBlob (run reply) - ] + let cbor = + rec + [ "request_type" =: GText "query", + "sender" =: GBlob user, + "canister_id" =: GBlob cid, + "method_name" =: GText "query", + "arg" =: GBlob (run reply) + ] + req <- addExpiry cbor signed_req <- env req - postQueryCBOR cid signed_req >>= okCBOR >>= queryResponse >>= isReply >>= is "", + postQueryCBOR cid signed_req >>= okCBOR >>= queryResponse >>= \res -> isQueryReply ecid (requestId req, res) >>= is "", simpleTestCase (name ++ " in update") ecid $ \cid -> do req <- addExpiry $ @@ -2669,25 +2681,27 @@ icTests my_sub other_sub = testGroup name [ simpleTestCase "in query" ecid $ \cid -> do - good_req <- - addNonce >=> addExpiry $ - rec - [ "request_type" =: GText "query", - "sender" =: GBlob defaultUser, - "canister_id" =: GBlob cid, - "method_name" =: GText "query", - "arg" =: GBlob (run ((debugPrint $ i2b $ int 0) >>> reply)) - ] - bad_req <- - addNonce >=> addExpiry $ - rec - [ "request_type" =: GText "query", - "sender" =: GBlob defaultUser, - "canister_id" =: GBlob cid, - "method_name" =: GText "query", - "arg" =: GBlob (run ((debugPrint $ i2b $ int 1) >>> reply)) - ] - queryCBOR cid good_req >>= queryResponse >>= isReply >>= is "" + let good_cbor = + rec + [ "request_type" =: GText "query", + "sender" =: GBlob defaultUser, + "canister_id" =: GBlob cid, + "method_name" =: GText "query", + "arg" =: GBlob (run ((debugPrint $ i2b $ int 0) >>> reply)) + ] + let bad_cbor = + rec + [ "request_type" =: GText "query", + "sender" =: GBlob defaultUser, + "canister_id" =: GBlob cid, + "method_name" =: GText "query", + "arg" =: GBlob (run ((debugPrint $ i2b $ int 1) >>> reply)) + ] + good_req <- addNonce >=> addExpiry $ good_cbor + bad_req <- addNonce >=> addExpiry $ bad_cbor + (rid, res) <- queryCBOR cid good_req + res <- queryResponse res + isQueryReply ecid (rid, res) >>= is "" env (mod_req bad_req) >>= postQueryCBOR cid >>= code4xx, simpleTestCase "in empty read state request" ecid $ \cid -> do good_req <- addNonce >=> addExpiry $ readStateEmpty @@ -2759,13 +2773,13 @@ icTests my_sub other_sub = req <- exampleQuery cid userKey sig <- genSig cid "Hello!" $ "\x0Aic-request" <> requestId req let env = simpleEnv userKey sig req [] - postQueryCBOR cid env >>= okCBOR >>= queryResponse >>= isReply >>= is "It works!", + postQueryCBOR cid env >>= okCBOR >>= queryResponse >>= \res -> isQueryReply ecid (requestId req, res) >>= is "It works!", simpleTestCase "direct signature (empty seed)" ecid $ \cid -> do let userKey = genId cid "" req <- exampleQuery cid userKey sig <- genSig cid "" $ "\x0Aic-request" <> requestId req let env = simpleEnv userKey sig req [] - postQueryCBOR cid env >>= okCBOR >>= queryResponse >>= isReply >>= is "It works!", + postQueryCBOR cid env >>= okCBOR >>= queryResponse >>= \res -> isQueryReply ecid (requestId req, res) >>= is "It works!", simpleTestCase "direct signature (wrong seed)" ecid $ \cid -> do let userKey = genId cid "Hello" req <- exampleQuery cid userKey @@ -2825,7 +2839,7 @@ icTests my_sub other_sub = req <- exampleQuery cid userKey sig <- sign "ic-request" otherSK (requestId req) let env = simpleEnv userKey sig req [signed_delegation] - postQueryCBOR cid env >>= okCBOR >>= queryResponse >>= isReply >>= is "It works!", + postQueryCBOR cid env >>= okCBOR >>= queryResponse >>= \res -> isQueryReply ecid (requestId req, res) >>= is "It works!", simpleTestCase "delegation from Ed25519" ecid $ \cid -> do let userKey = genId cid "Hello!" @@ -2850,7 +2864,7 @@ icTests my_sub other_sub = ] sig <- genSig cid "Hello!" $ "\x0Aic-request" <> requestId req let env = simpleEnv (toPublicKey otherSK) sig req [signed_delegation] - postQueryCBOR cid env >>= okCBOR >>= queryResponse >>= isReply >>= is "It works!" + postQueryCBOR cid env >>= okCBOR >>= queryResponse >>= \res -> isQueryReply ecid (requestId req, res) >>= is "It works!" ] ] ] diff --git a/hs/spec_compliance/src/IC/Test/Spec/CanisterVersion.hs b/hs/spec_compliance/src/IC/Test/Spec/CanisterVersion.hs index 47f6058441c..c116f0e0d19 100644 --- a/hs/spec_compliance/src/IC/Test/Spec/CanisterVersion.hs +++ b/hs/spec_compliance/src/IC/Test/Spec/CanisterVersion.hs @@ -189,7 +189,7 @@ canister_version_tests ecid = ctr2 @?= 2, simpleTestCase "after failed query" ecid $ \cid -> do ctr1 <- query cid (replyData canister_version) >>= asWord64 - query' cid (trap "") >>= isReject [5] + query' cid (trap "") >>= isQueryReject ecid [5] ctr2 <- query cid (replyData canister_version) >>= asWord64 ctr1 @?= 1 ctr2 @?= 1, diff --git a/hs/spec_compliance/src/IC/Test/Spec/Utils.hs b/hs/spec_compliance/src/IC/Test/Spec/Utils.hs index ecb2a23cb3d..30309702aa1 100644 --- a/hs/spec_compliance/src/IC/Test/Spec/Utils.hs +++ b/hs/spec_compliance/src/IC/Test/Spec/Utils.hs @@ -311,20 +311,23 @@ incrementCount :: IO Word32 incrementCount = atomicModifyIORef' counterRef (\count -> (count + 1, count + 1)) -query' :: (HasCallStack, HasAgentConfig) => Blob -> Prog -> IO ReqResponse +query' :: (HasCallStack, HasAgentConfig) => Blob -> Prog -> IO (Blob, QueryResponse) query' cid prog = do ctr <- incrementCount - queryCBOR cid >=> queryResponse $ - rec - [ "request_type" =: GText "query", - "sender" =: GBlob defaultUser, - "canister_id" =: GBlob cid, - "method_name" =: GText "query", - "arg" =: GBlob (run ((debugPrint $ i2b $ int ctr) >>> prog)) - ] + let cbor = + rec + [ "request_type" =: GText "query", + "sender" =: GBlob defaultUser, + "canister_id" =: GBlob cid, + "method_name" =: GText "query", + "arg" =: GBlob (run ((debugPrint $ i2b $ int ctr) >>> prog)) + ] + (rid, res) <- queryCBOR cid cbor + res <- queryResponse res + return (rid, res) query :: (HasCallStack, HasAgentConfig) => Blob -> Prog -> IO Blob -query cid prog = query' cid prog >>= isReply +query cid prog = query' cid prog >>= isQueryReply cid query_ :: (HasCallStack, HasAgentConfig) => Blob -> Prog -> IO () query_ cid prog = query cid prog >>= is "" diff --git a/hs/spec_compliance/src/IC/Types.hs b/hs/spec_compliance/src/IC/Types.hs index 1fa9a76e597..f79b9981637 100644 --- a/hs/spec_compliance/src/IC/Types.hs +++ b/hs/spec_compliance/src/IC/Types.hs @@ -162,7 +162,7 @@ data SubnetConfig = SubnetConfig canister_ranges :: [(W.Word64, W.Word64)] } -type TestSubnetConfig = (EntityId, SubnetType, W.Word64, [(W.Word64, W.Word64)], [String]) +type TestSubnetConfig = (EntityId, SubnetType, [EntityId], [(W.Word64, W.Word64)], [String]) -- Abstract canisters diff --git a/rs/execution_environment/src/query_handler.rs b/rs/execution_environment/src/query_handler.rs index c30f0060b8b..df1e9f634c7 100644 --- a/rs/execution_environment/src/query_handler.rs +++ b/rs/execution_environment/src/query_handler.rs @@ -288,9 +288,10 @@ impl Service<(UserQuery, Option)> for HttpQueryHandler { query.receiver, ) { Some((state, cert)) => { + let time = state.metadata.batch_time; let result = internal.query(query, state, cert); - let http_query_response = match result { + let response = match result { Ok(res) => match res { WasmResult::Reply(vec) => HttpQueryResponse::Replied { reply: HttpQueryResponseReply { arg: Blob(vec) }, @@ -309,7 +310,7 @@ impl Service<(UserQuery, Option)> for HttpQueryHandler { }, }; - Ok(http_query_response) + Ok((response, time)) } None => Err(QueryExecutionError::CertifiedStateUnavailable), }; diff --git a/rs/http_endpoints/public/src/lib.rs b/rs/http_endpoints/public/src/lib.rs index 1923c4c3eeb..540842eeac1 100644 --- a/rs/http_endpoints/public/src/lib.rs +++ b/rs/http_endpoints/public/src/lib.rs @@ -56,6 +56,7 @@ use ic_crypto_utils_threshold_sig_der::parse_threshold_sig_key_from_der; use ic_interfaces::{ artifact_pool::UnvalidatedArtifact, consensus_pool::ConsensusPoolCache, + crypto::BasicSigner, execution_environment::{IngressFilterService, QueryExecutionService}, ingress_pool::IngressPoolThrottler, time_source::TimeSource, @@ -75,7 +76,8 @@ use ic_types::{ malicious_flags::MaliciousFlags, messages::{ Blob, Certificate, CertificateDelegation, HttpReadState, HttpReadStateContent, - HttpReadStateResponse, HttpRequestEnvelope, ReplicaHealthStatus, SignedIngress, + HttpReadStateResponse, HttpRequestEnvelope, QueryResponseHash, ReplicaHealthStatus, + SignedIngress, }, time::expiry_time_from_now, CanisterId, NodeId, SubnetId, @@ -243,6 +245,7 @@ pub fn start_server( ingress_tx: Sender>, time_source: Arc, state_reader: Arc>, + query_signer: Arc + Send + Sync>, registry_client: Arc, tls_handshake: Arc, ingress_verifier: Arc, @@ -296,6 +299,8 @@ pub fn start_server( config.clone(), log.clone(), metrics.clone(), + query_signer, + node_id, Arc::clone(&health_status), Arc::clone(&delegation_from_nns), ValidatorExecutor::new( diff --git a/rs/http_endpoints/public/src/query.rs b/rs/http_endpoints/public/src/query.rs index 1dcbd1ec458..20e82186aa0 100644 --- a/rs/http_endpoints/public/src/query.rs +++ b/rs/http_endpoints/public/src/query.rs @@ -13,12 +13,19 @@ use futures_util::FutureExt; use http::Request; use hyper::{Body, Response, StatusCode}; use ic_config::http_handler::Config; -use ic_interfaces::execution_environment::{QueryExecutionError, QueryExecutionService}; +use ic_interfaces::{ + crypto::BasicSigner, + execution_environment::{QueryExecutionError, QueryExecutionService}, +}; use ic_interfaces_registry::RegistryClient; use ic_logger::{error, ReplicaLogger}; -use ic_types::messages::{ - CertificateDelegation, HasCanisterId, HttpQueryContent, HttpRequest, HttpRequestEnvelope, - SignedRequestBytes, UserQuery, +use ic_types::{ + messages::{ + Blob, CertificateDelegation, HasCanisterId, HttpQueryContent, HttpRequest, + HttpRequestEnvelope, HttpSignedQueryResponse, NodeSignature, QueryResponseHash, + SignedRequestBytes, UserQuery, + }, + NodeId, }; use std::convert::{Infallible, TryFrom}; use std::future::Future; @@ -31,6 +38,8 @@ use tower::{limit::GlobalConcurrencyLimitLayer, util::BoxCloneService, Service, pub(crate) struct QueryService { log: ReplicaLogger, metrics: HttpHandlerMetrics, + node_id: NodeId, + signer: Arc + Send + Sync>, health_status: Arc>, delegation_from_nns: Arc>>, validator_executor: ValidatorExecutor, @@ -44,6 +53,8 @@ impl QueryService { config: Config, log: ReplicaLogger, metrics: HttpHandlerMetrics, + signer: Arc + Send + Sync>, + node_id: NodeId, health_status: Arc>, delegation_from_nns: Arc>>, validator_executor: ValidatorExecutor, @@ -58,6 +69,8 @@ impl QueryService { .service(Self { log, metrics, + node_id, + signer, health_status, delegation_from_nns, validator_executor, @@ -182,8 +195,13 @@ impl Service>> for QueryService { ); let registry_version = self.registry_client.get_latest_version(); + let signer_clone = self.signer.clone(); + let validator_executor = self.validator_executor.clone(); let response_body_size_bytes_metric = self.metrics.response_body_size_bytes.clone(); + let node_id = self.node_id; + let logger = self.log.clone(); + async move { let get_authorized_canisters_fut = validator_executor.validate_request(request.clone(), registry_version); @@ -200,31 +218,67 @@ impl Service>> for QueryService { return Ok(res); } }; - old_query_execution_service - .call((request.take_content(), delegation_from_nns)) - .map(|call_result| { - let query_execution_response = call_result?; - - let response = match query_execution_response { - Err(QueryExecutionError::CertifiedStateUnavailable) => { - make_plaintext_response( - StatusCode::SERVICE_UNAVAILABLE, - "Certified state unavailable. Please try again.".to_string(), - ) - } - Ok(v) => { - let (resp, body_size) = cbor_response(&v); - response_body_size_bytes_metric - .with_label_values(&[ApiReqType::Query.into()]) - .observe(body_size as f64); - - resp - } + let user_query = request.take_content(); + + let query_execution_response = old_query_execution_service + .call((user_query.clone(), delegation_from_nns)) + .await?; + + let (query_response, timestamp) = match query_execution_response { + Err(QueryExecutionError::CertifiedStateUnavailable) => { + return Ok(make_plaintext_response( + StatusCode::SERVICE_UNAVAILABLE, + "Certified state unavailable. Please try again.".to_string(), + )) + } + Ok((response, time)) => (response, time), + }; + + let response_hash = QueryResponseHash::new(&query_response, &user_query, timestamp); + + // We wrap `sign_basic` into `spawn_blocking`, otherwise calling `sign_basic` will panic + // if called from the tokio runtime. + let signature = tokio::task::spawn_blocking(move || { + signer_clone.sign_basic(&response_hash, node_id, registry_version) + }) + .await + .expect("Panicked while attempting to sign the query response."); + + let response = match signature { + Ok(signature) => { + let signature_bytes = signature.get().0; + let signature_blob = Blob(signature_bytes); + + let node_signature = NodeSignature { + signature: signature_blob, + timestamp, + identity: node_id, + }; + + let signed_query_response = HttpSignedQueryResponse { + response: query_response, + node_signature, }; - Ok(response) - }) - .await + let (resp, body_size) = cbor_response(&signed_query_response); + response_body_size_bytes_metric + .with_label_values(&[ApiReqType::Query.into()]) + .observe(body_size as f64); + resp + } + Err(signing_error) => { + error!( + logger, + "Failed to sign the Query response: `{:?}`.", signing_error + ); + make_plaintext_response( + StatusCode::INTERNAL_SERVER_ERROR, + "Failed to sign the Query response.".to_string(), + ) + } + }; + + Ok(response) } .boxed() } diff --git a/rs/http_endpoints/public/tests/common/mod.rs b/rs/http_endpoints/public/tests/common/mod.rs index 25fac62670e..b987e4add91 100644 --- a/rs/http_endpoints/public/tests/common/mod.rs +++ b/rs/http_endpoints/public/tests/common/mod.rs @@ -38,7 +38,7 @@ use ic_registry_subnet_type::SubnetType; use ic_replicated_state::{CanisterQueues, NetworkTopology, ReplicatedState, SystemMetadata}; use ic_test_utilities::{ consensus::MockConsensusCache, - crypto::temp_crypto_component_with_fake_registry, + crypto::{temp_crypto_component_with_fake_registry, CryptoReturningOk}, mock_time, state::ReplicatedStateBuilder, types::ids::{node_test_id, subnet_test_id}, @@ -60,7 +60,7 @@ use ic_types::{ malicious_flags::MaliciousFlags, messages::{CertificateDelegation, SignedIngress, SignedIngressContent, UserQuery}, signature::ThresholdSignature, - CryptoHashOfPartialState, Height, RegistryVersion, + CryptoHashOfPartialState, Height, RegistryVersion, Time, }; use mockall::{mock, predicate::*}; use prost::Message; @@ -114,7 +114,7 @@ fn setup_ingress_filter_mock() -> (IngressFilterService, IngressFilterHandle) { move |request: (ProvisionalWhitelist, SignedIngressContent)| { let mut service_clone = service.clone(); async move { - Ok::, std::convert::Infallible>({ + Ok::, Infallible>({ service_clone .ready() .await @@ -242,6 +242,10 @@ pub fn basic_state_manager_mock() -> MockStateManager { mock_state_manager } +pub fn dummy_timestamp() -> Time { + Time::from_nanos_since_unix_epoch(1_690_000_000_000_000_000) +} + // Basic mock consensus pool cache at height 1. pub fn basic_consensus_pool_cache() -> MockConsensusCache { let mut mock_consensus_cache = MockConsensusCache::new(); @@ -414,6 +418,8 @@ pub fn start_http_endpoint( let tls_handshake = Arc::new(MockTlsHandshake::new()); let sig_verifier = Arc::new(temp_crypto_component_with_fake_registry(node_test_id(0))); + let crypto = Arc::new(CryptoReturningOk::default()); + let time_source = Arc::new(SysTimeSource::new()); let (ingress_tx, ingress_rx) = crossbeam::channel::unbounded(); let mut ingress_pool_throtller = MockIngressPoolThrottler::new(); @@ -430,6 +436,7 @@ pub fn start_http_endpoint( ingress_tx, time_source, state_manager, + crypto as Arc<_>, registry_client, tls_handshake, sig_verifier, diff --git a/rs/http_endpoints/public/tests/load_shed_test.rs b/rs/http_endpoints/public/tests/load_shed_test.rs index 298c2389443..99892ed880e 100644 --- a/rs/http_endpoints/public/tests/load_shed_test.rs +++ b/rs/http_endpoints/public/tests/load_shed_test.rs @@ -3,8 +3,8 @@ pub mod common; use crate::common::{ basic_consensus_pool_cache, basic_registry_client, basic_state_manager_mock, default_certified_state_reader, default_get_latest_state, default_latest_certified_height, - default_read_certified_state, get_free_localhost_socket_addr, start_http_endpoint, - wait_for_status_healthy, + default_read_certified_state, dummy_timestamp, get_free_localhost_socket_addr, + start_http_endpoint, wait_for_status_healthy, }; use async_trait::async_trait; use hyper::{Body, Client, Method, Request, StatusCode}; @@ -96,11 +96,14 @@ fn test_load_shedding_query() { query_exec_running.notify_one(); load_shedder_returned.notified().await; - resp.send_response(Ok(HttpQueryResponse::Replied { - reply: HttpQueryResponseReply { - arg: Blob("success".into()), + resp.send_response(Ok(( + HttpQueryResponse::Replied { + reply: HttpQueryResponseReply { + arg: Blob("success".into()), + }, }, - })) + dummy_timestamp(), + ))) }); rt.block_on(async { diff --git a/rs/http_endpoints/public/tests/test.rs b/rs/http_endpoints/public/tests/test.rs index e20443e6d09..667e813f041 100644 --- a/rs/http_endpoints/public/tests/test.rs +++ b/rs/http_endpoints/public/tests/test.rs @@ -5,8 +5,8 @@ pub mod common; use crate::common::{ basic_consensus_pool_cache, basic_registry_client, basic_state_manager_mock, - create_conn_and_send_request, get_free_localhost_socket_addr, start_http_endpoint, - wait_for_status_healthy, + create_conn_and_send_request, dummy_timestamp, get_free_localhost_socket_addr, + start_http_endpoint, wait_for_status_healthy, }; use hyper::{Body, Client, Method, Request, StatusCode}; use ic_agent::{ @@ -241,11 +241,14 @@ fn test_unauthorized_query() { rt.spawn(async move { loop { let (_, resp) = query_handler.next_request().await.unwrap(); - resp.send_response(Ok(HttpQueryResponse::Replied { - reply: HttpQueryResponseReply { - arg: Blob("success".into()), + resp.send_response(Ok(( + HttpQueryResponse::Replied { + reply: HttpQueryResponseReply { + arg: Blob("success".into()), + }, }, - })) + dummy_timestamp(), + ))) } }); @@ -467,11 +470,14 @@ fn test_request_timeout() { loop { let (_, resp) = query_handler.next_request().await.unwrap(); sleep(Duration::from_secs(request_timeout_seconds + 1)).await; - resp.send_response(Ok(HttpQueryResponse::Replied { - reply: HttpQueryResponseReply { - arg: Blob("success".into()), + resp.send_response(Ok(( + HttpQueryResponse::Replied { + reply: HttpQueryResponseReply { + arg: Blob("success".into()), + }, }, - })) + dummy_timestamp(), + ))) } }); diff --git a/rs/interfaces/src/crypto.rs b/rs/interfaces/src/crypto.rs index 69c029c3ab6..9c2660332a6 100644 --- a/rs/interfaces/src/crypto.rs +++ b/rs/interfaces/src/crypto.rs @@ -28,8 +28,10 @@ use ic_types::consensus::{ BlockMetadata, CatchUpContent, CatchUpContentProtobufBytes, FinalizationContent, NotarizationContent, RandomBeaconContent, RandomTapeContent, }; -use ic_types::crypto::canister_threshold_sig::idkg::{IDkgDealing, SignedIDkgDealing}; -use ic_types::messages::{MessageId, WebAuthnEnvelope}; +use ic_types::{ + crypto::canister_threshold_sig::idkg::{IDkgDealing, SignedIDkgDealing}, + messages::{MessageId, QueryResponseHash, WebAuthnEnvelope}, +}; /// The functionality offered by the crypto component pub trait Crypto: @@ -72,6 +74,8 @@ pub trait Crypto: // CanisterHttpResponse + BasicSigner + BasicSigVerifier + // Signed Queries + + BasicSigner // RequestId/WebAuthn + BasicSigVerifierByPublicKey + BasicSigVerifierByPublicKey @@ -131,6 +135,7 @@ impl Crypto for T where + BasicSigVerifier + BasicSigner + BasicSigVerifier + + BasicSigner + IDkgProtocol + ThresholdEcdsaSigner + ThresholdEcdsaSigVerifier diff --git a/rs/interfaces/src/execution_environment.rs b/rs/interfaces/src/execution_environment.rs index ac6a9759aca..34e9f17df6d 100644 --- a/rs/interfaces/src/execution_environment.rs +++ b/rs/interfaces/src/execution_environment.rs @@ -350,7 +350,8 @@ pub enum QueryExecutionError { } /// The response type to a `call()` request in [`QueryExecutionService`]. -pub type QueryExecutionResponse = Result; +/// An Ok response contains the response from the canister and the batch time at the time of execution. +pub type QueryExecutionResponse = Result<(HttpQueryResponse, Time), QueryExecutionError>; /// Interface for the component to execute queries. pub type QueryExecutionService = diff --git a/rs/replica/src/setup_ic_stack.rs b/rs/replica/src/setup_ic_stack.rs index 35195bd5bc8..cb0a9a036db 100755 --- a/rs/replica/src/setup_ic_stack.rs +++ b/rs/replica/src/setup_ic_stack.rs @@ -296,6 +296,7 @@ pub fn construct_ic_stack( ingress_tx.clone(), time_source, Arc::clone(&state_manager) as Arc<_>, + Arc::clone(&crypto) as Arc<_>, registry, Arc::clone(&crypto) as Arc<_>, Arc::clone(&crypto) as Arc<_>, diff --git a/rs/tests/src/spec_compliance.rs b/rs/tests/src/spec_compliance.rs index 6a0a04909b6..81a24ce309c 100644 --- a/rs/tests/src/spec_compliance.rs +++ b/rs/tests/src/spec_compliance.rs @@ -196,14 +196,18 @@ pub fn test_subnet( fn subnet_config(subnet: &SubnetSnapshot) -> String { format!( - "(\"{}\",{},{},[{}],[{}])", + "(\"{}\",{},[{}],[{}],[{}])", subnet.subnet_id, match subnet.subnet_type() { SubnetType::VerifiedApplication => "verified_application", SubnetType::Application => "application", SubnetType::System => "system", }, - REPLICATION_FACTOR, + subnet + .nodes() + .map(|n| format!("\"{}\"", n.node_id)) + .collect::>() + .join(","), subnet .subnet_canister_ranges() .iter() diff --git a/rs/types/types/src/crypto/hash.rs b/rs/types/types/src/crypto/hash.rs index dbc0edc2894..bcca56dbe59 100644 --- a/rs/types/types/src/crypto/hash.rs +++ b/rs/types/types/src/crypto/hash.rs @@ -72,6 +72,11 @@ const DOMAIN_MESSAGEID: &str = "messageid_domain"; // TODO: remove once NET-1501 is done const _DOMAIN_IC_ONCHAIN_OBSERVABILITY_REPORT: &str = "ic-onchain-observability-report-domain"; +/// The domain separator to be used when calculating the signature for a +/// query response from a replica. +/// [interface specification](https://sdk.dfinity.org/docs/interface-spec/index.html). +pub(crate) const DOMAIN_QUERY_RESPONSE: &str = "ic-response"; + pub(crate) const DOMAIN_RANDOM_TAPE_CONTENT: &str = "random_tape_content_domain"; const DOMAIN_RANDOM_TAPE: &str = "random_tape_domain"; const DOMAIN_RANDOM_TAPE_SHARE: &str = "random_tape_share_domain"; diff --git a/rs/types/types/src/crypto/sign.rs b/rs/types/types/src/crypto/sign.rs index 0c1a98433dd..467d17ea08b 100644 --- a/rs/types/types/src/crypto/sign.rs +++ b/rs/types/types/src/crypto/sign.rs @@ -13,11 +13,11 @@ use crate::crypto::hash::{ DOMAIN_BLOCK_METADATA, DOMAIN_CATCH_UP_CONTENT, DOMAIN_CERTIFICATION_CONTENT, DOMAIN_CRYPTO_HASH_OF_CANISTER_HTTP_RESPONSE_METADATA, DOMAIN_DEALING_CONTENT, DOMAIN_ECDSA_COMPLAINT_CONTENT, DOMAIN_ECDSA_OPENING_CONTENT, DOMAIN_FINALIZATION_CONTENT, - DOMAIN_IDKG_DEALING, DOMAIN_NOTARIZATION_CONTENT, DOMAIN_RANDOM_BEACON_CONTENT, - DOMAIN_RANDOM_TAPE_CONTENT, DOMAIN_SIGNED_IDKG_DEALING, + DOMAIN_IDKG_DEALING, DOMAIN_NOTARIZATION_CONTENT, DOMAIN_QUERY_RESPONSE, + DOMAIN_RANDOM_BEACON_CONTENT, DOMAIN_RANDOM_TAPE_CONTENT, DOMAIN_SIGNED_IDKG_DEALING, }; use crate::crypto::SignedBytesWithoutDomainSeparator; -use crate::messages::{Delegation, MessageId, WebAuthnEnvelope}; +use crate::messages::{Delegation, MessageId, QueryResponseHash, WebAuthnEnvelope}; use std::convert::TryFrom; const SIG_DOMAIN_IC_REQUEST_AUTH_DELEGATION: &str = "ic-request-auth-delegation"; @@ -54,7 +54,10 @@ pub trait SignatureDomain: private::SignatureDomainSeal { mod private { use super::*; - use crate::crypto::canister_threshold_sig::idkg::{IDkgDealing, SignedIDkgDealing}; + use crate::{ + crypto::canister_threshold_sig::idkg::{IDkgDealing, SignedIDkgDealing}, + messages::QueryResponseHash, + }; pub trait SignatureDomainSeal {} @@ -77,6 +80,7 @@ mod private { impl SignatureDomainSeal for RandomBeaconContent {} impl SignatureDomainSeal for RandomTapeContent {} impl SignatureDomainSeal for SignableMock {} + impl SignatureDomainSeal for QueryResponseHash {} } impl SignatureDomain for CanisterHttpResponseMetadata { @@ -192,6 +196,12 @@ impl SignatureDomain for RandomTapeContent { } } +impl SignatureDomain for QueryResponseHash { + fn domain(&self) -> Vec { + domain_with_prepended_length(DOMAIN_QUERY_RESPONSE) + } +} + // Returns a vector of bytes that contains the given domain // prepended with a single byte that holds the length of the domain. // This is the recommended format for non-empty domain separators, diff --git a/rs/types/types/src/messages.rs b/rs/types/types/src/messages.rs index 82411c1f959..93eea3a6a88 100644 --- a/rs/types/types/src/messages.rs +++ b/rs/types/types/src/messages.rs @@ -12,8 +12,9 @@ pub use self::http::{ Authentication, Certificate, CertificateDelegation, Delegation, HasCanisterId, HttpCallContent, HttpCanisterUpdate, HttpQueryContent, HttpQueryResponse, HttpQueryResponseReply, HttpReadState, HttpReadStateContent, HttpReadStateResponse, HttpReply, HttpRequest, HttpRequestContent, - HttpRequestEnvelope, HttpRequestError, HttpStatusResponse, HttpUserQuery, RawHttpRequestVal, - ReplicaHealthStatus, SignedDelegation, + HttpRequestEnvelope, HttpRequestError, HttpSignedQueryResponse, HttpStatusResponse, + HttpUserQuery, NodeSignature, QueryResponseHash, RawHttpRequestVal, ReplicaHealthStatus, + SignedDelegation, }; pub use crate::methods::SystemMethod; use crate::{user_id_into_protobuf, user_id_try_from_protobuf, Cycles, Funds, NumBytes, UserId}; diff --git a/rs/types/types/src/messages/http.rs b/rs/types/types/src/messages/http.rs index aec954089c0..5b937c4b02e 100644 --- a/rs/types/types/src/messages/http.rs +++ b/rs/types/types/src/messages/http.rs @@ -12,12 +12,12 @@ use crate::{ Height, Time, UserId, }; use derive_more::Display; -use ic_base_types::{CanisterId, CanisterIdError, PrincipalId}; +use ic_base_types::{CanisterId, CanisterIdError, NodeId, PrincipalId}; use ic_crypto_tree_hash::{MixedHashTree, Path}; use maplit::btreemap; #[cfg(test)] use proptest_derive::Arbitrary; -use serde::{Deserialize, Serialize}; +use serde::{ser::SerializeTuple, Deserialize, Serialize}; use std::{collections::BTreeSet, convert::TryFrom, error::Error, fmt}; #[cfg(test)] @@ -568,8 +568,7 @@ pub enum HttpReply { Empty {}, } -/// The response to `/api/v2/canister/_/{read_state|query}` with `request_type` -/// set to `query`. +/// The response for a query call from the execution service. #[derive(Debug, Clone, Serialize, Deserialize, PartialEq, Eq)] #[serde(rename_all = "snake_case")] #[serde(tag = "status")] @@ -584,6 +583,95 @@ pub enum HttpQueryResponse { }, } +/// Wraps the hash of a query response as described +/// in the [IC interface-spec](https://internetcomputer.org/docs/current/references/ic-interface-spec#http-query). +pub struct QueryResponseHash([u8; 32]); + +impl QueryResponseHash { + /// Creates a [`QueryResponseHash`] from a given query response, request and timestamp. + pub fn new(response: &HttpQueryResponse, request: &UserQuery, timestamp: Time) -> Self { + use RawHttpRequestVal::*; + + let self_map_representation = match response { + HttpQueryResponse::Replied { reply } => { + btreemap! { + "request_id".to_string() => Bytes(request.id().as_bytes().to_vec()), + "status".to_string() => String("replied".to_string()), + "timestamp".to_string() => U64(timestamp.as_nanos_since_unix_epoch()), + "reply".to_string() => Bytes(reply.arg.0.clone()), + } + } + HttpQueryResponse::Rejected { + error_code, + reject_code, + reject_message, + } => { + btreemap! { + "request_id".to_string() => Bytes(request.id().as_bytes().to_vec()), + "status".to_string() => String("rejected".to_string()), + "timestamp".to_string() => U64(timestamp.as_nanos_since_unix_epoch()), + "reject_code".to_string() => U64(*reject_code), + "reject_message".to_string() => String(reject_message.to_string()), + "error_code".to_string() => String(error_code.to_string()), + + } + } + }; + + let hash = hash_of_map(&self_map_representation); + + Self(hash) + } +} + +impl SignedBytesWithoutDomainSeparator for QueryResponseHash { + fn as_signed_bytes_without_domain_separator(&self) -> Vec { + self.0.to_vec() + } +} + +/// The response to `/api/v2/canister/_/query`. +#[derive(Debug, Clone, Serialize, Deserialize, PartialEq, Eq)] +#[serde(rename_all = "snake_case")] +pub struct HttpSignedQueryResponse { + #[serde(flatten)] + pub response: HttpQueryResponse, + + /// The signature of this replica node for the query response. + /// + /// Note: + /// To follow the IC specification for signed query responses, + /// the serializer will during serialization: + /// - rename the field: `node_signature` -> `signatures`. + /// - Convert the signature to a 1-tuple containing only this signature. + #[serde(serialize_with = "serialize_node_signature_to_1_tuple")] + #[serde(rename = "signatures")] + pub node_signature: NodeSignature, +} + +/// Serializes a `NodeSignature` to a 1-tuple containing only that one signature. +fn serialize_node_signature_to_1_tuple( + signature: &NodeSignature, + serializer: S, +) -> Result +where + S: serde::Serializer, +{ + let mut tup = serializer.serialize_tuple(1)?; + tup.serialize_element(signature)?; + tup.end() +} + +#[derive(Debug, Clone, Serialize, Deserialize, PartialEq, Eq)] +pub struct NodeSignature { + /// The time of creation of the signature (or the batch time). + pub timestamp: Time, + /// The actual signature. + pub signature: Blob, + /// The node id of the node that created this signature. + pub identity: NodeId, +} + /// The body of the `QueryResponse` #[derive(Debug, Clone, Serialize, Deserialize, PartialEq, Eq)] pub struct HttpQueryResponseReply { diff --git a/rs/types/types/src/messages/http/tests.rs b/rs/types/types/src/messages/http/tests.rs index c6444bb8292..354267d1426 100644 --- a/rs/types/types/src/messages/http/tests.rs +++ b/rs/types/types/src/messages/http/tests.rs @@ -552,13 +552,18 @@ mod try_from { } mod cbor_serialization { - - use crate::messages::http::btreemap; - use crate::messages::{ - Blob, Delegation, HttpQueryResponse, HttpQueryResponseReply, HttpStatusResponse, - ReplicaHealthStatus, SignedDelegation, + use crate::{ + messages::{ + http::{btreemap, HttpSignedQueryResponse, NodeSignature}, + Blob, Delegation, HttpQueryResponse, HttpQueryResponseReply, HttpStatusResponse, + ReplicaHealthStatus, SignedDelegation, + }, + time::UNIX_EPOCH, + AmountOf, Time, }; - use crate::{time::UNIX_EPOCH, AmountOf}; + + use candid::Principal; + use ic_base_types::{NodeId, PrincipalId}; use pretty_assertions::assert_eq; use serde::Serialize; use serde_cbor::Value; @@ -585,36 +590,85 @@ mod cbor_serialization { Value::Bytes(bs.to_vec()) } + fn vec(values: [Value; N]) -> Value { + Value::Array(Vec::from(values)) + } + + /// Returns a [`NodeId`] and its underlying byte array representation. + pub fn node_id_and_bytes_repr() -> (NodeId, [u8; 8]) { + let node_id_bytes: [u8; 8] = [15, 0, 0, 0, 0, 0, 0, 0]; + let principal_id = PrincipalId(Principal::from_slice(&node_id_bytes)); + + let node_id = NodeId::from(principal_id); + + (node_id, node_id_bytes) + } + #[test] fn encoding_read_query_response() { + let (node_id, node_id_bytes) = node_id_and_bytes_repr(); + + let time = 2614; assert_cbor_ser_equal( - &HttpQueryResponse::Replied { - reply: HttpQueryResponseReply { - arg: Blob(b"some_bytes".to_vec()), + &HttpSignedQueryResponse { + response: HttpQueryResponse::Replied { + reply: HttpQueryResponseReply { + arg: Blob(b"some_bytes".to_vec()), + }, + }, + node_signature: NodeSignature { + timestamp: Time::from_nanos_since_unix_epoch(time), + signature: Blob(b"Some node signature bytes.".to_vec()), + identity: node_id, }, }, Value::Map(btreemap! { text("status") => text("replied"), text("reply") => Value::Map(btreemap!{ text("arg") => bytes(b"some_bytes") - }) + }), + text("signatures") => vec([ + Value::Map(btreemap!{ + text("timestamp") => int(time), + text("signature") => bytes(b"Some node signature bytes."), + text("identity") => bytes(&node_id_bytes), + }) + ]), }), ); } #[test] fn encoding_read_query_reject() { + let (node_id, node_id_bytes) = node_id_and_bytes_repr(); + + let time = 2614; + assert_cbor_ser_equal( - &HttpQueryResponse::Rejected { - reject_code: 1, - reject_message: "system error".to_string(), - error_code: "IC500".to_string(), + &HttpSignedQueryResponse { + response: HttpQueryResponse::Rejected { + reject_code: 1, + reject_message: "system error".to_string(), + error_code: "IC500".to_string(), + }, + node_signature: NodeSignature { + timestamp: Time::from_nanos_since_unix_epoch(time), + signature: Blob(b"Some node signature bytes.".to_vec()), + identity: node_id, + }, }, Value::Map(btreemap! { text("status") => text("rejected"), text("reject_code") => int(1), text("reject_message") => text("system error"), text("error_code") => text("IC500"), + text("signatures") => vec([ + Value::Map(btreemap!{ + text("timestamp") => int(time), + text("signature") => bytes(b"Some node signature bytes."), + text("identity") => bytes(&node_id_bytes), + }) + ]), }), ); }