-- |
--   Copyright   :  (c) Sam Truzjan 2013, 2014
--   License     :  BSD3
--   Maintainer  :  pxqr.sta@gmail.com
--   Stability   :  experimental
--   Portability :  portable
--
--   Normally, you don't need to import this module.
--
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FunctionalDependencies     #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeFamilies               #-}
module Network.KRPC.Method
       ( Method (..)
       , KRPC (..)
       ) where

#ifdef VERSION_bencoding
import Data.BEncode (BEncode)
#else
import Data.Serialize
#endif
import Data.ByteString.Char8 as BC
import Data.Char
import Data.Monoid
import Data.List as L
import Data.String
import Data.Typeable
import Network.DatagramServer.Mainline
import Network.DatagramServer.Types
import Network.DHT.Types


-- | Method datatype used to describe method name, parameters and
-- return values of procedure. Client use a method to /invoke/, server
-- /implements/ the method to make the actual work.
--
--   We use the following fantom types to ensure type-safiety:
--
--     * param: Type of method parameters.
--
--     * result: Type of return value of the method.
--
newtype Method dht param result = Method { methodName :: QueryMethod dht }

deriving instance Eq (QueryMethod dht) => Eq (Method dht param result)
deriving instance Ord (QueryMethod dht) => Ord (Method dht param result)
deriving instance IsString (QueryMethod dht) => IsString (Method dht param result)
deriving instance BEncode (QueryMethod dht) => BEncode (Method dht param result)

-- | Example:
--
--   @show (Method \"concat\" :: [Int] Int) == \"concat :: [Int] -> Int\"@
--
instance (Show (QueryMethod dht), Typeable a, Typeable b) => Show (Method dht a b) where
  showsPrec _ = showsMethod

showsMethod :: forall dht a b. ( Show (QueryMethod dht), Typeable a , Typeable b ) => Method dht a b -> ShowS
showsMethod (Method name) =
    -- showString (BC.unpack name) <>
    shows (show name) <>
    showString " :: " <>
    shows paramsTy <>
    showString " -> " <>
    shows valuesTy
  where
    impossible = error "KRPC.showsMethod: impossible"
    paramsTy = typeOf (impossible :: a)
    valuesTy = typeOf (impossible :: b)

-- | In order to perform or handle KRPC query you need to provide
--   corresponding 'KRPC' class.
--
--   Example:
--
--   @
--   data Ping = Ping Text deriving BEncode
--   data Pong = Pong Text deriving BEncode
--
--   instance 'KRPC' Ping Pong where
--     method = \"ping\"
--   @
--
class ( Typeable req, Typeable resp, Envelope dht)
    => KRPC dht req resp | req -> resp, resp -> req where

  -- | Method name. Default implementation uses lowercased @req@
  -- datatype name.
  --
  method :: Method dht req resp

  -- TODO add underscores
  default method :: (IsString (QueryMethod dht), Typeable req) => Method dht req resp
  method = Method $ fromString $ L.map toLower $ show $ typeOf hole
    where
      hole = error "krpc.method: impossible" :: req


  validateExchange :: dht req -> dht resp -> Bool
  validateExchange _ _ = True

  makeQueryExtra :: DHTData dht ip -> NodeId dht -> Proxy req -> Proxy resp -> IO (QueryExtra dht)
  makeResponseExtra :: DHTData dht ip -> NodeId dht -> req -> Proxy resp -> IO (ResponseExtra dht)

  messageSender :: dht req -> Proxy resp -> NodeId dht
  messageResponder :: Proxy req -> dht resp -> NodeId dht