Renamed Network.KRPC.Message -> Network.DatagramServer.Mainline

2 files changed, 1 insertions, 367 deletions

diff --git a/src/Network/KRPC/Message.hs b/src/Network/KRPC/Message.hs
deleted file mode 100644
index 2f5f6729..00000000
--- a/src/Network/KRPC/Message.hs
+++ /dev/null
@@ -1,366 +0,0 @@
--- |
---   Copyright   :  (c) Sam Truzjan 2013, 2014
---   License     :  BSD3
---   Maintainer  :  pxqr.sta@gmail.com
---   Stability   :  experimental
---   Portability :  portable
---
---   KRPC messages types used in communication. All messages are
---   encoded as bencode dictionary.
---
---   Normally, you don't need to import this module.
---
---   See <http://www.bittorrent.org/beps/bep_0005.html#krpc-protocol>
---
-{-# LANGUAGE CPP                    #-}
-{-# LANGUAGE DefaultSignatures      #-}
-{-# LANGUAGE DeriveDataTypeable     #-}
-{-# LANGUAGE DeriveFunctor          #-}
-{-# LANGUAGE DeriveTraversable      #-}
-{-# LANGUAGE FlexibleContexts       #-}
-{-# LANGUAGE FlexibleInstances      #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE MultiParamTypeClasses  #-}
-{-# LANGUAGE OverloadedStrings      #-}
-{-# LANGUAGE TypeSynonymInstances   #-}
-module Network.KRPC.Message
-       ( -- * Transaction
-         TransactionId
-
-         -- * Error
-       , ErrorCode (..)
-       , KError(..)
-       , decodeError
-       , unknownMessage
-
-         -- * Query
-#ifdef VERSION_bencoding
-       , KQueryOf(..)
-#endif
-       , KQuery
-#ifndef VERSION_bencoding
-       , queryArgs
-       , queryMethod
-       , queryId
-#endif
-       , MethodName
-
-         -- * Response
-#ifdef VERSION_bencoding
-       , KResponseOf(..)
-#endif
-       , KResponse
-       , ReflectedIP(..)
-
-         -- * Message
-       , KMessageOf (..)
-       , KMessage
-       , KQueryArgs
-
-       ) where
-
-import Control.Applicative
-import Control.Arrow
-import Control.Exception.Lifted as Lifted
-#ifdef VERSION_bencoding
-import Data.BEncode as BE
-#else
-import qualified Data.Tox as Tox
-#endif
-import Data.ByteString as B
-import Data.ByteString.Char8 as BC
-import qualified Data.Serialize as S
-import Data.Word
-import Data.Typeable
-import Network.Socket (SockAddr (..),PortNumber,HostAddress)
-
-
-#ifdef VERSION_bencoding
--- | This transaction ID is generated by the querying node and is
--- echoed in the response, so responses may be correlated with
--- multiple queries to the same node. The transaction ID should be
--- encoded as a short string of binary numbers, typically 2 characters
--- are enough as they cover 2^16 outstanding queries.
-type TransactionId = ByteString
-#else
-type TransactionId = Tox.Nonce24 -- msgNonce
-#endif
-
-unknownTransaction :: TransactionId
-#ifdef VERSION_bencoding
-unknownTransaction = ""
-#else
-unknownTransaction = 0
-#endif
-
-{-----------------------------------------------------------------------
--- Error messages
------------------------------------------------------------------------}
-
--- | Types of RPC errors.
-data ErrorCode
-    -- | Some error doesn't fit in any other category.
-  = GenericError
-
-    -- | Occur when server fail to process procedure call.
-  | ServerError
-
-    -- | Malformed packet, invalid arguments or bad token.
-  | ProtocolError
-
-    -- | Occur when client trying to call method server don't know.
-  | MethodUnknown
-    deriving (Show, Read, Eq, Ord, Bounded, Typeable)
-
--- | According to the table:
--- <http://bittorrent.org/beps/bep_0005.html#errors>
-instance Enum ErrorCode where
-  fromEnum GenericError  = 201
-  fromEnum ServerError   = 202
-  fromEnum ProtocolError = 203
-  fromEnum MethodUnknown = 204
-  {-# INLINE fromEnum #-}
-
-  toEnum 201 = GenericError
-  toEnum 202 = ServerError
-  toEnum 203 = ProtocolError
-  toEnum 204 = MethodUnknown
-  toEnum _   = GenericError
-  {-# INLINE toEnum #-}
-
-#ifdef VERSION_bencoding
-instance BEncode ErrorCode where
-  toBEncode = toBEncode . fromEnum
-  {-# INLINE toBEncode #-}
-
-  fromBEncode b = toEnum <$> fromBEncode b
-  {-# INLINE fromBEncode #-}
-#endif
-
-#ifdef VERSION_bencoding
--- | Errors are sent when a query cannot be fulfilled. Error message
---   can be send only from server to client but not in the opposite
---   direction.
---
-data KError = KError
-  { errorCode    :: !ErrorCode     -- ^ the type of error;
-  , errorMessage :: !ByteString    -- ^ human-readable text message;
-  , errorId      :: !TransactionId -- ^ match to the corresponding 'queryId'.
-  } deriving ( Show, Eq, Ord, Typeable, Read )
-#else
-type KError = Tox.Message ByteString -- TODO TOX unused
-#endif
-
--- | Errors, or KRPC message dictionaries with a \"y\" value of \"e\",
---   contain one additional key \"e\". The value of \"e\" is a
---   list. The first element is an integer representing the error
---   code. The second element is a string containing the error
---   message.
---
---   Example Error Packet:
---
---   > { "t": "aa", "y":"e", "e":[201, "A Generic Error Ocurred"]}
---
---   or bencoded:
---
---   > d1:eli201e23:A Generic Error Ocurrede1:t2:aa1:y1:ee
---
-#ifdef VERSION_bencoding
-instance BEncode KError where
-  toBEncode KError {..} = toDict $
-       "e" .=! (errorCode, errorMessage)
-    .: "t" .=! errorId
-    .: "y" .=! ("e" :: ByteString)
-    .: endDict
-  {-# INLINE toBEncode #-}
-
-  fromBEncode = fromDict $ do
-    lookAhead $ match "y" (BString "e")
-    (code, msg) <- field (req "e")
-    KError code msg <$>! "t"
-  {-# INLINE fromBEncode #-}
-#endif
-
-instance Exception KError
-
--- | Received 'queryArgs' or 'respVals' can not be decoded.
-decodeError :: String -> TransactionId -> KError
-#ifdef VERSION_bencoding
-decodeError msg = KError ProtocolError (BC.pack msg)
-#else
-decodeError msg = error "TODO TOX Error packet"
-#endif
-
--- | A remote node has send some 'KMessage' this node is unable to
--- decode.
-unknownMessage :: String -> KError
-#ifdef VERSION_bencoding
-unknownMessage msg = KError ProtocolError (BC.pack msg) unknownTransaction
-#else
-unknownMessage msg = error "TODO TOX Protocol error"
-#endif
-
-{-----------------------------------------------------------------------
--- Query messages
------------------------------------------------------------------------}
-
-#ifdef VERSION_bencoding
-type MethodName = ByteString
-type KQueryArgs = BValue
-#else
-type MethodName = Tox.MessageType -- msgType
-type KQueryArgs = ByteString      -- msgPayload
-#endif
-
-#ifdef VERSION_bencoding
--- | Query used to signal that caller want to make procedure call to
--- callee and pass arguments in. Therefore query may be only sent from
--- client to server but not in the opposite direction.
---
-data KQueryOf a = KQuery
-  { queryArgs   :: !a              -- ^ values to be passed to method;
-  , queryMethod :: !MethodName     -- ^ method to call;
-  , queryId     :: !TransactionId  -- ^ one-time query token.
-  } deriving ( Show, Eq, Ord, Typeable, Read, Functor, Foldable, Traversable )
-
-type KQuery = KQueryOf KQueryArgs
-
--- | Queries, or KRPC message dictionaries with a \"y\" value of
--- \"q\", contain two additional keys; \"q\" and \"a\". Key \"q\" has
--- a string value containing the method name of the query. Key \"a\"
--- has a dictionary value containing named arguments to the query.
---
---    Example Query packet:
---
---    > { "t" : "aa", "y" : "q", "q" : "ping", "a" : { "msg" : "hi!" } }
---
-instance (Typeable a, BEncode a) => BEncode (KQueryOf a) where
-  toBEncode KQuery {..} = toDict $
-       "a" .=! queryArgs
-    .: "q" .=! queryMethod
-    .: "t" .=! queryId
-    .: "y" .=! ("q" :: ByteString)
-    .: endDict
-  {-# INLINE toBEncode #-}
-
-  fromBEncode = fromDict $ do
-    lookAhead $ match "y" (BString "q")
-    KQuery <$>! "a" <*>! "q" <*>! "t"
-  {-# INLINE fromBEncode #-}
-
-instance BEncode ReflectedIP where
-  toBEncode (ReflectedIP addr) = BString (encodeAddr addr)
-  fromBEncode (BString bs) = ReflectedIP <$> decodeAddr bs
-  fromBEncode _            = Left "ReflectedIP should be a bencoded string"
-#else
-type KQuery = Tox.Message KQueryArgs
-queryArgs   = Tox.msgPayload
-queryMethod = Tox.msgType
-queryId     = Tox.msgNonce
-#endif
-
-newtype ReflectedIP = ReflectedIP SockAddr
-  deriving (Eq, Ord, Show)
-
-port16 :: Word16 -> PortNumber
-port16 = fromIntegral
-
-decodeAddr :: ByteString -> Either String SockAddr
-decodeAddr bs | B.length bs == 6
-    = ( \(a,p) -> SockAddrInet <$> fmap port16 p <*> a )
-      $ (S.runGet S.getWord32host *** S.decode )
-      $ B.splitAt 4 bs
-decodeAddr bs | B.length bs == 18
-    = ( \(a,p) -> flip SockAddrInet6 0 <$> fmap port16 p <*> a <*> pure 0 )
-      $ (S.decode *** S.decode )
-      $ B.splitAt 16 bs
-decodeAddr _ = Left "incorrectly sized address and port"
-
-encodeAddr :: SockAddr -> ByteString
-encodeAddr (SockAddrInet port addr)
-    = S.runPut (S.putWord32host addr >> S.put (fromIntegral port :: Word16))
-encodeAddr (SockAddrInet6 port _ addr _)
-    = S.runPut (S.put addr >> S.put (fromIntegral port :: Word16))
-encodeAddr _ = B.empty
-
-{-----------------------------------------------------------------------
--- Response messages
------------------------------------------------------------------------}
-
--- | Response messages are sent upon successful completion of a
--- query:
---
---   * KResponse used to signal that callee successufully process a
---   procedure call and to return values from procedure.
---
---   * KResponse should not be sent if error occurred during RPC,
---   'KError' should be sent instead.
---
---   * KResponse can be only sent from server to client.
---
-#ifdef VERSION_bencoding
-data KResponseOf a = KResponse
-  { respVals :: a              -- ^ 'BDict' containing return values;
-  , respId   :: TransactionId  -- ^ match to the corresponding 'queryId'.
-  , respIP   :: Maybe ReflectedIP
-  } deriving (Show, Eq, Ord, Typeable, Functor, Foldable, Traversable)
-
-type KResponse = KResponseOf KQueryArgs
-
--- | Responses, or KRPC message dictionaries with a \"y\" value of
--- \"r\", contain one additional key \"r\". The value of \"r\" is a
--- dictionary containing named return values.
---
---   Example Response packet:
---
---   > { "t" : "aa", "y" : "r", "r" : { "msg" : "you've sent: hi!" } }
---
-instance (Typeable a, BEncode a) => BEncode (KResponseOf a) where
-  toBEncode KResponse {..} = toDict $
-       "ip" .=? respIP
-    .: "r" .=! respVals
-    .: "t" .=! respId
-    .: "y" .=! ("r" :: ByteString)
-    .: endDict
-  {-# INLINE toBEncode #-}
-
-  fromBEncode = fromDict $ do
-    lookAhead $ match "y" (BString "r")
-    addr <- optional (field (req "ip"))
-    (\r t -> KResponse r t addr) <$>! "r" <*>! "t"
-  {-# INLINE fromBEncode #-}
-#else
-type KResponse = Tox.Message KQueryArgs
-respVals       = Tox.msgPayload
-respId         = Tox.msgNonce
-respIP         = Nothing :: Maybe ReflectedIP
-#endif
-
-{-----------------------------------------------------------------------
--- Summed messages
------------------------------------------------------------------------}
-
-#ifdef VERSION_bencoding
--- | Generic KRPC message.
-data KMessageOf a
-  = Q (KQueryOf a)
-  | R (KResponseOf a)
-  | E KError
-    deriving (Show, Eq, Functor, Foldable, Traversable)
-
-type KMessage = KMessageOf KQueryArgs
-
-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
-    <|> decodingError "KMessage: unknown message or message tag"
-#else
-type KMessageOf = Tox.Message
-type KMessage = KMessageOf B.ByteString
-#endif
diff --git a/src/Network/KRPC/Method.hs b/src/Network/KRPC/Method.hs
index ad93cb8b..ea11720c 100644
--- a/src/Network/KRPC/Method.hs
+++ b/src/Network/KRPC/Method.hs
@@ -31,7 +31,7 @@ import Data.Monoid
 import Data.List as L
 import Data.String
 import Data.Typeable
-import Network.KRPC.Message
+import Network.DatagramServer.Mainline
 
 
 -- | Method datatype used to describe method name, parameters and