{-# LANGUAGE DeriveDataTypeable #-}

{-|
Module      : Database.Memcache.Errors
Description : Errors Handling
Copyright   : (c) David Terei, 2016
License     : BSD
Maintainer  : code@davidterei.com
Stability   : stable
Portability : GHC

Memcached related errors and exception handling.
-}
module Database.Memcache.Errors (
        -- * Error types
        MemcacheError(..),
        Status(..),
        ClientError(..),
        ProtocolError(..),

        -- * Error creation
        throwStatus,
        wrongOp
    ) where

import Database.Memcache.Types

import Control.Exception
import Data.Typeable

-- | All exceptions that a Memcached client may throw.
data MemcacheError
    -- | Memcached operation error.
    = OpError Status
    -- | Error occuring on client side.
    | ClientError ClientError
    -- | Errors occurring communicating with Memcached server.
    | ProtocolError ProtocolError
    deriving (MemcacheError -> MemcacheError -> Bool
(MemcacheError -> MemcacheError -> Bool)
-> (MemcacheError -> MemcacheError -> Bool) -> Eq MemcacheError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MemcacheError -> MemcacheError -> Bool
$c/= :: MemcacheError -> MemcacheError -> Bool
== :: MemcacheError -> MemcacheError -> Bool
$c== :: MemcacheError -> MemcacheError -> Bool
Eq, Int -> MemcacheError -> ShowS
[MemcacheError] -> ShowS
MemcacheError -> String
(Int -> MemcacheError -> ShowS)
-> (MemcacheError -> String)
-> ([MemcacheError] -> ShowS)
-> Show MemcacheError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MemcacheError] -> ShowS
$cshowList :: [MemcacheError] -> ShowS
show :: MemcacheError -> String
$cshow :: MemcacheError -> String
showsPrec :: Int -> MemcacheError -> ShowS
$cshowsPrec :: Int -> MemcacheError -> ShowS
Show, Typeable)

instance Exception MemcacheError

-- | Errors that occur on the client.
data ClientError
    -- | All servers are currently marked failed.
    = NoServersReady
    -- | Timeout occurred sending request to server.
    | Timeout
    deriving (ClientError -> ClientError -> Bool
(ClientError -> ClientError -> Bool)
-> (ClientError -> ClientError -> Bool) -> Eq ClientError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientError -> ClientError -> Bool
$c/= :: ClientError -> ClientError -> Bool
== :: ClientError -> ClientError -> Bool
$c== :: ClientError -> ClientError -> Bool
Eq, Int -> ClientError -> ShowS
[ClientError] -> ShowS
ClientError -> String
(Int -> ClientError -> ShowS)
-> (ClientError -> String)
-> ([ClientError] -> ShowS)
-> Show ClientError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientError] -> ShowS
$cshowList :: [ClientError] -> ShowS
show :: ClientError -> String
$cshow :: ClientError -> String
showsPrec :: Int -> ClientError -> ShowS
$cshowsPrec :: Int -> ClientError -> ShowS
Show, Typeable)

-- | Errors related to Memcached protocol and bytes on the wire.
data ProtocolError
    -- | Received an unknown response packet.
    = UnknownPkt    { ProtocolError -> String
protocolError :: String }
    -- | Unknown Memcached operation.
    | UnknownOp     { protocolError :: String }
    -- | Unknown Memcached status field value.
    | UnknownStatus { protocolError :: String }
    -- | Unexpected length of a Memcached field (extras, key, or value).
    | BadLength     { protocolError :: String }
    -- | Response packet is for a different operation than expected.
    | WrongOp       { protocolError :: String }
    -- | Network socket closed without receiving enough bytes.
    | UnexpectedEOF { protocolError :: String }
    deriving (ProtocolError -> ProtocolError -> Bool
(ProtocolError -> ProtocolError -> Bool)
-> (ProtocolError -> ProtocolError -> Bool) -> Eq ProtocolError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProtocolError -> ProtocolError -> Bool
$c/= :: ProtocolError -> ProtocolError -> Bool
== :: ProtocolError -> ProtocolError -> Bool
$c== :: ProtocolError -> ProtocolError -> Bool
Eq, Int -> ProtocolError -> ShowS
[ProtocolError] -> ShowS
ProtocolError -> String
(Int -> ProtocolError -> ShowS)
-> (ProtocolError -> String)
-> ([ProtocolError] -> ShowS)
-> Show ProtocolError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProtocolError] -> ShowS
$cshowList :: [ProtocolError] -> ShowS
show :: ProtocolError -> String
$cshow :: ProtocolError -> String
showsPrec :: Int -> ProtocolError -> ShowS
$cshowsPrec :: Int -> ProtocolError -> ShowS
Show, Typeable)

-- | Convert a status to 'MemcacheError' exception.
throwStatus :: Status -> IO a
throwStatus :: Status -> IO a
throwStatus Status
s = MemcacheError -> IO a
forall e a. Exception e => e -> IO a
throwIO (MemcacheError -> IO a) -> MemcacheError -> IO a
forall a b. (a -> b) -> a -> b
$ Status -> MemcacheError
OpError Status
s

-- | Create a properly formatted 'WrongOp' protocol error.
wrongOp :: Response -> String -> MemcacheError
wrongOp :: Response -> String -> MemcacheError
wrongOp Response
r String
msg = ProtocolError -> MemcacheError
ProtocolError (ProtocolError -> MemcacheError) -> ProtocolError -> MemcacheError
forall a b. (a -> b) -> a -> b
$
    WrongOp :: String -> ProtocolError
WrongOp {
        protocolError :: String
protocolError  = String
"Expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"! Got: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ OpResponse -> String
forall a. Show a => a -> String
show (Response -> OpResponse
resOp Response
r)
    }