{-# LINE 1 "src/Botan/Bindings/Error.hsc" #-}
{-|
Module      : Botan.Bindings.Error
Description : Error codes and exception handling
Copyright   : (c) Leo D, 2023
License     : BSD-3-Clause
Maintainer  : leo@apotheca.io
Stability   : experimental
Portability : POSIX

Error values below -10000 are reserved for the application (these can be returned from view functions).
-}

{-# LANGUAGE CApiFFI #-}

module Botan.Bindings.Error where

import Botan.Bindings.Prelude



pattern BOTAN_FFI_SUCCESS
    ,   BOTAN_FFI_INVALID_VERIFIER
    ,   BOTAN_FFI_ERROR_INVALID_INPUT
    ,   BOTAN_FFI_ERROR_BAD_MAC
    ,   BOTAN_FFI_ERROR_INSUFFICIENT_BUFFER_SPACE
    ,   BOTAN_FFI_ERROR_STRING_CONVERSION_ERROR
    ,   BOTAN_FFI_ERROR_EXCEPTION_THROWN
    ,   BOTAN_FFI_ERROR_OUT_OF_MEMORY
    ,   BOTAN_FFI_ERROR_SYSTEM_ERROR
    ,   BOTAN_FFI_ERROR_INTERNAL_ERROR
    ,   BOTAN_FFI_ERROR_BAD_FLAG
    ,   BOTAN_FFI_ERROR_NULL_POINTER
    ,   BOTAN_FFI_ERROR_BAD_PARAMETER
    ,   BOTAN_FFI_ERROR_KEY_NOT_SET
    ,   BOTAN_FFI_ERROR_INVALID_KEY_LENGTH
    ,   BOTAN_FFI_ERROR_INVALID_OBJECT_STATE
    ,   BOTAN_FFI_ERROR_NOT_IMPLEMENTED
    ,   BOTAN_FFI_ERROR_INVALID_OBJECT
    ,   BOTAN_FFI_ERROR_TLS_ERROR
    ,   BOTAN_FFI_ERROR_HTTP_ERROR
    ,   BOTAN_FFI_ERROR_ROUGHTIME_ERROR
    ,   BOTAN_FFI_ERROR_UNKNOWN_ERROR
    ::  (Eq a, Num a) => a

-- | Generally returned to indicate success
pattern $mBOTAN_FFI_SUCCESS :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bBOTAN_FFI_SUCCESS :: forall a. (Eq a, Num a) => a
BOTAN_FFI_SUCCESS = 0
{-# LINE 47 "src/Botan/Bindings/Error.hsc" #-}

-- | NOTE: this value is positive, but still represents an error condition. In indicates that the function completed successfully, but the value provided was not correct. For example botan_bcrypt_is_valid returns this value if the password did not match the hash.
pattern $mBOTAN_FFI_INVALID_VERIFIER :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bBOTAN_FFI_INVALID_VERIFIER :: forall a. (Eq a, Num a) => a
BOTAN_FFI_INVALID_VERIFIER = 1
{-# LINE 50 "src/Botan/Bindings/Error.hsc" #-}

-- | The input was invalid. (Currently this error return is not used.)
pattern $mBOTAN_FFI_ERROR_INVALID_INPUT :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bBOTAN_FFI_ERROR_INVALID_INPUT :: forall a. (Eq a, Num a) => a
BOTAN_FFI_ERROR_INVALID_INPUT = -1
{-# LINE 53 "src/Botan/Bindings/Error.hsc" #-}

-- | While decrypting in an AEAD mode, the tag failed to verify.
pattern $mBOTAN_FFI_ERROR_BAD_MAC :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bBOTAN_FFI_ERROR_BAD_MAC :: forall a. (Eq a, Num a) => a
BOTAN_FFI_ERROR_BAD_MAC = -2
{-# LINE 56 "src/Botan/Bindings/Error.hsc" #-}

-- | Functions which write a variable amount of space return this if the indicated buffer length was insufficient to write the data. In that case, the output length parameter is set to the size that is required.
pattern $mBOTAN_FFI_ERROR_INSUFFICIENT_BUFFER_SPACE :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bBOTAN_FFI_ERROR_INSUFFICIENT_BUFFER_SPACE :: forall a. (Eq a, Num a) => a
BOTAN_FFI_ERROR_INSUFFICIENT_BUFFER_SPACE = -10
{-# LINE 59 "src/Botan/Bindings/Error.hsc" #-}

-- | A string view function which attempts to convert a string to a specified charset, and fails, can use this function to indicate the error.
pattern $mBOTAN_FFI_ERROR_STRING_CONVERSION_ERROR :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bBOTAN_FFI_ERROR_STRING_CONVERSION_ERROR :: forall a. (Eq a, Num a) => a
BOTAN_FFI_ERROR_STRING_CONVERSION_ERROR = -11
{-# LINE 62 "src/Botan/Bindings/Error.hsc" #-}

-- | An exception was thrown while processing this request, but no further details are available.
pattern $mBOTAN_FFI_ERROR_EXCEPTION_THROWN :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bBOTAN_FFI_ERROR_EXCEPTION_THROWN :: forall a. (Eq a, Num a) => a
BOTAN_FFI_ERROR_EXCEPTION_THROWN = -20
{-# LINE 65 "src/Botan/Bindings/Error.hsc" #-}

-- | Memory allocation failed
pattern $mBOTAN_FFI_ERROR_OUT_OF_MEMORY :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bBOTAN_FFI_ERROR_OUT_OF_MEMORY :: forall a. (Eq a, Num a) => a
BOTAN_FFI_ERROR_OUT_OF_MEMORY = -21
{-# LINE 68 "src/Botan/Bindings/Error.hsc" #-}

-- | A system call failed
pattern $mBOTAN_FFI_ERROR_SYSTEM_ERROR :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bBOTAN_FFI_ERROR_SYSTEM_ERROR :: forall a. (Eq a, Num a) => a
BOTAN_FFI_ERROR_SYSTEM_ERROR = -22
{-# LINE 71 "src/Botan/Bindings/Error.hsc" #-}

-- | An internal bug was encountered (please open a ticket on github)
pattern $mBOTAN_FFI_ERROR_INTERNAL_ERROR :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bBOTAN_FFI_ERROR_INTERNAL_ERROR :: forall a. (Eq a, Num a) => a
BOTAN_FFI_ERROR_INTERNAL_ERROR = -23
{-# LINE 74 "src/Botan/Bindings/Error.hsc" #-}

-- | A value provided in a flag variable was unknown.
pattern $mBOTAN_FFI_ERROR_BAD_FLAG :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bBOTAN_FFI_ERROR_BAD_FLAG :: forall a. (Eq a, Num a) => a
BOTAN_FFI_ERROR_BAD_FLAG = -30
{-# LINE 77 "src/Botan/Bindings/Error.hsc" #-}

-- | A null pointer was provided as an argument where that is not allowed.
pattern $mBOTAN_FFI_ERROR_NULL_POINTER :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bBOTAN_FFI_ERROR_NULL_POINTER :: forall a. (Eq a, Num a) => a
BOTAN_FFI_ERROR_NULL_POINTER = -31
{-# LINE 80 "src/Botan/Bindings/Error.hsc" #-}

-- | An argument did not match the function.
pattern $mBOTAN_FFI_ERROR_BAD_PARAMETER :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bBOTAN_FFI_ERROR_BAD_PARAMETER :: forall a. (Eq a, Num a) => a
BOTAN_FFI_ERROR_BAD_PARAMETER = -32
{-# LINE 83 "src/Botan/Bindings/Error.hsc" #-}

-- | An object that requires a key normally must be keyed before use (eg before encrypting or MACing data). If this is not done, the operation will fail and return this error code.
pattern $mBOTAN_FFI_ERROR_KEY_NOT_SET :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bBOTAN_FFI_ERROR_KEY_NOT_SET :: forall a. (Eq a, Num a) => a
BOTAN_FFI_ERROR_KEY_NOT_SET = -33
{-# LINE 86 "src/Botan/Bindings/Error.hsc" #-}

-- | An invalid key length was provided with a call to foo_set_key.
pattern $mBOTAN_FFI_ERROR_INVALID_KEY_LENGTH :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bBOTAN_FFI_ERROR_INVALID_KEY_LENGTH :: forall a. (Eq a, Num a) => a
BOTAN_FFI_ERROR_INVALID_KEY_LENGTH = -34
{-# LINE 89 "src/Botan/Bindings/Error.hsc" #-}

-- | An operation was invoked that makes sense for the object, but it is in the wrong state to perform it.
pattern $mBOTAN_FFI_ERROR_INVALID_OBJECT_STATE :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bBOTAN_FFI_ERROR_INVALID_OBJECT_STATE :: forall a. (Eq a, Num a) => a
BOTAN_FFI_ERROR_INVALID_OBJECT_STATE = -35
{-# LINE 92 "src/Botan/Bindings/Error.hsc" #-}

-- | This is returned if the functionality is not available for some reason. For example if you call botan_hash_init with a named hash function which is not enabled, this error is returned.
pattern $mBOTAN_FFI_ERROR_NOT_IMPLEMENTED :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bBOTAN_FFI_ERROR_NOT_IMPLEMENTED :: forall a. (Eq a, Num a) => a
BOTAN_FFI_ERROR_NOT_IMPLEMENTED = -40
{-# LINE 95 "src/Botan/Bindings/Error.hsc" #-}

-- | This is used if an object provided did not match the function. For example calling botan_hash_destroy on a botan_rng_t object will cause this error.
pattern $mBOTAN_FFI_ERROR_INVALID_OBJECT :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bBOTAN_FFI_ERROR_INVALID_OBJECT :: forall a. (Eq a, Num a) => a
BOTAN_FFI_ERROR_INVALID_OBJECT = -50
{-# LINE 98 "src/Botan/Bindings/Error.hsc" #-}

pattern $mBOTAN_FFI_ERROR_TLS_ERROR :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bBOTAN_FFI_ERROR_TLS_ERROR :: forall a. (Eq a, Num a) => a
BOTAN_FFI_ERROR_TLS_ERROR = -75
{-# LINE 100 "src/Botan/Bindings/Error.hsc" #-}
pattern BOTAN_FFI_ERROR_HTTP_ERROR = -76
{-# LINE 101 "src/Botan/Bindings/Error.hsc" #-}
pattern BOTAN_FFI_ERROR_ROUGHTIME_ERROR = -77
{-# LINE 102 "src/Botan/Bindings/Error.hsc" #-}

-- | Something bad happened, but we are not sure why or how.
pattern $mBOTAN_FFI_ERROR_UNKNOWN_ERROR :: forall {r} {a}.
(Eq a, Num a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bBOTAN_FFI_ERROR_UNKNOWN_ERROR :: forall a. (Eq a, Num a) => a
BOTAN_FFI_ERROR_UNKNOWN_ERROR = -100
{-# LINE 105 "src/Botan/Bindings/Error.hsc" #-}

foreign import capi safe "botan/ffi.h botan_error_description"
    botan_error_description
        :: CInt                -- ^ __err__
        -> IO (ConstPtr CChar)

foreign import capi safe "botan/ffi.h botan_error_last_exception_message"
    botan_error_last_exception_message
        :: IO (ConstPtr CChar)