summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/Client.hs80
-rw-r--r--tests/Network/KRPC/MethodSpec.hs52
-rw-r--r--tests/Network/KRPCSpec.hs33
-rw-r--r--tests/Server.hs20
-rw-r--r--tests/Shared.hs39
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 @@
1{-# LANGUAGE OverloadedStrings #-}
2module Main (main) where
3
4import Control.Concurrent
5import Control.Exception
6import qualified Data.ByteString as B
7import Data.BEncode as BE
8import Data.BEncode.BDict as BE
9import System.Process
10import System.FilePath
11
12import Test.HUnit hiding (Test)
13import Test.Framework
14import Test.Framework.Providers.HUnit
15
16import Network.KRPC
17import Network.Socket
18import Shared
19
20
21addr :: SockAddr
22addr = SockAddrInet 6000 0
23
24withServ :: FilePath -> IO () -> IO ()
25withServ serv_path = bracket up terminateProcess . const
26 where
27 up = do
28 (_, _, _, h) <- createProcess (proc serv_path [])
29 threadDelay 1000000
30 return h
31
32main :: IO ()
33main = do
34 let serv_path = "dist" </> "build" </> "test-server" </> "test-server"
35 withServ serv_path $
36 defaultMain tests
37
38
39(==?) :: (Eq a, Show a) => a -> IO a -> Assertion
40expected ==? action = do
41 actual <- action
42 expected @=? actual
43
44tests :: [Test]
45tests =
46 [ testCase "unit" $
47 () ==? call addr unitM ()
48
49 , testCase "echo int" $
50 1234 ==? call addr echoM 1234
51
52 , testCase "reverse 1..100" $
53 reverse [1..100] ==? call addr reverseM [1..100]
54
55 , testCase "reverse empty list" $
56 reverse [] ==? call addr reverseM []
57
58 , testCase "reverse singleton list" $
59 reverse [1] ==? call addr reverseM [1]
60
61 , testCase "swap pair" $
62 (1, 0) ==? call addr swapM (0, 1)
63
64 , testCase "shift triple" $
65 ([2..10], (), 1) ==? call addr shiftR ((), 1, [2..10])
66
67 , testCase "echo bytestring" $
68 let bs = B.replicate 400 0 in
69 bs ==? call addr echoBytes bs
70
71 , testCase "raw method" $
72 BInteger 10 ==? call addr rawM (BInteger 10)
73
74 , testCase "raw dict" $
75 let dict = BDict $ BE.fromAscList
76 [ ("some_int", BInteger 100)
77 , ("some_list", BList [BInteger 10])
78 ]
79 in dict ==? call addr rawDictM dict
80 ]
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 @@
1{-# LANGUAGE MultiParamTypeClasses #-}
2{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5{-# LANGUAGE DeriveDataTypeable #-}
6{-# OPTIONS_GHC -fno-warn-orphans #-}
7module Network.KRPC.MethodSpec where
8import Control.Applicative
9import Data.BEncode
10import Data.ByteString as BS
11import Data.Typeable
12import Network.KRPC
13import Test.Hspec
14
15
16data Ping = Ping
17 deriving (Show, Eq, Typeable)
18
19instance BEncode Ping where
20 toBEncode Ping = toBEncode ()
21 fromBEncode b = Ping <$ (fromBEncode b :: Result ())
22
23instance KRPC Ping Ping
24
25ping :: Monad h => Handler h
26ping = handler $ \ _ Ping -> return Ping
27
28newtype Echo a = Echo a
29 deriving (Show, Eq, BEncode, Typeable)
30
31echo :: Monad h => Handler h
32echo = handler $ \ _ (Echo a) -> return (Echo (a :: ByteString))
33
34instance (Typeable a, BEncode a) => KRPC (Echo a) (Echo a)
35
36spec :: Spec
37spec = do
38 describe "ping method" $ do
39 it "name is ping" $ do
40 (method :: Method Ping Ping) `shouldBe` "ping"
41
42 it "has pretty Show instance" $ do
43 show (method :: Method Ping Ping) `shouldBe` "ping :: Ping -> Ping"
44
45 describe "echo method" $ do
46 it "is overloadable" $ do
47 (method :: Method (Echo Int ) (Echo Int )) `shouldBe` "echo int"
48 (method :: Method (Echo Bool) (Echo Bool)) `shouldBe` "echo bool"
49
50 it "has pretty Show instance" $ do
51 show (method :: Method (Echo Int) (Echo Int))
52 `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 @@
1{-# LANGUAGE OverloadedStrings #-}
2module Network.KRPCSpec (spec) where
3import Control.Monad.Reader
4import Network.Socket (SockAddr (..))
5import Network.KRPC
6import Network.KRPC.MethodSpec hiding (spec)
7import Test.Hspec
8
9servAddr :: SockAddr
10servAddr = SockAddrInet 6000 (256 * 256 * 256 + 127)
11
12handlers :: [Handler IO]
13handlers =
14 [ handler $ \ _ Ping -> return Ping
15 , handler $ \ _ (Echo a) -> return (Echo (a :: Bool))
16 , handler $ \ _ (Echo a) -> return (Echo (a :: Int))
17 ]
18
19spec :: Spec
20spec = do
21 describe "query" $ do
22 it "run handlers" $ do
23 let int = 0xabcd :: Int
24 (withManager servAddr handlers $ runReaderT $ do
25 listen
26 query servAddr (Echo int))
27 `shouldReturn` Echo int
28
29 it "throw timeout exception" $ do
30 (withManager servAddr handlers $ runReaderT $ do
31 query servAddr (Echo (0xabcd :: Int))
32 )
33 `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 @@
1{-# LANGUAGE IncoherentInstances #-}
2module Main (main) where
3
4import Data.BEncode
5import Network.KRPC
6import Network.Socket
7import Shared
8
9
10main :: IO ()
11main = server (SockAddrInet 6000 0)
12 [ unitM ==> return
13 , echoM ==> return
14 , echoBytes ==> return
15 , swapM ==> \(a, b) -> return (b, a)
16 , reverseM ==> return . reverse
17 , shiftR ==> \(a, b, c) -> return (c, a, b)
18 , rawM ==> return
19 , rawDictM ==> return
20 ]
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 @@
1{-# LANGUAGE OverloadedStrings #-}
2module Shared
3 ( echoM
4 , echoBytes
5 , unitM
6 , swapM
7 , reverseM
8 , shiftR
9 , rawM
10 , rawDictM
11 ) where
12
13import Data.ByteString (ByteString)
14import Data.BEncode
15import Network.KRPC
16
17unitM :: Method () ()
18unitM = method "unit" [] []
19
20echoM :: Method Int Int
21echoM = method "echo" ["x"] ["x"]
22
23echoBytes :: Method ByteString ByteString
24echoBytes = method "echoBytes" ["x"] ["x"]
25
26reverseM :: Method [Int] [Int]
27reverseM = method "reverse" ["xs"] ["ys"]
28
29swapM :: Method (Int, Int) (Int, Int)
30swapM = method "swap" ["x", "y"] ["b", "a"]
31
32shiftR :: Method ((), Int, [Int]) ([Int], (), Int)
33shiftR = method "shiftR" ["x", "y", "z"] ["a", "b", "c"]
34
35rawM :: Method BValue BValue
36rawM = method "rawM" [""] [""]
37
38rawDictM :: Method BValue BValue
39rawDictM = method "m" [] [] \ No newline at end of file
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 20:54:59 +0000