-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at http://mozilla.org/MPL/2.0/.

{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}

module Database.Redis.IO.Types where

import Control.Exception (Exception, SomeException, catch)
import Data.IP
import Data.Typeable
import Network.Socket (SockAddr (..), PortNumber)
import System.Logger.Message

newtype Milliseconds = Ms { Milliseconds -> Int
ms :: Int } deriving (Milliseconds -> Milliseconds -> Bool
(Milliseconds -> Milliseconds -> Bool)
-> (Milliseconds -> Milliseconds -> Bool) -> Eq Milliseconds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Milliseconds -> Milliseconds -> Bool
$c/= :: Milliseconds -> Milliseconds -> Bool
== :: Milliseconds -> Milliseconds -> Bool
$c== :: Milliseconds -> Milliseconds -> Bool
Eq, Int -> Milliseconds -> ShowS
[Milliseconds] -> ShowS
Milliseconds -> String
(Int -> Milliseconds -> ShowS)
-> (Milliseconds -> String)
-> ([Milliseconds] -> ShowS)
-> Show Milliseconds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Milliseconds] -> ShowS
$cshowList :: [Milliseconds] -> ShowS
show :: Milliseconds -> String
$cshow :: Milliseconds -> String
showsPrec :: Int -> Milliseconds -> ShowS
$cshowsPrec :: Int -> Milliseconds -> ShowS
Show, Integer -> Milliseconds
Milliseconds -> Milliseconds
Milliseconds -> Milliseconds -> Milliseconds
(Milliseconds -> Milliseconds -> Milliseconds)
-> (Milliseconds -> Milliseconds -> Milliseconds)
-> (Milliseconds -> Milliseconds -> Milliseconds)
-> (Milliseconds -> Milliseconds)
-> (Milliseconds -> Milliseconds)
-> (Milliseconds -> Milliseconds)
-> (Integer -> Milliseconds)
-> Num Milliseconds
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Milliseconds
$cfromInteger :: Integer -> Milliseconds
signum :: Milliseconds -> Milliseconds
$csignum :: Milliseconds -> Milliseconds
abs :: Milliseconds -> Milliseconds
$cabs :: Milliseconds -> Milliseconds
negate :: Milliseconds -> Milliseconds
$cnegate :: Milliseconds -> Milliseconds
* :: Milliseconds -> Milliseconds -> Milliseconds
$c* :: Milliseconds -> Milliseconds -> Milliseconds
- :: Milliseconds -> Milliseconds -> Milliseconds
$c- :: Milliseconds -> Milliseconds -> Milliseconds
+ :: Milliseconds -> Milliseconds -> Milliseconds
$c+ :: Milliseconds -> Milliseconds -> Milliseconds
Num)

-----------------------------------------------------------------------------
-- InetAddr

newtype InetAddr = InetAddr { InetAddr -> SockAddr
sockAddr :: SockAddr } deriving (InetAddr -> InetAddr -> Bool
(InetAddr -> InetAddr -> Bool)
-> (InetAddr -> InetAddr -> Bool) -> Eq InetAddr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InetAddr -> InetAddr -> Bool
$c/= :: InetAddr -> InetAddr -> Bool
== :: InetAddr -> InetAddr -> Bool
$c== :: InetAddr -> InetAddr -> Bool
Eq, Eq InetAddr
Eq InetAddr
-> (InetAddr -> InetAddr -> Ordering)
-> (InetAddr -> InetAddr -> Bool)
-> (InetAddr -> InetAddr -> Bool)
-> (InetAddr -> InetAddr -> Bool)
-> (InetAddr -> InetAddr -> Bool)
-> (InetAddr -> InetAddr -> InetAddr)
-> (InetAddr -> InetAddr -> InetAddr)
-> Ord InetAddr
InetAddr -> InetAddr -> Bool
InetAddr -> InetAddr -> Ordering
InetAddr -> InetAddr -> InetAddr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InetAddr -> InetAddr -> InetAddr
$cmin :: InetAddr -> InetAddr -> InetAddr
max :: InetAddr -> InetAddr -> InetAddr
$cmax :: InetAddr -> InetAddr -> InetAddr
>= :: InetAddr -> InetAddr -> Bool
$c>= :: InetAddr -> InetAddr -> Bool
> :: InetAddr -> InetAddr -> Bool
$c> :: InetAddr -> InetAddr -> Bool
<= :: InetAddr -> InetAddr -> Bool
$c<= :: InetAddr -> InetAddr -> Bool
< :: InetAddr -> InetAddr -> Bool
$c< :: InetAddr -> InetAddr -> Bool
compare :: InetAddr -> InetAddr -> Ordering
$ccompare :: InetAddr -> InetAddr -> Ordering
$cp1Ord :: Eq InetAddr
Ord)

instance Show InetAddr where
    show :: InetAddr -> String
show (InetAddr (SockAddrInet PortNumber
p HostAddress
a)) =
        let i :: Int
i = PortNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
p :: Int in
        IPv4 -> ShowS
forall a. Show a => a -> ShowS
shows (HostAddress -> IPv4
fromHostAddress HostAddress
a) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
":" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
i ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
""
    show (InetAddr (SockAddrInet6 PortNumber
p HostAddress
_ HostAddress6
a HostAddress
_)) =
        let i :: Int
i = PortNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
p :: Int in
        IPv6 -> ShowS
forall a. Show a => a -> ShowS
shows (HostAddress6 -> IPv6
fromHostAddress6 HostAddress6
a) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
":" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
i ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
""
    show (InetAddr (SockAddrUnix String
unix)) = String
unix
#if !MIN_VERSION_network(3,0,0)
    show (InetAddr (SockAddrCan int32)) = show int32
#endif

instance ToBytes InetAddr where
    bytes :: InetAddr -> Builder
bytes (InetAddr (SockAddrInet PortNumber
p HostAddress
a)) =
        let i :: Int
i = PortNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
p :: Int in
        IPv4 -> String
forall a. Show a => a -> String
show (HostAddress -> IPv4
fromHostAddress HostAddress
a) String -> Builder -> Builder
forall a b. (ToBytes a, ToBytes b) => a -> b -> Builder
+++ ByteString -> Builder
val ByteString
":" Builder -> Int -> Builder
forall a b. (ToBytes a, ToBytes b) => a -> b -> Builder
+++ Int
i
    bytes (InetAddr (SockAddrInet6 PortNumber
p HostAddress
_ HostAddress6
a HostAddress
_)) =
        let i :: Int
i = PortNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
p :: Int in
        IPv6 -> String
forall a. Show a => a -> String
show (HostAddress6 -> IPv6
fromHostAddress6 HostAddress6
a) String -> Builder -> Builder
forall a b. (ToBytes a, ToBytes b) => a -> b -> Builder
+++ ByteString -> Builder
val ByteString
":" Builder -> Int -> Builder
forall a b. (ToBytes a, ToBytes b) => a -> b -> Builder
+++ Int
i
    bytes (InetAddr (SockAddrUnix String
unix)) = String -> Builder
forall a. ToBytes a => a -> Builder
bytes String
unix
#if !MIN_VERSION_network(3,0,0)
    bytes (InetAddr (SockAddrCan int32)) = bytes int32
#endif

ip2inet :: PortNumber -> IP -> InetAddr
ip2inet :: PortNumber -> IP -> InetAddr
ip2inet PortNumber
p (IPv4 IPv4
a) = SockAddr -> InetAddr
InetAddr (SockAddr -> InetAddr) -> SockAddr -> InetAddr
forall a b. (a -> b) -> a -> b
$ PortNumber -> HostAddress -> SockAddr
SockAddrInet PortNumber
p (IPv4 -> HostAddress
toHostAddress IPv4
a)
ip2inet PortNumber
p (IPv6 IPv6
a) = SockAddr -> InetAddr
InetAddr (SockAddr -> InetAddr) -> SockAddr -> InetAddr
forall a b. (a -> b) -> a -> b
$ PortNumber
-> HostAddress -> HostAddress6 -> HostAddress -> SockAddr
SockAddrInet6 PortNumber
p HostAddress
0 (IPv6 -> HostAddress6
toHostAddress6 IPv6
a) HostAddress
0

-----------------------------------------------------------------------------
-- ConnectionError

data ConnectionError
    = ConnectionsBusy  -- ^ All connections are in use.
    | ConnectionClosed -- ^ The connection has been closed unexpectedly.
    | ConnectTimeout   -- ^ Connecting to redis server took too long.
    deriving Typeable

instance Exception ConnectionError

instance Show ConnectionError where
    show :: ConnectionError -> String
show ConnectionError
ConnectionsBusy   = String
"redis-io: connections busy"
    show ConnectionError
ConnectionClosed  = String
"redis-io: connection closed"
    show ConnectionError
ConnectTimeout    = String
"redis-io: connect timeout"

-----------------------------------------------------------------------------
-- InternalError

-- | General error, e.g. parsing redis responses failed.
newtype InternalError = InternalError String
    deriving Typeable

instance Exception InternalError

instance Show InternalError where
    show :: InternalError -> String
show (InternalError String
e) = String
"redis-io: internal error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
e

-----------------------------------------------------------------------------
-- Timeout

-- | A single send-receive cycle took too long.
newtype Timeout = Timeout String
    deriving Typeable

instance Exception Timeout

instance Show Timeout where
    show :: Timeout -> String
show (Timeout String
e) = String
"redis-io: timeout: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e

-----------------------------------------------------------------------------
-- Transaction failure

-- | An exception thrown on transaction failures.
data TransactionFailure
    = TransactionAborted        -- ^ A @WATCH@ed key changed conccurrently.
    | TransactionDiscarded      -- ^ The transaction was @DISCARD@ed.
    | TransactionFailure String -- ^ Other transaction failure.
    deriving Typeable

instance Exception TransactionFailure

instance Show TransactionFailure where
    show :: TransactionFailure -> String
show TransactionFailure
TransactionAborted     = String
"redis-io: transaction aborted"
    show TransactionFailure
TransactionDiscarded   = String
"redis-io: transaction discarded"
    show (TransactionFailure String
e) = String
"redis-io: transaction failed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e

ignore :: IO () -> IO ()
ignore :: IO () -> IO ()
ignore IO ()
a = IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch IO ()
a (IO () -> SomeException -> IO ()
forall a b. a -> b -> a
const (IO () -> SomeException -> IO ())
-> IO () -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () :: SomeException -> IO ())
{-# INLINE ignore #-}