json-rpc-generic-0.2.0.0: test/Eq.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}

module Eq (tests) where

import Test.QuickCheck.Simple (Test, eqTest)

import GHC.Generics (Generic)

import Prelude hiding (id)
import Control.Applicative ((<$>))
import Data.Maybe (fromMaybe)
import Data.Aeson (FromJSON)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson

import Data.JsonRpc
  (Id(..), numberId, Request (..),
   Success, success, Failure, failure, Response (..),
   genericParseJSONRPC, JsonRpcOptions (..), defaultJsonRpcOptions, )
import qualified Data.JsonRpc.Failure as Failure


data Foo =
  Foo
  { foo :: Int
  , bar :: String
  , baz :: [Int]
  } deriving (Eq, Show, Generic)

instance FromJSON Foo where
  parseJSON = genericParseJSONRPC defaultJsonRpcOptions Aeson.defaultOptions

eqDecodeO :: Test
eqDecodeO =
  eqTest "eq - decode object"
  (Aeson.decode
   "{\"jsonrpc\": \"2.0\", \"method\": \"foo\", \"params\": { \"bar\": \"Hello\", \"foo\": 234, \"baz\": [5, 6, 7, 8] }, \"id\": 3}")
  (Just Request { jsonrpc = "2.0"
                , method = "foo"
                , params = Just (Foo {foo = 234, bar = "Hello", baz = [5,6,7,8]})
                , id = Just (NumberId 3)}
  )

eqDecodeA :: Test
eqDecodeA =
  eqTest "eq - decode array"
  (Aeson.decode
   "{\"jsonrpc\": \"2.0\", \"method\": \"foo\", \"params\": [ 234, \"Hello\", [5, 6, 7, 8] ], \"id\": 3}")
  (Just Request { jsonrpc = "2.0"
                , method = "foo"
                , params = Just (Foo {foo = 234, bar = "Hello", baz = [5,6,7,8]})
                , id = Just (NumberId 3)}
  )


newtype FooNE = FooNE Foo deriving (Eq, Show)

instance FromJSON FooNE where
  parseJSON =
    (FooNE <$>)
    . genericParseJSONRPC defaultJsonRpcOptions { allowNonExistField = False } Aeson.defaultOptions

eqDecodeNonExistAllow :: Test
eqDecodeNonExistAllow =
  eqTest "eq - decode object - allow non-exist"
  (Aeson.decode
   "{\"jsonrpc\": \"2.0\", \"method\": \"foo\", \"params\": { \"bar\": \"Hello\", \"foo\": 234, \"baz\": [5, 6, 7, 8], \"x\": 0 }, \"id\": 3}")
  (Just Request { jsonrpc = "2.0"
                , method = "foo"
                , params = Just (Foo {foo = 234, bar = "Hello", baz = [5,6,7,8]})
                , id = Just (NumberId 3)}
  )

eqDecodeNonExistDisallow :: Test
eqDecodeNonExistDisallow =
  eqTest "eq - decode object - don't allow non-exist - error"
  (Aeson.decode
   "{\"jsonrpc\": \"2.0\", \"method\": \"foo\", \"params\": { \"bar\": \"Hello\", \"foo\": 234, \"baz\": [5, 6, 7, 8], \"x\": 0 }, \"id\": 3}"
  :: Maybe (Request FooNE))
  Nothing


newtype FooSA = FooSA Foo deriving (Eq, Show)

instance FromJSON FooSA where
  parseJSON =
    (FooSA <$>)
    . genericParseJSONRPC defaultJsonRpcOptions { allowSpilledArguemnts = False } Aeson.defaultOptions

eqDecodeSpilledAllow :: Test
eqDecodeSpilledAllow =
  eqTest "eq - decode array - allow spilled args"
  (Aeson.decode
   "{\"jsonrpc\": \"2.0\", \"method\": \"foo\", \"params\": [ 234, \"Hello\", [5, 6, 7, 8], 0 ], \"id\": 3}")
  (Just Request { jsonrpc = "2.0"
                , method = "foo"
                , params = Just (Foo {foo = 234, bar = "Hello", baz = [5,6,7,8]})
                , id = Just (NumberId 3)}
  )

eqDecodeSpilledDisallow :: Test
eqDecodeSpilledDisallow =
  eqTest "eq - decode array - don't allow spilled args"
  (Aeson.decode
   "{\"jsonrpc\": \"2.0\", \"method\": \"foo\", \"params\": [ 234, \"Hello\", [5, 6, 7, 8], 0 ], \"id\": 3}"
   :: Maybe (Request FooSA))
  Nothing


exId :: Id
exId = fromMaybe (error "something wrong: _success") $ numberId 25

exSuccess :: Success Foo
exSuccess = success exId Foo {foo = 234, bar = "Hello", baz = [5,6,7,8]}

exFailure :: Failure String
exFailure = failure (Just exId) Failure.InvalidRequest Nothing Nothing

eqResponseS :: Test
eqResponseS =
  eqTest "eq - response success"
  (Just (Response $ Right exSuccess :: Response String Foo))
  (Aeson.decode "{\"result\":{ \"bar\": \"Hello\", \"foo\": 234, \"baz\": [5, 6, 7, 8] },\"jsonrpc\":\"2.0\",\"id\":25}")

eqResponseF :: Test
eqResponseF =
  eqTest "eq - response failure"
  (Just (Response $ Left exFailure :: Response String Foo))
  (Aeson.decode "{\"error\":{\"code\":-32600,\"message\":\"Invalid Request\"},\"jsonrpc\":\"2.0\",\"id\":25}")

tests :: [Test]
tests =
  [ eqDecodeO
  , eqDecodeA

  , eqDecodeNonExistAllow
  , eqDecodeNonExistDisallow

  , eqDecodeSpilledAllow
  , eqDecodeSpilledDisallow

  , eqResponseS
  , eqResponseF
  ]