{-# LANGUAGE ImplicitParams #-}

-- | Sqlite exception utils.
module Unison.Sqlite.Exception
  ( -- * @SomeSqliteException@
    SomeSqliteException (..),
    isCantOpenException,

    -- ** @SqliteConnectException@
    SqliteConnectException (..),
    rethrowAsSqliteConnectException,

    -- ** @SqliteQueryException@
    SqliteQueryException (..),
    pattern SqliteBusyException,
    isSqliteBusyException,
    SqliteQueryExceptionInfo (..),
    throwSqliteQueryException,
    SomeSqliteExceptionReason (..),
    SqliteExceptionReason,
  )
where

import Control.Concurrent (ThreadId, myThreadId)
import Data.Typeable (cast)
import Database.SQLite.Simple qualified as Sqlite
import GHC.Stack (CallStack)
import GHC.Stack qualified as Stack
import Unison.Prelude
import Unison.Sqlite.Connection.Internal (Connection)
import Unison.Sqlite.Sql (Sql (..))
import UnliftIO.Exception

------------------------------------------------------------------------------------------------------------------------
-- SomeSqliteException

-- | The root exception for all exceptions thrown by this library.
--
-- @
-- SomeException (from base)
--   └── SomeSqliteException
--         └── SqliteConnectException
--         └── SqliteQueryException
-- @
--
-- A @SomeSqliteException@ should not be inspected or used for control flow when run in a trusted environment, where the
-- database can be assumed to be uncorrupt. Rather, wherever possible, the user of this library should write code that
-- is guaranteed not to throw exceptions, by checking the necessary preconditions first. If that is not possible, it
-- should be considered a bug in this library.
--
-- When actions are run on an untrusted codebase, e.g. one downloaded from a remote server, it is sufficient to catch
-- just one exception type, @SomeSqliteException@.
data SomeSqliteException
  = forall e. (Exception e) => SomeSqliteException e
  deriving anyclass (Show SomeSqliteException
Typeable SomeSqliteException
(Typeable SomeSqliteException, Show SomeSqliteException) =>
(SomeSqliteException -> SomeException)
-> (SomeException -> Maybe SomeSqliteException)
-> (SomeSqliteException -> String)
-> Exception SomeSqliteException
SomeException -> Maybe SomeSqliteException
SomeSqliteException -> String
SomeSqliteException -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: SomeSqliteException -> SomeException
toException :: SomeSqliteException -> SomeException
$cfromException :: SomeException -> Maybe SomeSqliteException
fromException :: SomeException -> Maybe SomeSqliteException
$cdisplayException :: SomeSqliteException -> String
displayException :: SomeSqliteException -> String
Exception)

instance Show SomeSqliteException where
  show :: SomeSqliteException -> String
show (SomeSqliteException e
e) = e -> String
forall a. Show a => a -> String
show e
e

isCantOpenException :: SomeSqliteException -> Bool
isCantOpenException :: SomeSqliteException -> Bool
isCantOpenException (SomeSqliteException e
exception) =
  case e -> Maybe SqliteConnectException
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
exception of
    Just SqliteConnectException {$sel:exception:SqliteConnectException :: SqliteConnectException -> SQLError
exception = Sqlite.SQLError Error
Sqlite.ErrorCan'tOpen Text
_ Text
_} -> Bool
True
    Maybe SqliteConnectException
_ -> Bool
False

------------------------------------------------------------------------------------------------------------------------
-- SomeSqliteException
--   └── SqliteConnectException

-- | An exception thrown during establishing a connection.
data SqliteConnectException = SqliteConnectException
  { SqliteConnectException -> ThreadId
threadId :: ThreadId,
    SqliteConnectException -> String
name :: String,
    SqliteConnectException -> String
file :: FilePath,
    SqliteConnectException -> SQLError
exception :: Sqlite.SQLError
  }
  deriving stock (Int -> SqliteConnectException -> ShowS
[SqliteConnectException] -> ShowS
SqliteConnectException -> String
(Int -> SqliteConnectException -> ShowS)
-> (SqliteConnectException -> String)
-> ([SqliteConnectException] -> ShowS)
-> Show SqliteConnectException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SqliteConnectException -> ShowS
showsPrec :: Int -> SqliteConnectException -> ShowS
$cshow :: SqliteConnectException -> String
show :: SqliteConnectException -> String
$cshowList :: [SqliteConnectException] -> ShowS
showList :: [SqliteConnectException] -> ShowS
Show)

instance Exception SqliteConnectException where
  toException :: SqliteConnectException -> SomeException
toException = SomeSqliteException -> SomeException
forall e. Exception e => e -> SomeException
toException (SomeSqliteException -> SomeException)
-> (SqliteConnectException -> SomeSqliteException)
-> SqliteConnectException
-> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqliteConnectException -> SomeSqliteException
forall e. Exception e => e -> SomeSqliteException
SomeSqliteException
  fromException :: SomeException -> Maybe SqliteConnectException
fromException = SomeException -> Maybe SomeSqliteException
forall e. Exception e => SomeException -> Maybe e
fromException (SomeException -> Maybe SomeSqliteException)
-> (SomeSqliteException -> Maybe SqliteConnectException)
-> SomeException
-> Maybe SqliteConnectException
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \(SomeSqliteException e
e) -> e -> Maybe SqliteConnectException
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e

rethrowAsSqliteConnectException :: String -> FilePath -> Sqlite.SQLError -> IO a
rethrowAsSqliteConnectException :: forall a. String -> String -> SQLError -> IO a
rethrowAsSqliteConnectException String
name String
file SQLError
exception = do
  ThreadId
threadId <- IO ThreadId
myThreadId
  SqliteConnectException -> IO a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO SqliteConnectException {SQLError
$sel:exception:SqliteConnectException :: SQLError
exception :: SQLError
exception, String
$sel:file:SqliteConnectException :: String
file :: String
file, String
$sel:name:SqliteConnectException :: String
name :: String
name, ThreadId
$sel:threadId:SqliteConnectException :: ThreadId
threadId :: ThreadId
threadId}

------------------------------------------------------------------------------------------------------------------------
-- SomeSqliteException
--   └── SqliteQueryException

-- | A @SqliteQueryException@ represents an exception thrown during processing a query, paired with some context that
-- resulted in the exception.
--
-- A @SqliteQueryException@ may result from a number of different conditions:
--
-- * The underlying sqlite library threw an exception.
-- * A postcondition violation of a function like 'Unison.Sqlite.queryMaybeRow', which asserts that the resulting
--   relation will have certain number of rows,
-- * A postcondition violation of a function like 'Unison.Sqlite.queryListRowCheck', which takes a user-defined check as
--   an argument.
--
-- A @SqliteQueryException@ should not be inspected or used for control flow when run in a trusted environment, where
-- the database can be assumed to be uncorrupt. Rather, wherever possible, the user of this library should write code
-- that is guaranteed not to throw exceptions, by checking the necessary preconditions first. If that is not possible,
-- it should be considered a bug in this library.
--
-- When actions are run on an untrusted codebase, e.g. one downloaded from a remote server, it is sufficient to catch
-- just one exception type, @SqliteQueryException@.
data SqliteQueryException = SqliteQueryException
  { SqliteQueryException -> Text
sql :: Text,
    SqliteQueryException -> [SQLData]
params :: [Sqlite.SQLData],
    -- | The inner exception. It is intentionally not 'SomeException', so that calling code cannot accidentally
    -- 'throwIO' domain-specific exception types, but must instead use a @*Check@ query variant.
    SqliteQueryException -> SomeSqliteExceptionReason
exception :: SomeSqliteExceptionReason,
    SqliteQueryException -> CallStack
callStack :: CallStack,
    SqliteQueryException -> Connection
connection :: Connection,
    SqliteQueryException -> ThreadId
threadId :: ThreadId
  }
  deriving stock (Int -> SqliteQueryException -> ShowS
[SqliteQueryException] -> ShowS
SqliteQueryException -> String
(Int -> SqliteQueryException -> ShowS)
-> (SqliteQueryException -> String)
-> ([SqliteQueryException] -> ShowS)
-> Show SqliteQueryException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SqliteQueryException -> ShowS
showsPrec :: Int -> SqliteQueryException -> ShowS
$cshow :: SqliteQueryException -> String
show :: SqliteQueryException -> String
$cshowList :: [SqliteQueryException] -> ShowS
showList :: [SqliteQueryException] -> ShowS
Show)

instance Exception SqliteQueryException where
  toException :: SqliteQueryException -> SomeException
toException = SomeSqliteException -> SomeException
forall e. Exception e => e -> SomeException
toException (SomeSqliteException -> SomeException)
-> (SqliteQueryException -> SomeSqliteException)
-> SqliteQueryException
-> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqliteQueryException -> SomeSqliteException
forall e. Exception e => e -> SomeSqliteException
SomeSqliteException
  fromException :: SomeException -> Maybe SqliteQueryException
fromException = SomeException -> Maybe SomeSqliteException
forall e. Exception e => SomeException -> Maybe e
fromException (SomeException -> Maybe SomeSqliteException)
-> (SomeSqliteException -> Maybe SqliteQueryException)
-> SomeException
-> Maybe SqliteQueryException
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \(SomeSqliteException e
e) -> e -> Maybe SqliteQueryException
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e

pattern SqliteBusyException :: SqliteQueryException
pattern $mSqliteBusyException :: forall {r}.
SqliteQueryException -> ((# #) -> r) -> ((# #) -> r) -> r
SqliteBusyException <- (isSqliteBusyException -> True)

isSqliteBusyException :: SqliteQueryException -> Bool
isSqliteBusyException :: SqliteQueryException -> Bool
isSqliteBusyException SqliteQueryException {$sel:exception:SqliteQueryException :: SqliteQueryException -> SomeSqliteExceptionReason
exception = SomeSqliteExceptionReason e
reason} =
  case e -> Maybe SQLError
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
reason of
    Just (Sqlite.SQLError Error
Sqlite.ErrorBusy Text
_ Text
_) -> Bool
True
    Maybe SQLError
_ -> Bool
False

data SqliteQueryExceptionInfo = SqliteQueryExceptionInfo
  { SqliteQueryExceptionInfo -> Connection
connection :: Connection,
    SqliteQueryExceptionInfo -> Sql
sql :: Sql,
    SqliteQueryExceptionInfo -> SomeSqliteExceptionReason
exception :: SomeSqliteExceptionReason
  }

throwSqliteQueryException :: (HasCallStack) => SqliteQueryExceptionInfo -> IO a
throwSqliteQueryException :: forall a. HasCallStack => SqliteQueryExceptionInfo -> IO a
throwSqliteQueryException SqliteQueryExceptionInfo {Connection
$sel:connection:SqliteQueryExceptionInfo :: SqliteQueryExceptionInfo -> Connection
connection :: Connection
connection, SomeSqliteExceptionReason
$sel:exception:SqliteQueryExceptionInfo :: SqliteQueryExceptionInfo -> SomeSqliteExceptionReason
exception :: SomeSqliteExceptionReason
exception, $sel:sql:SqliteQueryExceptionInfo :: SqliteQueryExceptionInfo -> Sql
sql = Sql Text
sql [SQLData]
params} = do
  ThreadId
threadId <- IO ThreadId
myThreadId
  SqliteQueryException -> IO a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO
    SqliteQueryException
      { Text
$sel:sql:SqliteQueryException :: Text
sql :: Text
sql,
        [SQLData]
$sel:params:SqliteQueryException :: [SQLData]
params :: [SQLData]
params,
        SomeSqliteExceptionReason
$sel:exception:SqliteQueryException :: SomeSqliteExceptionReason
exception :: SomeSqliteExceptionReason
exception,
        $sel:callStack:SqliteQueryException :: CallStack
callStack = CallStack
HasCallStack => CallStack
Stack.callStack,
        Connection
$sel:connection:SqliteQueryException :: Connection
connection :: Connection
connection,
        ThreadId
$sel:threadId:SqliteQueryException :: ThreadId
threadId :: ThreadId
threadId
      }

data SomeSqliteExceptionReason
  = forall e. (SqliteExceptionReason e) => SomeSqliteExceptionReason e
  deriving anyclass (Show SomeSqliteExceptionReason
Typeable SomeSqliteExceptionReason
(Show SomeSqliteExceptionReason,
 Typeable SomeSqliteExceptionReason) =>
SqliteExceptionReason SomeSqliteExceptionReason
forall e. (Show e, Typeable e) => SqliteExceptionReason e
SqliteExceptionReason)

instance Show SomeSqliteExceptionReason where
  show :: SomeSqliteExceptionReason -> String
show (SomeSqliteExceptionReason e
x) = e -> String
forall a. Show a => a -> String
show e
x

-- | A type that is intended to be used as additional context for a sqlite-related exception.
class (Show e, Typeable e) => SqliteExceptionReason e

instance SqliteExceptionReason Sqlite.SQLError

instance SqliteExceptionReason Void