@@ -63,19 +63,34 @@ main = defaultMain [ testCase "encode RPC error" testEncodeRpcError
63
63
rsp = errResponse nonNullId (- 32602 )
64
64
in testCase " disallow extra unnamed arguments" $ assertSubtractResponse req rsp
65
65
66
- , testCase " invalid notification" testNoResponseToInvalidNotification
66
+ , let req = TestRequest " 12345" (Nothing :: Maybe () ) Nothing
67
+ in testCase " invalid notification" $ callSubtractMethods req @?= (Nothing :: Maybe Value )
68
+
67
69
, testCase " batch request" testBatch
68
70
, testCase " batch notifications" testBatchNotifications
69
71
, testCase " allow missing version" testAllowMissingVersion
70
72
, testCase " no arguments" testNoArgs
71
73
, testCase " empty argument array" testEmptyUnnamedArgs
72
74
, testCase " empty argument object" testEmptyNamedArgs
73
- , testCase " allow extra named argument" testAllowExtraNamedArg
74
- , testCase " use default named argument" testDefaultNamedArg
75
- , testCase " use default unnamed argument" testDefaultUnnamedArg
76
- , testCase " null request ID" testNullId
75
+
76
+ , let req = subtractRequestNamed [(" x" , Number 10 ), (" y" , Number 20 ), (" z" , String " extra" )] nonNullId
77
+ rsp = TestResponse nonNullId $ Right $ Number (- 10 )
78
+ in testCase " allow extra named argument" $ assertSubtractResponse req rsp
79
+
80
+ , let req = subtractRequestNamed [(" x1" , Number 500 ), (" x" , Number 1000 )] nonNullId
81
+ rsp = TestResponse nonNullId (Right $ Number 1000 )
82
+ in testCase " use default named argument" $ assertSubtractResponse req rsp
83
+
84
+ , let req = subtractRequestUnnamed [Number 4 ] nonNullId
85
+ rsp = TestResponse nonNullId (Right $ Number 4 )
86
+ in testCase " use default unnamed argument" $ assertSubtractResponse req rsp
87
+
88
+ , let req = subtractRequestNamed [(" y" , Number 70 ), (" x" , Number (- 10 ))] idNull
89
+ rsp = TestResponse idNull (Right $ Number (- 80 ))
90
+ in testCase " null request ID" $ assertSubtractResponse req rsp
91
+
77
92
, testCase " parallelize tasks" P. testParallelizingTasks ]
78
-
93
+
79
94
testEncodeRpcError :: Assertion
80
95
testEncodeRpcError = fromByteString (encode err) @?= Just testError
81
96
where err = rpcError (- 1 ) " error"
@@ -100,11 +115,6 @@ testWrongVersion = removeErrMsg <$> rsp @?= Just (errResponse idNull (-32600))
100
115
where rsp = callSubtractMethods $ Object $ H. insert versionKey (String " 1" ) hm
101
116
Object hm = toJSON $ subtractRequestNamed [(" x" , Number 4 )] nonNullId
102
117
103
- testNoResponseToInvalidNotification :: Assertion
104
- testNoResponseToInvalidNotification = runIdentity response @?= Nothing
105
- where response = call (toMethods [subtractMethod]) $ encode request
106
- request = TestRequest " 12345" (Nothing :: Maybe () ) Nothing
107
-
108
118
testBatch :: Assertion
109
119
testBatch = sortBy (compare `on` fromIntId) (fromJust (fromByteString =<< runIdentity response)) @?= expected
110
120
where expected = [TestResponse i1 (Right $ Number 2 ), TestResponse i2 (Right $ Number 4 )]
@@ -127,32 +137,6 @@ testAllowMissingVersion = (fromByteString =<< runIdentity response) @?= (Just $
127
137
response = call (toMethods [subtractMethod]) $ encode requestNoVersion
128
138
i = idNumber (- 1 )
129
139
130
- testAllowExtraNamedArg :: Assertion
131
- testAllowExtraNamedArg = (fromByteString =<< runIdentity response) @?= (Just $ TestResponse i (Right $ Number (- 10 )))
132
- where response = call (toMethods [subtractMethod]) $ encode request
133
- request = subtractRequestNamed args i
134
- args = [(" x" , Number 10 ), (" y" , Number 20 ), (" z" , String " extra" )]
135
- i = idString " ID"
136
-
137
- testDefaultNamedArg :: Assertion
138
- testDefaultNamedArg = (fromByteString =<< runIdentity response) @?= (Just $ TestResponse i (Right $ Number 1000 ))
139
- where response = call (toMethods [subtractMethod]) $ encode request
140
- request = subtractRequestNamed args i
141
- args = [(" x1" , Number 500 ), (" x" , Number 1000 )]
142
- i = idNumber 3
143
-
144
- testDefaultUnnamedArg :: Assertion
145
- testDefaultUnnamedArg = (fromByteString =<< runIdentity response) @?= (Just $ TestResponse i (Right $ Number 4 ))
146
- where response = call (toMethods [subtractMethod]) $ encode request
147
- request = subtractRequestUnnamed [Number 4 ] i
148
- i = idNumber 0
149
-
150
- testNullId :: Assertion
151
- testNullId = (fromByteString =<< runIdentity response) @?= (Just $ TestResponse idNull (Right $ Number (- 80 )))
152
- where response = call (toMethods [subtractMethod]) $ encode request
153
- request = subtractRequestNamed args idNull
154
- args = [(" y" , Number 70 ), (" x" , Number (- 10 ))]
155
-
156
140
testNoArgs :: Assertion
157
141
testNoArgs = compareGetTimeResult Nothing
158
142
@@ -175,10 +159,10 @@ compareGetTimeResult requestArgs = assertEqual "unexpected rpc response" expecte
175
159
i = idString " Id 1"
176
160
177
161
subtractRequestNamed :: [(Text , Value )] -> TestId -> TestRequest
178
- subtractRequestNamed args i = TestRequest " subtract 1 " (Just $ H. fromList args) (Just i)
162
+ subtractRequestNamed args i = TestRequest " subtract" (Just $ H. fromList args) (Just i)
179
163
180
164
subtractRequestUnnamed :: [Value ] -> TestId -> TestRequest
181
- subtractRequestUnnamed args i = TestRequest " subtract 1 " (Just args) (Just i)
165
+ subtractRequestUnnamed args i = TestRequest " subtract" (Just args) (Just i)
182
166
183
167
callSubtractMethods :: (ToJSON a , FromJSON b ) => a -> Maybe b
184
168
callSubtractMethods req = let methods :: Methods Identity
@@ -192,7 +176,7 @@ fromByteString str = case fromJSON <$> decode str of
192
176
_ -> Nothing
193
177
194
178
subtractMethod :: Method Identity
195
- subtractMethod = toMethod " subtract 1 " sub (Required " x" :+: Optional " y" 0 :+: () )
179
+ subtractMethod = toMethod " subtract" sub (Required " x" :+: Optional " y" 0 :+: () )
196
180
where sub :: Int -> Int -> RpcResult Identity Int
197
181
sub x y = return (x - y)
198
182
0 commit comments