Handle transactions properly

1 files changed, 44 insertions, 3 deletions

diff --git a/src/Network/KRPC/Message.hs b/src/Network/KRPC/Message.hs
index a70c2ea9..3bbfb1db 100644
--- a/src/Network/KRPC/Message.hs
+++ b/src/Network/KRPC/Message.hs
@@ -19,10 +19,17 @@
 {-# LANGUAGE DefaultSignatures      #-}
 {-# LANGUAGE DeriveDataTypeable     #-}
 module Network.KRPC.Message
-       ( -- * Error
-         ErrorCode (..)
+       ( -- * Transaction
+         TransactionId
+       , unknownTransaction
+
+         -- * Error
+       , ErrorCode (..)
        , KError(..)
        , serverError
+       , decodeError
+       , unknownMethod
+       , unknownMessage
 
          -- * Query
        , KQuery(..)
@@ -30,6 +37,9 @@ module Network.KRPC.Message
 
          -- * Response
        , KResponse(..)
+
+         -- * Message
+       , KMessage (..)
        ) where
 
 import Control.Applicative
@@ -47,6 +57,9 @@ import Data.Typeable
 -- are enough as they cover 2^16 outstanding queries.
 type TransactionId = ByteString
 
+unknownTransaction :: TransactionId
+unknownTransaction = ""
+
 {-----------------------------------------------------------------------
 -- Error messages
 -----------------------------------------------------------------------}
@@ -120,6 +133,15 @@ instance Exception KError
 serverError :: SomeException -> TransactionId -> KError
 serverError e = KError ServerError (BC.pack (show e))
 
+decodeError :: String -> TransactionId -> KError
+decodeError msg = KError ProtocolError (BC.pack msg)
+
+unknownMethod :: MethodName -> TransactionId -> KError
+unknownMethod = KError MethodUnknown
+
+unknownMessage :: String -> KError
+unknownMessage msg = KError ProtocolError (BC.pack msg) ""
+
 {-----------------------------------------------------------------------
 -- Query messages
 -----------------------------------------------------------------------}
@@ -183,4 +205,23 @@ instance BEncode KResponse where
   fromBEncode = fromDict $ do
     lookAhead $ match "y" (BString "r")
     KResponse <$>! "r" <*>! "t"
-  {-# INLINE fromBEncode #-}
\ No newline at end of file
+  {-# INLINE fromBEncode #-}
+
+{-----------------------------------------------------------------------
+-- Summed messages
+-----------------------------------------------------------------------}
+
+data KMessage
+  = Q KQuery
+  | R KResponse
+  | E KError
+
+instance BEncode KMessage where
+  toBEncode (Q q) = toBEncode q
+  toBEncode (R r) = toBEncode r
+  toBEncode (E e) = toBEncode e
+
+  fromBEncode b =
+        Q <$> fromBEncode b
+    <|> R <$> fromBEncode b
+    <|> E <$> fromBEncode b