summaryrefslogtreecommitdiff
path: root/dht/bittorrent/tests/Network/KRPC/MethodSpec.hs
blob: c1c582827c49da82c669178595e1b63c183c36cf (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
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"