{-# LANGUAGE CPP #-}
module ZooKeeper.Exception
( ZooException
, zooExceptionToException
, zooExceptionFromException
, ZooExInfo (..)
, ZSYSTEMERROR (..)
, ZRUNTIMEINCONSISTENCY (..)
, ZDATAINCONSISTENCY (..)
, ZCONNECTIONLOSS (..)
, ZMARSHALLINGERROR (..)
, ZUNIMPLEMENTED (..)
, ZOPERATIONTIMEOUT (..)
, ZBADARGUMENTS (..)
, ZINVALIDSTATE (..)
, ZNEWCONFIGNOQUORUM (..)
, ZRECONFIGINPROGRESS (..)
, ZSSLCONNECTIONERROR (..)
, ZAPIERROR (..)
, ZNONODE (..)
, ZNOAUTH (..)
, ZBADVERSION (..)
, ZNOCHILDRENFOREPHEMERALS (..)
, ZNODEEXISTS (..)
, ZNOTEMPTY (..)
, ZSESSIONEXPIRED (..)
, ZINVALIDCALLBACK (..)
, ZINVALIDACL (..)
, ZAUTHFAILED (..)
, ZCLOSING (..)
, ZNOTHING (..)
, ZSESSIONMOVED (..)
, ZNOTREADONLY (..)
, ZEPHEMERALONLOCALSESSION (..)
, ZNOWATCHER (..)
, ZRECONFIGDISABLED (..)
, ZSESSIONCLOSEDREQUIRESASLAUTH (..)
, ZTHROTTLEDOP (..)
, SYSERRNO
, UNKNOWN_ERR
, throwZooError
, throwZooErrorIfNotOK
, throwZooErrorIfLeft
, throwZooErrorIfLeft'
, pattern CZOK
, pattern CZSYSTEMERROR
, pattern CZRUNTIMEINCONSISTENCY
, pattern CZDATAINCONSISTENCY
, pattern CZCONNECTIONLOSS
, pattern CZMARSHALLINGERROR
, pattern CZUNIMPLEMENTED
, pattern CZOPERATIONTIMEOUT
, pattern CZBADARGUMENTS
, pattern CZINVALIDSTATE
, pattern CZNEWCONFIGNOQUORUM
, pattern CZRECONFIGINPROGRESS
, pattern CZSSLCONNECTIONERROR
, pattern CZAPIERROR
, pattern CZNONODE
, pattern CZNOAUTH
, pattern CZBADVERSION
, pattern CZNOCHILDRENFOREPHEMERALS
, pattern CZNODEEXISTS
, pattern CZNOTEMPTY
, pattern CZSESSIONEXPIRED
, pattern CZINVALIDCALLBACK
, pattern CZINVALIDACL
, pattern CZAUTHFAILED
, pattern CZCLOSING
, pattern CZNOTHING
, pattern CZSESSIONMOVED
, pattern CZNOTREADONLY
, pattern CZEPHEMERALONLOCALSESSION
, pattern CZNOWATCHER
, pattern CZRECONFIGDISABLED
, pattern CZSESSIONCLOSEDREQUIRESASLAUTH
, pattern CZTHROTTLEDOP
, E.throwIO
, getCErrNum
) where
import Control.Exception (Exception (..))
import qualified Control.Exception as E
import Data.Typeable (cast)
import Foreign.C (CInt, CString)
import GHC.Stack (CallStack, HasCallStack, callStack,
prettyCallStack)
import qualified Z.Data.Text as T
import qualified Z.Data.Text.Print as T
import qualified Z.Foreign as Z
data ZooException = forall e . E.Exception e => ZooException e
instance Show ZooException where
show :: ZooException -> String
show (ZooException e
e) = e -> String
forall a. Show a => a -> String
show e
e
instance E.Exception ZooException
zooExceptionToException :: E.Exception e => e -> E.SomeException
zooExceptionToException :: e -> SomeException
zooExceptionToException = ZooException -> SomeException
forall e. Exception e => e -> SomeException
E.toException (ZooException -> SomeException)
-> (e -> ZooException) -> e -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ZooException
forall e. Exception e => e -> ZooException
ZooException
zooExceptionFromException :: E.Exception e => E.SomeException -> Maybe e
zooExceptionFromException :: SomeException -> Maybe e
zooExceptionFromException SomeException
x = do
ZooException e
a <- SomeException -> Maybe ZooException
forall e. Exception e => SomeException -> Maybe e
E.fromException SomeException
x
e -> Maybe e
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
a
data ZooExInfo = ZooExInfo
{ ZooExInfo -> Text
errDescription :: T.Text
, ZooExInfo -> CallStack
errCallStack :: CallStack
}
instance T.Print ZooExInfo where
toUTF8BuilderP :: Int -> ZooExInfo -> Builder ()
toUTF8BuilderP Int
_ (ZooExInfo Text
desc CallStack
cstack) = do
Builder ()
"description: "
Text -> Builder ()
T.text Text
desc
Builder ()
", callstack: "
String -> Builder ()
T.stringUTF8 (CallStack -> String
prettyCallStack CallStack
cstack)
instance Show ZooExInfo where
show :: ZooExInfo -> String
show = ZooExInfo -> String
forall a. Print a => a -> String
T.toString
pattern
CZOK
, CZSYSTEMERROR
, CZRUNTIMEINCONSISTENCY
, CZDATAINCONSISTENCY
, CZCONNECTIONLOSS
, CZMARSHALLINGERROR
, CZUNIMPLEMENTED
, CZOPERATIONTIMEOUT
, CZBADARGUMENTS
, CZINVALIDSTATE
, CZNEWCONFIGNOQUORUM
, CZRECONFIGINPROGRESS
, CZSSLCONNECTIONERROR
, CZAPIERROR
, CZNONODE
, CZNOAUTH
, CZBADVERSION
, CZNOCHILDRENFOREPHEMERALS
, CZNODEEXISTS
, CZNOTEMPTY
, CZSESSIONEXPIRED
, CZINVALIDCALLBACK
, CZINVALIDACL
, CZAUTHFAILED
, CZCLOSING
, CZNOTHING
, CZSESSIONMOVED
, CZNOTREADONLY
, CZEPHEMERALONLOCALSESSION
, CZNOWATCHER
, CZRECONFIGDISABLED
, CZSESSIONCLOSEDREQUIRESASLAUTH
, CZTHROTTLEDOP
:: CInt
pattern $bCZOK :: CInt
$mCZOK :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZOK = 0
pattern $bCZSYSTEMERROR :: CInt
$mCZSYSTEMERROR :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZSYSTEMERROR = (- 1)
pattern $bCZRUNTIMEINCONSISTENCY :: CInt
$mCZRUNTIMEINCONSISTENCY :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZRUNTIMEINCONSISTENCY = (- 2)
pattern $bCZDATAINCONSISTENCY :: CInt
$mCZDATAINCONSISTENCY :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZDATAINCONSISTENCY = (- 3)
pattern $bCZCONNECTIONLOSS :: CInt
$mCZCONNECTIONLOSS :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZCONNECTIONLOSS = (- 4)
pattern $bCZMARSHALLINGERROR :: CInt
$mCZMARSHALLINGERROR :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZMARSHALLINGERROR = (- 5)
pattern $bCZUNIMPLEMENTED :: CInt
$mCZUNIMPLEMENTED :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZUNIMPLEMENTED = (- 6)
pattern $bCZOPERATIONTIMEOUT :: CInt
$mCZOPERATIONTIMEOUT :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZOPERATIONTIMEOUT = (- 7)
pattern $bCZBADARGUMENTS :: CInt
$mCZBADARGUMENTS :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZBADARGUMENTS = (- 8)
pattern $bCZINVALIDSTATE :: CInt
$mCZINVALIDSTATE :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZINVALIDSTATE = (- 9)
pattern $bCZNEWCONFIGNOQUORUM :: CInt
$mCZNEWCONFIGNOQUORUM :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZNEWCONFIGNOQUORUM = (-13)
pattern $bCZRECONFIGINPROGRESS :: CInt
$mCZRECONFIGINPROGRESS :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZRECONFIGINPROGRESS = (-14)
pattern $bCZSSLCONNECTIONERROR :: CInt
$mCZSSLCONNECTIONERROR :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZSSLCONNECTIONERROR = (-15)
pattern $bCZAPIERROR :: CInt
$mCZAPIERROR :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZAPIERROR = (-100)
pattern $bCZNONODE :: CInt
$mCZNONODE :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZNONODE = (-101)
pattern $bCZNOAUTH :: CInt
$mCZNOAUTH :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZNOAUTH = (-102)
pattern $bCZBADVERSION :: CInt
$mCZBADVERSION :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZBADVERSION = (-103)
pattern $bCZNOCHILDRENFOREPHEMERALS :: CInt
$mCZNOCHILDRENFOREPHEMERALS :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZNOCHILDRENFOREPHEMERALS = (-108)
pattern $bCZNODEEXISTS :: CInt
$mCZNODEEXISTS :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZNODEEXISTS = (-110)
pattern $bCZNOTEMPTY :: CInt
$mCZNOTEMPTY :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZNOTEMPTY = (-111)
pattern $bCZSESSIONEXPIRED :: CInt
$mCZSESSIONEXPIRED :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZSESSIONEXPIRED = (-112)
pattern $bCZINVALIDCALLBACK :: CInt
$mCZINVALIDCALLBACK :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZINVALIDCALLBACK = (-113)
pattern $bCZINVALIDACL :: CInt
$mCZINVALIDACL :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZINVALIDACL = (-114)
pattern $bCZAUTHFAILED :: CInt
$mCZAUTHFAILED :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZAUTHFAILED = (-115)
pattern $bCZCLOSING :: CInt
$mCZCLOSING :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZCLOSING = (-116)
pattern $bCZNOTHING :: CInt
$mCZNOTHING :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZNOTHING = (-117)
pattern $bCZSESSIONMOVED :: CInt
$mCZSESSIONMOVED :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZSESSIONMOVED = (-118)
pattern $bCZNOTREADONLY :: CInt
$mCZNOTREADONLY :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZNOTREADONLY = (-119)
pattern $bCZEPHEMERALONLOCALSESSION :: CInt
$mCZEPHEMERALONLOCALSESSION :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZEPHEMERALONLOCALSESSION = (-120)
pattern $bCZNOWATCHER :: CInt
$mCZNOWATCHER :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZNOWATCHER = (-121)
pattern $bCZRECONFIGDISABLED :: CInt
$mCZRECONFIGDISABLED :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZRECONFIGDISABLED = (-123)
pattern $bCZSESSIONCLOSEDREQUIRESASLAUTH :: CInt
$mCZSESSIONCLOSEDREQUIRESASLAUTH :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZSESSIONCLOSEDREQUIRESASLAUTH = (-124)
pattern $bCZTHROTTLEDOP :: CInt
$mCZTHROTTLEDOP :: forall r. CInt -> (Void# -> r) -> (Void# -> r) -> r
CZTHROTTLEDOP = (-127)
#define MAKE_EX(e) \
newtype e = e ZooExInfo deriving (Show); \
instance Exception e where \
{ toException = zooExceptionToException; \
fromException = zooExceptionFromException } \
MAKE_EX(ZSYSTEMERROR )
MAKE_EX(ZRUNTIMEINCONSISTENCY)
MAKE_EX(ZDATAINCONSISTENCY )
MAKE_EX(ZCONNECTIONLOSS )
MAKE_EX(ZMARSHALLINGERROR )
MAKE_EX(ZUNIMPLEMENTED )
MAKE_EX(ZOPERATIONTIMEOUT )
MAKE_EX(ZBADARGUMENTS )
MAKE_EX(ZINVALIDSTATE )
MAKE_EX(ZNEWCONFIGNOQUORUM )
MAKE_EX(ZRECONFIGINPROGRESS )
MAKE_EX(ZSSLCONNECTIONERROR )
MAKE_EX(ZAPIERROR )
MAKE_EX(ZNONODE )
MAKE_EX(ZNOAUTH )
MAKE_EX(ZBADVERSION )
MAKE_EX(ZNOCHILDRENFOREPHEMERALS )
MAKE_EX(ZNODEEXISTS )
MAKE_EX(ZNOTEMPTY )
MAKE_EX(ZSESSIONEXPIRED )
MAKE_EX(ZINVALIDCALLBACK )
MAKE_EX(ZINVALIDACL )
MAKE_EX(ZAUTHFAILED )
MAKE_EX(ZCLOSING )
MAKE_EX(ZNOTHING )
MAKE_EX(ZSESSIONMOVED )
MAKE_EX(ZNOTREADONLY )
MAKE_EX(ZEPHEMERALONLOCALSESSION )
MAKE_EX(ZNOWATCHER )
MAKE_EX(ZRECONFIGDISABLED )
MAKE_EX(ZSESSIONCLOSEDREQUIRESASLAUTH)
MAKE_EX(ZTHROTTLEDOP )
MAKE_EX(SYSERRNO)
MAKE_EX(UNKNOWN_ERR)
#define MAKE_THROW_EX(c, e) \
throwZooError c stack = do \
desc <- T.validate <$> (Z.fromNullTerminated =<< c_zerror c); \
E.throwIO $ e (ZooExInfo desc stack)
throwZooError :: CInt -> CallStack -> IO a
throwZooError :: CInt -> CallStack -> IO a
MAKE_THROW_EX(CInt
CZSYSTEMERROR , ZSYSTEMERROR )
MAKE_THROW_EX(CInt
CZRUNTIMEINCONSISTENCY, ZRUNTIMEINCONSISTENCY)
MAKE_THROW_EX(CInt
CZDATAINCONSISTENCY , ZDATAINCONSISTENCY )
MAKE_THROW_EX(CInt
CZCONNECTIONLOSS , ZCONNECTIONLOSS )
MAKE_THROW_EX(CInt
CZMARSHALLINGERROR , ZMARSHALLINGERROR )
MAKE_THROW_EX(CInt
CZUNIMPLEMENTED , ZUNIMPLEMENTED )
MAKE_THROW_EX(CInt
CZOPERATIONTIMEOUT , ZOPERATIONTIMEOUT )
MAKE_THROW_EX(CInt
CZBADARGUMENTS , ZBADARGUMENTS )
MAKE_THROW_EX(CInt
CZINVALIDSTATE , ZINVALIDSTATE )
MAKE_THROW_EX(CInt
CZNEWCONFIGNOQUORUM , ZNEWCONFIGNOQUORUM )
MAKE_THROW_EX(CInt
CZRECONFIGINPROGRESS , ZRECONFIGINPROGRESS )
MAKE_THROW_EX(CInt
CZSSLCONNECTIONERROR , ZSSLCONNECTIONERROR )
MAKE_THROW_EX(CInt
CZAPIERROR , ZAPIERROR )
MAKE_THROW_EX(CInt
CZNONODE , ZNONODE )
MAKE_THROW_EX(CInt
CZNOAUTH , ZNOAUTH )
MAKE_THROW_EX(CInt
CZBADVERSION , ZBADVERSION )
MAKE_THROW_EX(CInt
CZNOCHILDRENFOREPHEMERALS , ZNOCHILDRENFOREPHEMERALS )
MAKE_THROW_EX(CInt
CZNODEEXISTS , ZNODEEXISTS )
MAKE_THROW_EX(CInt
CZNOTEMPTY , ZNOTEMPTY )
MAKE_THROW_EX(CInt
CZSESSIONEXPIRED , ZSESSIONEXPIRED )
MAKE_THROW_EX(CInt
CZINVALIDCALLBACK , ZINVALIDCALLBACK )
MAKE_THROW_EX(CInt
CZINVALIDACL , ZINVALIDACL )
MAKE_THROW_EX(CInt
CZAUTHFAILED , ZAUTHFAILED )
MAKE_THROW_EX(CInt
CZCLOSING , ZCLOSING )
MAKE_THROW_EX(CInt
CZNOTHING , ZNOTHING )
MAKE_THROW_EX(CInt
CZSESSIONMOVED , ZSESSIONMOVED )
MAKE_THROW_EX(CInt
CZNOTREADONLY , ZNOTREADONLY )
MAKE_THROW_EX(CInt
CZEPHEMERALONLOCALSESSION , ZEPHEMERALONLOCALSESSION )
MAKE_THROW_EX(CInt
CZNOWATCHER , ZNOWATCHER )
MAKE_THROW_EX(CInt
CZRECONFIGDISABLED , ZRECONFIGDISABLED )
MAKE_THROW_EX(CInt
CZSESSIONCLOSEDREQUIRESASLAUTH, ZSESSIONCLOSEDREQUIRESASLAUTH)
MAKE_THROW_EX(CInt
CZTHROTTLEDOP , ZTHROTTLEDOP )
throwZooError CInt
code CallStack
stack
| CInt
code CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
> CInt
0 = do
Text
desc <- HasCallStack => Bytes -> Text
Bytes -> Text
T.validate (Bytes -> Text) -> IO Bytes -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr CChar -> IO Bytes
forall a. Ptr a -> IO Bytes
Z.fromNullTerminated (Ptr CChar -> IO Bytes) -> IO (Ptr CChar) -> IO Bytes
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CInt -> IO (Ptr CChar)
c_zerror CInt
code)
SYSERRNO -> IO a
forall e a. Exception e => e -> IO a
E.throwIO (SYSERRNO -> IO a) -> SYSERRNO -> IO a
forall a b. (a -> b) -> a -> b
$ ZooExInfo -> SYSERRNO
SYSERRNO (Text -> CallStack -> ZooExInfo
ZooExInfo Text
desc CallStack
stack)
| Bool
otherwise =
let codeBS :: Text
codeBS = Text
"UNKNOWN_ERR: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Bytes -> Text
Bytes -> Text
T.validate (CInt -> Bytes
forall a. Print a => a -> Bytes
T.toUTF8Bytes CInt
code)
in UNKNOWN_ERR -> IO a
forall e a. Exception e => e -> IO a
E.throwIO (UNKNOWN_ERR -> IO a) -> UNKNOWN_ERR -> IO a
forall a b. (a -> b) -> a -> b
$ ZooExInfo -> UNKNOWN_ERR
UNKNOWN_ERR (Text -> CallStack -> ZooExInfo
ZooExInfo Text
codeBS CallStack
stack)
throwZooErrorIfNotOK :: HasCallStack => CInt -> IO CInt
throwZooErrorIfNotOK :: CInt -> IO CInt
throwZooErrorIfNotOK CInt
code
| CInt
code CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0 = CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
0
| Bool
otherwise = CInt -> CallStack -> IO CInt
forall a. CInt -> CallStack -> IO a
throwZooError CInt
code CallStack
HasCallStack => CallStack
callStack
throwZooErrorIfLeft :: HasCallStack => Either CInt a -> IO a
throwZooErrorIfLeft :: Either CInt a -> IO a
throwZooErrorIfLeft (Left CInt
rc) = CInt -> CallStack -> IO a
forall a. CInt -> CallStack -> IO a
throwZooError CInt
rc CallStack
HasCallStack => CallStack
callStack
throwZooErrorIfLeft (Right a
x) = a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
throwZooErrorIfLeft' :: HasCallStack => (CInt -> Bool) -> Either CInt a -> IO (Maybe a)
throwZooErrorIfLeft' :: (CInt -> Bool) -> Either CInt a -> IO (Maybe a)
throwZooErrorIfLeft' CInt -> Bool
cond (Left CInt
rc) = if CInt -> Bool
cond CInt
rc then Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing else CInt -> CallStack -> IO (Maybe a)
forall a. CInt -> CallStack -> IO a
throwZooError CInt
rc CallStack
HasCallStack => CallStack
callStack
throwZooErrorIfLeft' CInt -> Bool
_ (Right a
x) = Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> IO (Maybe a)) -> Maybe a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
x
foreign import ccall unsafe "hs_zk.h zerror"
c_zerror :: CInt -> IO CString
foreign import ccall unsafe "HsBase.h __hscore_get_errno"
getCErrNum :: IO CInt