Whitelist.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{- 
 - (C) 2012, Andy Georges
 -
 - This module provides the interface to the Mollom whitelisting API.
 -}

module Network.Mollom.Whitelist
  ( Reason(..)
  , Context(..)
  , WhitelistResponse(..)
  , createWhitelist
  , updateWhitelist
  , deleteWhitelist
  , listWhitelist
  , readWhitelistEntry
  ) where

import Control.Applicative
import Control.Monad.Error
import Control.Monad.Reader
import qualified Data.Aeson as A
import Data.List(intercalate)
import Data.Maybe(catMaybes)
import Network.HTTP.Base (RequestMethod(..))

import Network.Mollom.Helper
import Network.Mollom.MollomMonad
import Network.Mollom.Types

-- | Data type representing the reasons the user can provide to
--   the Mollom service for whitelisting a string or a value.
data Reason = Spam 
            | Profanity 
            | Quality 
            | Unwanted 
            deriving (Eq)

instance Show Reason where
  show Spam = "spam"
  show Profanity = " profanity"
  show Quality = "quality"
  show Unwanted = "unwanted"

instance A.FromJSON Reason where
    parseJSON (A.String s) = return $ case s of
                               "spam"      -> Spam
                               "profanity" -> Profanity
                               "quality"   -> Quality
                               "unwanted"  -> Unwanted
    parseJSON _ = mzero


-- | Data type representing the context in which the Mollom
--   service is allowed to look for a whitelisted term (to be 
--   provided at the creation of said term).
data Context = AuthorName
             | AuthorMail
             | AuthorIp
             | AuthorId
              deriving (Eq)

instance Show Context where
  show AuthorName = "authorName"
  show AuthorMail = "authorMail"
  show AuthorIp = "authorIp"
  show AuthorId = "authorId"


instance A.FromJSON Context where
    parseJSON (A.String s) = return $ case s of
                                "authorName" -> AuthorName
                                "authorMail" -> AuthorMail
                                "authorIp"   -> AuthorIp
                                "authorId"   -> AuthorId
    parseJSON _ = mzero


-- | Data type indicating how well a specific match should be.
data Match = Exact
           | Contains
           deriving Eq

instance Show Match where
  show Exact = "exact"
  show Contains = "contains"

instance A.FromJSON Match where
    parseJSON (A.String s) = return $ case s of
                                "exact" -> Exact
                                "contains" -> Contains
    parseJSON _ = mzero


-- | Data type representing the response in the blacklist API.
data WhitelistResponse = 
     WhitelistResponse { whitelistId         :: String
                       , whitelistCreated    :: String -- FIXME should be datetime
                       , whitelistStatus     :: Bool
                       , whitelistLastMatch  :: String -- FIXME should be datetime
                       , whitelistMatchCount :: Int
                       , whitelistValue      :: String
                       , whitelistContext    :: Context
                       , whitelistNote       :: String
                       }

instance A.FromJSON WhitelistResponse where
    parseJSON j = do
        o <- A.parseJSON j
        e <- o A..: "entry"
        WhitelistResponse <$>
          e A..: "id"         <*>
          e A..: "created"    <*>
          e A..: "status"     <*>
          e A..: "lastMatch"  <*>
          e A..: "matchCount" <*>
          e A..: "value"      <*>
          e A..: "context"    <*>
          e A..: "note"


instance A.FromJSON [WhitelistResponse] where
    parseJSON j = do
      o <- A.parseJSON j
      ls <- o A..: "list"
      mapM A.parseJSON ls




-- | Create a whitelist entry for the given site.
createWhitelist :: String        -- ^ The value or string to whitelist
                -> Maybe Context -- ^ Where may the entry match
                -> Maybe Bool    -- ^ Is the entry live or not
                -> Maybe String  -- ^ Note
                -> Mollom (MollomResponse WhitelistResponse)
createWhitelist s context status note = do
    config <- ask
    let pubKey = mcPublicKey config
        privKey = mcPrivateKey config
        path = "whitelist/" ++ pubKey
        kvs = [ ("value", Just s)
              , ("context", fmap show context)
              , ("status", fmap boolToOneZeroString status)
              , ("note", note)
              ]
        errors = generalErrors
    mollomService pubKey privKey POST path kvs [] errors


-- | Update an existing whitelist entry. All arguments that are provided as Nothing
--   default to keeping existing values.
updateWhitelist :: String        -- ^ ID of the whitelisted entry to update
                -> Maybe String  -- ^ The whitelisted string or value.
                -> Maybe Context -- ^ Where may the entry match
                -> Maybe Bool    -- ^ Is the entry live or not
                -> Maybe String  -- ^ Note
                -> Mollom (MollomResponse ())
updateWhitelist entryId s context status note = do
    config <- ask
    let pubKey = mcPublicKey config
        privKey = mcPrivateKey config
        path = "whitelist/" ++ pubKey ++ "/" ++ entryId
        kvs = [ ("value", s)
              , ("context", fmap show context)
              , ("status", fmap boolToOneZeroString status)
              , ("note", note)
              ]
        errors = generalErrors
    mollomService pubKey privKey POST path kvs [] errors

-- | Delete a whitelisted entry.
deleteWhitelist :: String    -- ^ ID of the whitelisted entry to delete
                -> Mollom (MollomResponse ())
deleteWhitelist entryId = do
    config <- ask
    let pubKey = mcPublicKey config
        privKey = mcPrivateKey config
        path = "whitelist/" ++ pubKey ++ "/" ++ entryId ++ "/delete"
        errors = generalErrors
    mollomService pubKey privKey POST path [] [] errors


-- | List the entries in the whitelist for a given set of credentials, 
--   identified by the site public key.
--   FIXME: the arguments determination is fugly.
listWhitelist :: Maybe Int  -- ^ The offset from which to start listing entries. Defaults to 0 when Nothing is given as the argument.
              -> Maybe Int  -- ^ The number of entries that should be returned. Defaults to all.
              -> Mollom (MollomResponse [WhitelistResponse])
listWhitelist offset count = do
    config <- ask
    let pubKey = mcPublicKey config
        privKey = mcPrivateKey config
        arguments = case offset `mplus` count of
                      Nothing -> ""
                      _       -> "/q?" ++ (intercalate "&" $ catMaybes [ fmap (\o -> "offset=" ++ show o) offset
                                                                       , fmap (\c -> "count=" ++ show c) count
                                                                       ])
        path = "whitelist/" ++ pubKey ++ arguments
        errors = generalErrors
    mollomService pubKey privKey GET path [] [] errors


-- | Read the information that is stored for a given whitelist entry.
readWhitelistEntry :: String  -- ^ ID of the whitelisted entry to read
              -> Mollom (MollomResponse WhitelistResponse)
readWhitelistEntry entryId = do
    config <- ask
    let pubKey = mcPublicKey config
        privKey = mcPrivateKey config
        path = "whitelist/" ++ pubKey ++ "/" ++ entryId
        errors = generalErrors
    mollomService pubKey privKey GET path [] [] errors