    {-# LANGUAGE IncoherentInstances #-}
    {-# LANGUAGE RoleAnnotations     #-}

    {-# OPTIONS_GHC -Wno-unused-binds #-}
    {-# OPTIONS_GHC -Wno-redundant-constraints #-}

    -- | Checked exceptions
    module Hackage.Security.Util.Checked (
        Throws
      , unthrow
        -- ** Base exceptions
      , throwChecked
      , catchChecked
      , handleChecked
      , tryChecked
      , checkIO
      , throwUnchecked
      , internalError
      ) where

    import Prelude
    import Control.Exception (Exception, IOException)
    import qualified Control.Exception as Base

    import GHC.Prim (coerce)

    {-------------------------------------------------------------------------------
      Basic infrastructure
    -------------------------------------------------------------------------------}

    -- | Checked exceptions
    class Throws e where

    type role Throws representational

    unthrow :: forall a e proxy . proxy e -> (Throws e => a) -> a
    unthrow :: forall a e (proxy :: * -> *). proxy e -> (Throws e => a) -> a
    unthrow proxy e
    _ Throws e => a
    x = Wrap (Catch e) a -> Throws (Catch e) => a
    forall e a. Wrap e a -> Throws e => a
    unWrap (Wrap e a -> Wrap (Catch e) a
    forall e a. Wrap e a -> Wrap (Catch e) a
    coerceWrap ((Throws e => a) -> Wrap e a
    forall e a. (Throws e => a) -> Wrap e a
    Wrap a
    Throws e => a
    x :: Wrap e a))

    {-------------------------------------------------------------------------------
      Base exceptions
    -------------------------------------------------------------------------------}

    -- | Determine if an exception is asynchronous, based on its type.
    isAsync :: Exception e => e -> Bool
    isAsync :: forall e. Exception e => e -> Bool
    isAsync e
    e =
      case SomeException -> Maybe SomeAsyncException
    forall e. Exception e => SomeException -> Maybe e
    Base.fromException (SomeException -> Maybe SomeAsyncException)
    -> SomeException -> Maybe SomeAsyncException
    forall a b. (a -> b) -> a -> b
    $ e -> SomeException
    forall e. Exception e => e -> SomeException
    Base.toException e
    e of
        Just Base.SomeAsyncException{} -> Bool
    True
        Maybe SomeAsyncException
    Nothing -> Bool
    False

    -- | 'Base.catch', but immediately rethrows asynchronous exceptions
    -- (as determined by 'isAsync').
    catchSync :: Exception e => IO a -> (e -> IO a) -> IO a
    catchSync :: forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    catchSync IO a
    act e -> IO a
    onErr = IO a
    act IO a -> (e -> IO a) -> IO a
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `Base.catch` \e
    e ->
      if e -> Bool
    forall e. Exception e => e -> Bool
    isAsync e
    e
        then e -> IO a
    forall e a. (HasCallStack, Exception e) => e -> IO a
    Base.throwIO e
    e
        else e -> IO a
    onErr e
    e

    -- | Wraps up an async exception as a synchronous exception.
    newtype SyncException = SyncException Base.SomeException
      deriving (Int -> SyncException -> ShowS
    [SyncException] -> ShowS
    SyncException -> String
    (Int -> SyncException -> ShowS)
    -> (SyncException -> String)
    -> ([SyncException] -> ShowS)
    -> Show SyncException
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> SyncException -> ShowS
    showsPrec :: Int -> SyncException -> ShowS
    $cshow :: SyncException -> String
    show :: SyncException -> String
    $cshowList :: [SyncException] -> ShowS
    showList :: [SyncException] -> ShowS
    Show)
    instance Exception SyncException

    -- | Throw a checked exception
    throwChecked :: (Exception e, Throws e) => e -> IO a
    throwChecked :: forall e a. (Exception e, Throws e) => e -> IO a
    throwChecked e
    e
      | e -> Bool
    forall e. Exception e => e -> Bool
    isAsync e
    e = SyncException -> IO a
    forall e a. (HasCallStack, Exception e) => e -> IO a
    Base.throwIO (SyncException -> IO a) -> SyncException -> IO a
    forall a b. (a -> b) -> a -> b
    $ SomeException -> SyncException
    SyncException (SomeException -> SyncException) -> SomeException -> SyncException
    forall a b. (a -> b) -> a -> b
    $ e -> SomeException
    forall e. Exception e => e -> SomeException
    Base.toException e
    e
      | Bool
    otherwise = e -> IO a
    forall e a. (HasCallStack, Exception e) => e -> IO a
    Base.throwIO e
    e

    -- | Catch a checked exception
    catchChecked :: forall a e. Exception e
                 => (Throws e => IO a) -> (e -> IO a) -> IO a
    catchChecked :: forall a e.
    Exception e =>
    (Throws e => IO a) -> (e -> IO a) -> IO a
    catchChecked Throws e => IO a
    act = IO a -> (e -> IO a) -> IO a
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    catchSync (Proxy e -> (Throws e => IO a) -> IO a
    forall a e (proxy :: * -> *). proxy e -> (Throws e => a) -> a
    unthrow (Proxy e
    forall a. Proxy a
    Proxy :: Proxy e) IO a
    Throws e => IO a
    act)

    -- | 'catchChecked' with the arguments reversed
    handleChecked :: Exception e => (e -> IO a) -> (Throws e => IO a) -> IO a
    handleChecked :: forall e a.
    Exception e =>
    (e -> IO a) -> (Throws e => IO a) -> IO a
    handleChecked e -> IO a
    act Throws e => IO a
    handler = (Throws e => IO a) -> (e -> IO a) -> IO a
    forall a e.
    Exception e =>
    (Throws e => IO a) -> (e -> IO a) -> IO a
    catchChecked IO a
    Throws e => IO a
    handler e -> IO a
    act

    -- | Like 'try', but for checked exceptions
    tryChecked :: Exception e => (Throws e => IO a) -> IO (Either e a)
    tryChecked :: forall e a. Exception e => (Throws e => IO a) -> IO (Either e a)
    tryChecked Throws e => IO a
    act = (Throws e => IO (Either e a))
    -> (e -> IO (Either e a)) -> IO (Either e a)
    forall a e.
    Exception e =>
    (Throws e => IO a) -> (e -> IO a) -> IO a
    catchChecked (a -> Either e a
    forall a b. b -> Either a b
    Right (a -> Either e a) -> IO a -> IO (Either e a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO a
    Throws e => IO a
    act) (Either e a -> IO (Either e a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either e a -> IO (Either e a))
    -> (e -> Either e a) -> e -> IO (Either e a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . e -> Either e a
    forall a b. a -> Either a b
    Left)

    -- | Rethrow IO exceptions as checked exceptions
    checkIO :: Throws IOException => IO a -> IO a
    checkIO :: forall a. Throws IOException => IO a -> IO a
    checkIO = (IOException -> IO a) -> IO a -> IO a
    forall e a. Exception e => (e -> IO a) -> IO a -> IO a
    Base.handle ((IOException -> IO a) -> IO a -> IO a)
    -> (IOException -> IO a) -> IO a -> IO a
    forall a b. (a -> b) -> a -> b
    $ \(IOException
    ex :: IOException) -> IOException -> IO a
    forall e a. (Exception e, Throws e) => e -> IO a
    throwChecked IOException
    ex

    -- | Throw an unchecked exception
    --
    -- This is just an alias for 'throw', but makes it evident that this is a very
    -- intentional use of an unchecked exception.
    throwUnchecked :: Exception e => e -> IO a
    throwUnchecked :: forall e a. Exception e => e -> IO a
    throwUnchecked = e -> IO a
    forall e a. (HasCallStack, Exception e) => e -> IO a
    Base.throwIO

    -- | Variation on 'throwUnchecked' for internal errors
    internalError :: String -> IO a
    internalError :: forall a. String -> IO a
    internalError = IOException -> IO a
    forall e a. Exception e => e -> IO a
    throwUnchecked (IOException -> IO a) -> (String -> IOException) -> String -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> IOException
    userError

    {-------------------------------------------------------------------------------
      Auxiliary definitions (not exported)
    -------------------------------------------------------------------------------}

    -- | Wrap an action that may throw a checked exception
    --
    -- This is used internally in 'unthrow' to avoid impredicative
    -- instantiation of the type of 'coerce'/'unsafeCoerce'.
    newtype Wrap e a = Wrap { forall e a. Wrap e a -> Throws e => a
    unWrap :: Throws e => a }

    coerceWrap :: Wrap e a -> Wrap (Catch e) a
    coerceWrap :: forall e a. Wrap e a -> Wrap (Catch e) a
    coerceWrap = Wrap e a -> Wrap (Catch e) a
    forall a b. Coercible a b => a -> b
    coerce

    data Proxy a = Proxy

    newtype Catch a = Catch a
    instance Throws (Catch e) where