content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE TypeOperators #-}
  {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
  
  module Tests (tests) where
  
  -- import qualified Data.Aeson.KeyMap as KM
  -- import qualified Data.Aeson.Key    as DAK
  
  -- import Data.Maybe (fromJust)
  
  -- import Data.Scientific (Scientific)
  -- import qualified Data.Vector as V
  
  import Control.Applicative (empty, (<|>))
  import Control.Monad (when)
  import Control.Monad.Except (runExceptT, throwError)
  import Control.Monad.State (State, modify, runState)
  import Data.Aeson ((.=))
  import qualified Data.Aeson as A
  import qualified Data.ByteString.Lazy as B
  import Data.Ratio ((%))
  import Network.JsonRpc.Client
  import Network.JsonRpc.Server (call, callWithBatchStrategy, rpcError)
  import Network.JsonRpc.ServerAdapter (toServerMethod)
  import Test.Framework (Test)
  import Test.Framework.Providers.HUnit (testCase)
  import Test.HUnit hiding (State, Test)
  import Prelude hiding (subtract)
  
  #if !MIN_VERSION_base(4,8,0)
  import Control.Applicative (pure, (<$>), (<$), (<*>))
  #endif
  
  tests :: [Test]
  tests =
    [ testCase "single request" $
        runResult (subtract 22 1) @?= (Right 21, 1),
      testCase "batch with one request" $
        myRunBatch (subtractB 1 2) @?= (Right (-1), 1),
      testCase "batch with multiple requests" $
        let result = myRunBatch $ pure (,) <*> subtractB 7 3 <*> divideB 15 12
         in result @?= (Right (4, 5 % 4), 2),
      testCase "requests combined right to left" $
        let result =
              myRunBatch $
                (+) <$> subtractB 5 3 <*> ((*) <$> subtractB 11 2 <*> subtractB 15 10)
         in result @?= (Right 47, 3),
      testCase "requests combined left to right" $
        let result =
              myRunBatch $
                (*) <$> ((+) <$> subtractB 5 3 <*> subtractB 11 2) <*> subtractB 15 10
         in result @?= (Right 55, 3),
      testCase "single notification" $
        runResult (subtract_ 1 2) @?= (Right (), 1),
      testCase "batch with one notification" $
        myRunBatch (subtractB_ 1 2) @?= (Right (), 1),
      testCase "notification at start of batch" $
        let result =
              myRunBatch $
                (,) <$> subtractB_ 5 4 <*> subtractB 20 16
         in result @?= (Right ((), 4), 2),
      testCase "notification at end of batch" $
        let result =
              myRunBatch $
                (,) <$> subtractB 5 4 <*> subtractB_ 20 16
         in result @?= (Right (1, ()), 2),
      testCase "single request with error" $
        runResult (divide 10 0) @?= (Left divByZeroCode, 0),
      testCase "error at start of batch" $
        let result =
              myRunBatch $
                (:) <$> divideB 4 0 <*> ((: []) <$> divideB 1 1)
         in result @?= (Left divByZeroCode, 1),
      testCase "error at end of batch" $
        let result =
              myRunBatch $
                (+) <$> divideB 4 2 <*> divideB 1 0
         in result @?= (Left divByZeroCode, 1),
      testCase "batch with multiple errors" $
        let result =
              myRunBatch $
                (,) <$> divideB 1 0 <*> missingMethodB
         in result @?= (Left divByZeroCode, 0),
      testCase "batch with no requests is not sent to server" $
        let result =
              runResult $
                runBatch badServer $ (||) <$> pure True <*> pure False
            badServer = constServer $ error "server was used"
         in result @?= (Right True, 0),
      testCase "batch alternative with failure first" $
        let result = myRunBatch $ divideB 1 0 <|> divideB 2 1
         in result @?= (Right 2, 1),
      testCase "batch alternative with failure last" $
        let result = myRunBatch $ divideB 2 1 <|> divideB 1 0
         in result @?= (Right 2, 1),
      testCase "batch alternative with all failures" $
        let result = myRunBatch $ divideB 2 0 <|> missingMethodB
         in result @?= (Left (-32601), 0),
      testCase "batch alternative with no failures" $
        let result = myRunBatch $ divideB 2 1 <|> divideB 1 1
         in result @?= (Right 2, 2),
      testCase "empty batch" $
        myRunBatch (empty :: Batch String) @?= (Left (-31999), 0),
      testCase "invalid JSON response" $
        let result = subtractWithConstServer $ A.Number 3
         in runResult result @?= (Left clientCode, 0),
      testCase "missing ID attribute in response" $
        let result =
              subtractWithConstServer $
                A.object
                  [ "result" .= A.Number 3,
                    "jsonrpc" .= A.String "2.0"
                  ]
         in runResult result @?= (Left clientCode, 0),
      testCase "non-object response to single request" $
        let result = subtractWithConstServer $ A.toJSON [A.String "element"]
         in runResult result @?= (Left clientCode, 0),
      testCase "wrong result type in response" $
        let result =
              subtractWithConstServer $
                A.object
                  [ "id" .= A.Number 3,
                    "result" .= True,
                    "jsonrpc" .= A.String "2.0"
                  ]
         in runResult result @?= (Left clientCode, 0),
      --   , testCase "detect modified single request ID" $
      --         let result = toFunction (idModifyingServer (+1)) subtractSig 10 1
      --         in runResult result @?= (Left clientCode, 1)
  
      --   , testCase "detect modified batch response IDs" $
      --         let result = runBatch (idModifyingServer (+1)) $
      --                      (+) <$> subtractB 10 1 <*> subtractB 2 1
      --         in runResult result @?= (Left clientCode, 2)
  
      --   , testCase "detect duplicate batch response IDs" $
      --         let result = runBatch (idModifyingServer (const 0)) $
      --                      (,) <$> divideB 3 1 <*> divideB 3 1
      --         in runResult result @?= (Left clientCode, 2)
  
      testCase "handle reversed batch responses" $
        let result =
              runBatch reversingServer $
                (,) <$> subtractB 2 1 <*> subtractB 4 2
            reversingServer = callWithBatchStrategy (sequence . reverse) methods
         in runResult result @?= (Right (1, 2), 2)
    ]
  
  -- | Monad used by server to keep a count of requests.
  type RequestCount = State Int
  
  type Result r = RpcResult RequestCount r
  
  subtractSig :: Signature (Int ::: Int ::: ()) Int
  subtractSig = Signature "subtract" ("x" ::: "y" ::: ())
  
  divideSig :: Signature (Rational ::: Rational ::: ()) Rational
  divideSig = Signature "divide" ("x" ::: "y" ::: ())
  
  missingMethodSig :: Signature () Rational
  missingMethodSig = Signature "f" ()
  
  subtract = toFunction myServer subtractSig
  
  subtract_ = toFunction_ myServer subtractSig
  
  subtractB = toBatchFunction subtractSig
  
  subtractB_ = toBatchFunction_ subtractSig
  
  divide = toFunction myServer divideSig
  
  divideB = toBatchFunction divideSig
  
  missingMethodB = toBatchFunction missingMethodSig
  
  -- | Returns the error code or result, and the new server state.
  runResult :: Result a -> (Either Int a, Int)
  runResult result = runState (mapLeft errCode <$> runExceptT result) 0
    where
      mapLeft f (Left x) = Left $ f x
      mapLeft _ (Right x) = Right x
  
  myRunBatch :: Batch a -> (Either Int a, Int)
  myRunBatch = runResult . runBatch myServer
  
  myServer :: B.ByteString -> RequestCount (Maybe B.ByteString)
  myServer = call methods
  
  subtractWithConstServer :: A.Value -> RpcResult RequestCount Int
  subtractWithConstServer response = toFunction server subtractSig 1 2
    where
      server = constServer $ A.encode response
  
  -- fix later
  -- idModifyingServer :: (Scientific -> Scientific) -> Connection RequestCount
  -- idModifyingServer f = responseModifyingServer modifyIds
  --     where modifyIds (A.Array rs) = A.Array $ V.map modifyIds rs
  --           modifyIds (A.Object r) = A.Object $ KM.alterF modifyId (DAK.fromString "id") r
  --               where modifyId (A.Number i) = A.Number $ f i
  --                     modifyId x = x
  --           modifyIds x = x
  
  -- responseModifyingServer :: (A.Value -> A.Value) -> Connection RequestCount
  -- responseModifyingServer f rq = modifyResponse <$> myServer rq
  --     where modifyResponse rsp = A.encode . f . fromJust . A.decode <$> rsp
  
  constServer :: B.ByteString -> Connection RequestCount
  constServer = const . return . Just
  
  methods = [subtractMethod, divideMethod]
  
  subtractMethod = toServerMethod subtractSig f
    where
      f :: Int -> Int -> RpcResult RequestCount Int
      f x y = (x - y) <$ modify (+ 1)
  
  divideMethod = toServerMethod divideSig f
    where
      f :: Rational -> Rational -> RpcResult RequestCount Rational
      f x y = do
        when (y == 0) $ throwError $ rpcError divByZeroCode "divide by zero"
        x / y <$ modify (+ 1)
  
  divByZeroCode = -32050
  