diff --git a/src/IC/Test/Spec.hs b/src/IC/Test/Spec.hs index 752d53bf..c5e54da6 100644 --- a/src/IC/Test/Spec.hs +++ b/src/IC/Test/Spec.hs @@ -2574,10 +2574,17 @@ icTests my_sub other_sub = , "sender" =: GBlob defaultUser , "canister_id" =: GBlob cid , "method_name" =: GText "query" - , "arg" =: GBlob (run reply) + , "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 "" - env (mod_req good_req) >>= postQueryCBOR cid >>= code4xx + env (mod_req bad_req) >>= postQueryCBOR cid >>= code4xx , simpleTestCase "in empty read state request" ecid $ \cid -> do good_req <- addNonce >=> addExpiry $ readStateEmpty diff --git a/src/IC/Test/Spec/Utils.hs b/src/IC/Test/Spec/Utils.hs index 3dd234e4..fb46e43b 100644 --- a/src/IC/Test/Spec/Utils.hs +++ b/src/IC/Test/Spec/Utils.hs @@ -17,6 +17,7 @@ import qualified Data.Set as S import qualified Data.Vector as Vec import qualified Data.Word as W import Numeric.Natural +import Data.IORef import Data.List import Test.Tasty import Test.Tasty.HUnit @@ -30,8 +31,7 @@ import Network.HTTP.Client import qualified Data.Binary.Get as Get import Codec.Candid (Principal(..)) import qualified Codec.Candid as Candid -import Control.Concurrent -import System.Timeout +import System.IO.Unsafe (unsafePerformIO) import IC.HTTP.GenR import IC.HTTP.RequestId @@ -289,14 +289,24 @@ callTwice' :: (HasCallStack, HasAgentConfig) => Blob -> Prog -> IO ReqResponse callTwice' cid prog = awaitCallTwice cid (callRequest cid prog) +counterRef :: IORef Word32 +counterRef = + unsafePerformIO (newIORef 0) +{-# NOINLINE counterRef #-} + +incrementCount :: IO Word32 +incrementCount = + atomicModifyIORef' counterRef (\count -> (count + 1, count + 1)) + query' :: (HasCallStack, HasAgentConfig) => Blob -> Prog -> IO ReqResponse -query' cid prog = +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 prog) + , "arg" =: GBlob (run ((debugPrint $ i2b $ int ctr) >>> prog)) ] query :: (HasCallStack, HasAgentConfig) => Blob -> Prog -> IO Blob