-- | All the errors that the runtime can throw
module Aws.Lambda.Runtime.Error
  ( EnvironmentVariableNotSet (..),
    Parsing (..),
    Invocation (..),
  )
where

import Control.Exception.Safe
import Data.Aeson (ToJSON (..), object, (.=))
import qualified Data.ByteString.Lazy as LBS
import Data.Text (Text)

newtype EnvironmentVariableNotSet
  = EnvironmentVariableNotSet Text
  deriving (Int -> EnvironmentVariableNotSet -> ShowS
[EnvironmentVariableNotSet] -> ShowS
EnvironmentVariableNotSet -> String
(Int -> EnvironmentVariableNotSet -> ShowS)
-> (EnvironmentVariableNotSet -> String)
-> ([EnvironmentVariableNotSet] -> ShowS)
-> Show EnvironmentVariableNotSet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnvironmentVariableNotSet -> ShowS
showsPrec :: Int -> EnvironmentVariableNotSet -> ShowS
$cshow :: EnvironmentVariableNotSet -> String
show :: EnvironmentVariableNotSet -> String
$cshowList :: [EnvironmentVariableNotSet] -> ShowS
showList :: [EnvironmentVariableNotSet] -> ShowS
Show, Show EnvironmentVariableNotSet
Typeable EnvironmentVariableNotSet
(Typeable EnvironmentVariableNotSet,
 Show EnvironmentVariableNotSet) =>
(EnvironmentVariableNotSet -> SomeException)
-> (SomeException -> Maybe EnvironmentVariableNotSet)
-> (EnvironmentVariableNotSet -> String)
-> Exception EnvironmentVariableNotSet
SomeException -> Maybe EnvironmentVariableNotSet
EnvironmentVariableNotSet -> String
EnvironmentVariableNotSet -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: EnvironmentVariableNotSet -> SomeException
toException :: EnvironmentVariableNotSet -> SomeException
$cfromException :: SomeException -> Maybe EnvironmentVariableNotSet
fromException :: SomeException -> Maybe EnvironmentVariableNotSet
$cdisplayException :: EnvironmentVariableNotSet -> String
displayException :: EnvironmentVariableNotSet -> String
Exception)

instance ToJSON EnvironmentVariableNotSet where
  toJSON :: EnvironmentVariableNotSet -> Value
toJSON (EnvironmentVariableNotSet Text
msg) =
    [Pair] -> Value
object
      [ Key
"errorType" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"EnvironmentVariableNotSet" :: Text),
        Key
"errorMessage" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
msg
      ]

data Parsing = Parsing
  { Parsing -> Text
errorMessage :: Text,
    Parsing -> Text
actualValue :: Text,
    Parsing -> Text
valueName :: Text
  }
  deriving (Int -> Parsing -> ShowS
[Parsing] -> ShowS
Parsing -> String
(Int -> Parsing -> ShowS)
-> (Parsing -> String) -> ([Parsing] -> ShowS) -> Show Parsing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Parsing -> ShowS
showsPrec :: Int -> Parsing -> ShowS
$cshow :: Parsing -> String
show :: Parsing -> String
$cshowList :: [Parsing] -> ShowS
showList :: [Parsing] -> ShowS
Show, Show Parsing
Typeable Parsing
(Typeable Parsing, Show Parsing) =>
(Parsing -> SomeException)
-> (SomeException -> Maybe Parsing)
-> (Parsing -> String)
-> Exception Parsing
SomeException -> Maybe Parsing
Parsing -> String
Parsing -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: Parsing -> SomeException
toException :: Parsing -> SomeException
$cfromException :: SomeException -> Maybe Parsing
fromException :: SomeException -> Maybe Parsing
$cdisplayException :: Parsing -> String
displayException :: Parsing -> String
Exception)

instance ToJSON Parsing where
  toJSON :: Parsing -> Value
toJSON (Parsing Text
errorMessage Text
_ Text
valueName) =
    [Pair] -> Value
object
      [ Key
"errorType" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"Parsing" :: Text),
        Key
"errorMessage" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"Could not parse '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
valueName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"': " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
errorMessage)
      ]

newtype Invocation
  = Invocation LBS.ByteString
  deriving (Int -> Invocation -> ShowS
[Invocation] -> ShowS
Invocation -> String
(Int -> Invocation -> ShowS)
-> (Invocation -> String)
-> ([Invocation] -> ShowS)
-> Show Invocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Invocation -> ShowS
showsPrec :: Int -> Invocation -> ShowS
$cshow :: Invocation -> String
show :: Invocation -> String
$cshowList :: [Invocation] -> ShowS
showList :: [Invocation] -> ShowS
Show, Show Invocation
Typeable Invocation
(Typeable Invocation, Show Invocation) =>
(Invocation -> SomeException)
-> (SomeException -> Maybe Invocation)
-> (Invocation -> String)
-> Exception Invocation
SomeException -> Maybe Invocation
Invocation -> String
Invocation -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: Invocation -> SomeException
toException :: Invocation -> SomeException
$cfromException :: SomeException -> Maybe Invocation
fromException :: SomeException -> Maybe Invocation
$cdisplayException :: Invocation -> String
displayException :: Invocation -> String
Exception)