implement CRP-1951 in ic-hs (#154)

* implement CRP-1951 in ic-hs * drop obsolete same delegations test
dfinity · Mar 23, 2023 · 3d61cfc · 3d61cfc
1 parent f207e26
commit 3d61cfc
Show file tree

Hide file tree

Showing 2 changed files with 16 additions and 5 deletions.
diff --git a/src/IC/HTTP/Request.hs b/src/IC/HTTP/Request.hs
@@ -40,7 +40,7 @@ stripEnvelope root_key gr = runWriterT $ flip record gr $ do
                 throwError "Public key not authorized to sign for user"
 
             delegations <- optionalField (listOf delegationField) "sender_delegation"
-            pk' <- checkDelegations pk (fromMaybe [] delegations)
+            pk' <- checkDelegations pk [pk] (fromMaybe [] delegations)
 
             let rid = requestId content
             lift $ lift $
@@ -56,17 +56,19 @@ stripEnvelope root_key gr = runWriterT $ flip record gr $ do
     return content
 
     where
-      checkDelegations pk [] = return pk
-      checkDelegations pk ((pk', Timestamp expiry, targets, hash, sig):ds) = do
+      checkDelegations pk _ [] = return pk
+      checkDelegations pk pks ((pk', Timestamp expiry, targets, hash, sig):ds) = do
           lift $ lift $ verify root_key "ic-request-auth-delegation" pk hash sig
+          when (pk' `elem` pks) $ throwError "Every public key in the chain of delegations must appear exactly once"
           tell $ validWhen $ \(Timestamp t) ->
               unless (expiry > t) $
                 throwError $ "Delegation expiry is " <> T.pack (show ((t - expiry)`div`1000_000_000)) <> " seconds in the past"
+          unless (length (fromMaybe [] targets) <= 1000) $ throwError "Delegation can specify at most 1000 targets"
           for_ targets $ \ts ->
             tell $ validWhere $ \c ->
               unless (c `elem` ts) $
                 throwError "Delegation does not apply to this canister"
-          checkDelegations pk' ds
+          checkDelegations pk' (pk':pks) ds
 
 
       checkExpiry :: GenR -> RecordM (WriterT EnvValidity (Either T.Text)) ()

diff --git a/src/IC/Test/Spec.hs b/src/IC/Test/Spec.hs
@@ -2454,6 +2454,8 @@ icTests my_sub other_sub =
       withEd25519 = zip [createSecretKeyEd25519 (BS.singleton n) | n <- [0..]]
       withWebAuthnECDSA = zip [createSecretKeyWebAuthnECDSA (BS.singleton n) | n <- [0..]]
       withWebAuthnRSA = zip [createSecretKeyWebAuthnRSA (BS.singleton n) | n <- [0..]]
+      withSelfLoop = zip [createSecretKeyEd25519 (BS.singleton n) | n <- repeat 0]
+      withCycle = zip [createSecretKeyEd25519 (BS.singleton n) | n <- [y | _ <- [(0::Integer)..], y <- [0, 1]]]
 
     in
     [ goodTestCase "one delegation, singleton target" callReq $ \cid ->
@@ -2462,6 +2464,10 @@ icTests my_sub other_sub =
       withEd25519 [Just [doesn'tExist]]
     , goodTestCase "one delegation, two targets" callReq $ \cid ->
       withEd25519 [Just [cid, doesn'tExist]]
+    , goodTestCase "one delegation, many targets" callReq $ \cid ->
+      withEd25519 [Just (cid:map wordToId' [0..998])]
+    , badTestCase "one delegation, too many targets" callReq $ \cid ->
+      withEd25519 [Just (cid:map wordToId' [0..999])]
     , goodTestCase "two delegations, two targets, webauthn ECDSA" callReq $ \cid ->
       withWebAuthnECDSA [Just [cid, doesn'tExist], Just [cid, doesn'tExist]]
     , goodTestCase "two delegations, two targets, webauthn RSA" callReq $ \cid ->
@@ -2480,6 +2486,10 @@ icTests my_sub other_sub =
       withEd25519 [Just [], Just [cid]]
     , badTestCase "two delegations, second empty target set" callReq $ \cid ->
       withEd25519 [Just [cid], Just []]
+    , badTestCase "self-loop in delegations" callReq $ \cid ->
+      withSelfLoop [Just [cid], Just [cid]]
+    , badTestCase "cycle in delegations" callReq $ \cid ->
+      withCycle [Just [cid], Just [cid], Just [cid]]
     , goodTestCase "management canister: correct target" mgmtReq $ \_cid ->
       withEd25519 [Just [""]]
     , badTestCase "management canister: empty target set" mgmtReq $ \_cid ->
@@ -2502,7 +2512,6 @@ icTests my_sub other_sub =
       , ("WebAuthn ECDSA",     webAuthnECDSAUser, envelope webAuthnECDSASK)
       , ("WebAuthn RSA",       webAuthnRSAUser,   envelope webAuthnRSASK)
       , ("empty delegations",  otherUser,         delEnv [])
-      , ("same delegations",   otherUser,         delEnv [otherSK])
       , ("three delegations",  otherUser,         delEnv [ed25519SK2, ed25519SK3])
       , ("four delegations",   otherUser,         delEnv [ed25519SK2, ed25519SK3, ed25519SK4])
       , ("mixed delegations",  otherUser,         delEnv [defaultSK, webAuthnECDSASK, webAuthnRSASK, ecdsaSK, secp256k1SK])