Update tests

5 files changed, 85 insertions, 139 deletions

diff --git a/tests/Client.hs b/tests/Client.hs
deleted file mode 100644
index 2b49bd82..00000000
--- a/tests/Client.hs
+++ /dev/null
@@ -1,80 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Main (main) where
-
-import Control.Concurrent
-import Control.Exception
-import qualified Data.ByteString as B
-import Data.BEncode as BE
-import Data.BEncode.BDict as BE
-import System.Process
-import System.FilePath
-
-import Test.HUnit hiding (Test)
-import Test.Framework
-import Test.Framework.Providers.HUnit
-
-import Network.KRPC
-import Network.Socket
-import Shared
-
-
-addr :: SockAddr
-addr = SockAddrInet 6000 0
-
-withServ :: FilePath -> IO () -> IO ()
-withServ serv_path = bracket up terminateProcess . const
-  where
-    up = do
-      (_, _, _, h) <- createProcess (proc serv_path [])
-      threadDelay 1000000
-      return h
-
-main :: IO ()
-main = do
-  let serv_path = "dist" </> "build" </> "test-server" </> "test-server"
-  withServ serv_path $
-    defaultMain tests
-
-
-(==?) :: (Eq a, Show a) => a -> IO a -> Assertion
-expected ==? action = do
-  actual <- action
-  expected @=? actual
-
-tests :: [Test]
-tests =
-  [ testCase "unit" $
-      () ==? call addr unitM ()
-
-  , testCase "echo int" $
-      1234 ==? call addr echoM 1234
-
-  , testCase "reverse 1..100" $
-      reverse [1..100] ==? call addr reverseM [1..100]
-
-  , testCase "reverse empty list" $
-      reverse [] ==? call addr reverseM []
-
-  , testCase "reverse singleton list" $
-      reverse [1] ==? call addr reverseM [1]
-
-  , testCase "swap pair" $
-      (1, 0) ==? call addr swapM (0, 1)
-
-  , testCase "shift triple" $
-      ([2..10], (), 1) ==? call addr shiftR ((), 1, [2..10])
-
-  , testCase "echo bytestring" $
-      let bs = B.replicate 400 0 in
-      bs ==? call addr echoBytes bs
-
-  , testCase "raw method" $
-      BInteger 10 ==? call addr rawM (BInteger 10)
-
-  , testCase "raw dict" $
-      let dict = BDict $ BE.fromAscList
-                 [ ("some_int", BInteger 100)
-                 , ("some_list", BList [BInteger 10])
-                 ]
-      in dict ==? call addr rawDictM dict
-  ]
diff --git a/tests/Network/KRPC/MethodSpec.hs b/tests/Network/KRPC/MethodSpec.hs
new file mode 100644
index 00000000..c1c58282
--- /dev/null
+++ b/tests/Network/KRPC/MethodSpec.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveDataTypeable    #-}
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
+module Network.KRPC.MethodSpec where
+import Control.Applicative
+import Data.BEncode
+import Data.ByteString as BS
+import Data.Typeable
+import Network.KRPC
+import Test.Hspec
+
+
+data Ping = Ping
+  deriving (Show, Eq, Typeable)
+
+instance BEncode Ping where
+  toBEncode Ping = toBEncode ()
+  fromBEncode b  = Ping <$ (fromBEncode b :: Result ())
+
+instance KRPC Ping Ping
+
+ping :: Monad h => Handler h
+ping = handler $ \ _ Ping -> return Ping
+
+newtype Echo a = Echo a
+  deriving (Show, Eq, BEncode, Typeable)
+
+echo :: Monad h => Handler h
+echo = handler $ \ _ (Echo a) -> return (Echo (a :: ByteString))
+
+instance (Typeable a, BEncode a) => KRPC (Echo a) (Echo a)
+
+spec :: Spec
+spec = do
+  describe "ping method" $ do
+    it "name is ping" $ do
+      (method :: Method Ping Ping) `shouldBe` "ping"
+
+    it "has pretty Show instance" $ do
+      show (method :: Method Ping Ping) `shouldBe` "ping :: Ping -> Ping"
+
+  describe "echo method" $ do
+    it "is overloadable" $ do
+      (method :: Method (Echo Int ) (Echo Int )) `shouldBe` "echo int"
+      (method :: Method (Echo Bool) (Echo Bool)) `shouldBe` "echo bool"
+
+    it "has pretty Show instance" $ do
+      show (method :: Method (Echo Int) (Echo Int))
+        `shouldBe` "echo int :: Echo Int -> Echo Int"
\ No newline at end of file
diff --git a/tests/Network/KRPCSpec.hs b/tests/Network/KRPCSpec.hs
new file mode 100644
index 00000000..27148682
--- /dev/null
+++ b/tests/Network/KRPCSpec.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Network.KRPCSpec (spec) where
+import Control.Monad.Reader
+import Network.Socket (SockAddr (..))
+import Network.KRPC
+import Network.KRPC.MethodSpec hiding (spec)
+import Test.Hspec
+
+servAddr :: SockAddr
+servAddr = SockAddrInet 6000 (256 * 256 * 256 + 127)
+
+handlers :: [Handler IO]
+handlers =
+ [ handler $ \ _ Ping     -> return Ping
+ , handler $ \ _ (Echo a) -> return (Echo (a :: Bool))
+ , handler $ \ _ (Echo a) -> return (Echo (a :: Int))
+ ]
+
+spec :: Spec
+spec = do
+  describe "query" $ do
+    it "run handlers" $ do
+      let int = 0xabcd :: Int
+      (withManager servAddr handlers $ runReaderT $ do
+         listen
+         query servAddr (Echo int))
+       `shouldReturn` Echo int
+
+    it "throw timeout exception" $ do
+      (withManager servAddr handlers $ runReaderT $ do
+         query servAddr (Echo (0xabcd :: Int))
+       )
+        `shouldThrow` (== KError GenericError "timeout expired" "0")
diff --git a/tests/Server.hs b/tests/Server.hs
deleted file mode 100644
index b4b34891..00000000
--- a/tests/Server.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-{-# LANGUAGE IncoherentInstances #-}
-module Main (main) where
-
-import Data.BEncode
-import Network.KRPC
-import Network.Socket
-import Shared
-
-
-main :: IO ()
-main = server (SockAddrInet 6000 0)
-  [ unitM ==> return
-  , echoM ==> return
-  , echoBytes ==> return
-  , swapM ==> \(a, b) -> return (b, a)
-  , reverseM ==> return . reverse
-  , shiftR ==> \(a, b, c) -> return (c, a, b)
-  , rawM      ==> return
-  , rawDictM  ==> return
-  ]
diff --git a/tests/Shared.hs b/tests/Shared.hs
deleted file mode 100644
index 16547644..00000000
--- a/tests/Shared.hs
+++ /dev/null
@@ -1,39 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Shared
-       ( echoM
-       , echoBytes
-       , unitM
-       , swapM
-       , reverseM
-       , shiftR
-       , rawM
-       , rawDictM
-       ) where
-
-import Data.ByteString (ByteString)
-import Data.BEncode
-import Network.KRPC
-
-unitM :: Method () ()
-unitM = method "unit" [] []
-
-echoM :: Method Int Int
-echoM = method "echo" ["x"] ["x"]
-
-echoBytes :: Method ByteString ByteString
-echoBytes = method "echoBytes" ["x"] ["x"]
-
-reverseM :: Method [Int] [Int]
-reverseM = method "reverse" ["xs"] ["ys"]
-
-swapM :: Method (Int, Int) (Int, Int)
-swapM = method "swap" ["x", "y"] ["b", "a"]
-
-shiftR :: Method ((), Int, [Int]) ([Int], (), Int)
-shiftR = method "shiftR" ["x", "y", "z"] ["a", "b", "c"]
-
-rawM :: Method BValue BValue
-rawM = method "rawM" [""] [""]
-
-rawDictM :: Method BValue BValue
-rawDictM = method "m" [] []
\ No newline at end of file