1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
|
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module ServerErrors where
import Control.Exception (Exception)
import Control.Monad.Logger (MonadLogger, logError, logWarn)
import Data.ByteString.Lazy qualified as Bytes.Lazy
import Data.Error.Tree
import Network.HTTP.Types qualified as Http
import PossehlAnalyticsPrelude
data ServerError = ServerError
{ status :: Http.Status,
errBody :: Bytes.Lazy.ByteString
}
deriving stock (Show)
deriving anyclass (Exception)
emptyServerError :: Http.Status -> ServerError
emptyServerError status = ServerError {status, errBody = ""}
-- | Throw a user error.
--
-- “User” here is a client using our API, not a human user.
-- So we throw a `HTTP 400` error, which means the API was used incorrectly.
--
-- We also log the error as a warning, because it probably signifies a programming bug in our client.
--
-- If you need to display a message to a human user, return a `FrontendResponse`
-- or a structured type with translation keys (so we can localize the errors).
throwUserError ::
(MonadLogger m, MonadThrow m) =>
-- | The error to log & throw to the user
Error ->
m b
throwUserError err = do
-- TODO: should we make this into a macro to keep the line numbers?
$logWarn (err & errorContext "There was a “user holding it wrong” error, check the client code" & prettyError)
throwM
ServerError
{ status = Http.badRequest400,
errBody = err & prettyError & textToBytesUtf8 & toLazyBytes
}
-- | Throw a user error.
--
-- “User” here is a client using our API, not a human user.
-- So we throw a `HTTP 400` error, which means the API was used incorrectly.
--
-- We also log the error as a warning, because it probably signifies a programming bug in our client.
--
-- If you need to display a message to a human user, return a `FrontendResponse`
-- or a structured type with translation keys (so we can localize the errors).
throwUserErrorTree ::
(MonadLogger m, MonadThrow m) =>
-- | The error to log & throw to the user
ErrorTree ->
m b
throwUserErrorTree err = do
-- TODO: should we make this into a macro to keep the line numbers?
$logWarn (err & nestedError "There was a “user holding it wrong” error, check the client code" & prettyErrorTree)
throwM
ServerError
{ status = Http.badRequest400,
errBody = err & prettyErrorTree & textToBytesUtf8 & toLazyBytes
}
-- | Unwrap the `Either` and if `Left` throw a user error.
--
-- Intended to use in a pipeline, e.g.:
--
-- @@
-- doSomething
-- >>= orUserError "Oh no something did not work"
-- >>= doSomethingElse
-- @@
--
-- “User” here is a client using our API, not a human user.
-- So we throw a `HTTP 400` error, which means the API was used incorrectly.
--
-- We also log the error as a warning, because it probably signifies a programming bug in our client.
--
-- If you need to display a message to a human user, return a `FrontendResponse`
-- or a structured type with translation keys (so we can localize the errors).
orUserError ::
(MonadThrow m, MonadLogger m) =>
-- | The message to add as a context to the error being thrown
Text ->
-- | Result to unwrap and potentially throw
Either Error a ->
m a
orUserError outerMsg eErrA =
orUserErrorTree outerMsg (first singleError eErrA)
-- | Unwrap the `Either` and if `Left` throw a user error. Will pretty-print the 'ErrorTree'
--
-- Intended to use in a pipeline, e.g.:
--
-- @@
-- doSomething
-- >>= orUserErrorTree "Oh no something did not work"
-- >>= doSomethingElse
-- @@
--
-- “User” here is a client using our API, not a human user.
-- So we throw a `HTTP 400` error, which means the API was used incorrectly.
--
-- We also log the error as a warning, because it probably signifies a programming bug in our client.
--
-- If you need to display a message to a human user, return a `FrontendResponse`
-- or a structured type with translation keys (so we can localize the errors).
orUserErrorTree ::
(MonadThrow m, MonadLogger m) =>
-- | The message to add as a context to the 'ErrorTree' being thrown
Text ->
-- | Result to unwrap and potentially throw
Either ErrorTree a ->
m a
orUserErrorTree outerMsg = \case
Right a -> pure a
Left err -> do
-- TODO: this outer message should probably be added as a separate root instead of adding to the root error?
let tree = errorTreeContext outerMsg err
-- TODO: should we make this into a macro to keep the line numbers?
$logWarn (errorTreeContext "There was a “user holding it wrong” error, check the client code" tree & prettyErrorTree)
throwM
ServerError
{ status = Http.badRequest400,
errBody = tree & prettyErrorTree & textToBytesUtf8 & toLazyBytes
}
-- | Throw an internal error.
--
-- “Internal” here means some assertion that we depend on failed,
-- e.g. some database request returned a wrong result/number of results
-- or some invariant that we expect to hold failed.
--
-- This prints the full error to the log,
-- and returns a “HTTP 500” error without the message.
--
-- If you want to signify a mishandling of the API (e.g. a wrong request), throw a `userError`.
-- If you need to display a message to a human user, return a `FrontendResponse`
-- or a structured type with translation keys (so we can localize the errors).
throwInternalError ::
(MonadLogger m, MonadThrow m) =>
-- | The error to log internally
Error ->
m b
throwInternalError err = do
-- TODO: should we make this into a macro to keep the line numbers?
$logError
(err & prettyError)
throwM $ emptyServerError Http.internalServerError500
-- | Throw an internal error.
--
-- “Internal” here means some assertion that we depend on failed,
-- e.g. some database request returned a wrong result/number of results
-- or some invariant that we expect to hold failed.
--
-- This prints the full error to the log,
-- and returns a “HTTP 500” error without the message.
--
-- If you want to signify a mishandling of the API (e.g. a wrong request), throw a `userError`.
-- If you need to display a message to a human user, return a `FrontendResponse`
-- or a structured type with translation keys (so we can localize the errors).
throwInternalErrorTree ::
(MonadLogger m, MonadThrow m) =>
-- | The error to log internally
ErrorTree ->
m b
throwInternalErrorTree err = do
-- TODO: should we make this into a macro to keep the line numbers?
$logError
(err & prettyErrorTree)
throwM $ emptyServerError Http.internalServerError500
-- | Unwrap the `Either` and if `Left` throw an internal error.
--
-- Intended to use in a pipeline, e.g.:
--
-- @@
-- doSomething
-- >>= orInternalError "Oh no something did not work"
-- >>= doSomethingElse
-- @@
--
-- “Internal” here means some assertion that we depend on failed,
-- e.g. some database request returned a wrong result/number of results
-- or some invariant that we expect to hold failed.
--
-- This prints the full error to the log,
-- and returns a “HTTP 500” error without the message.
--
-- If you want to signify a mishandling of the API (e.g. a wrong request), throw a `userError`.
-- If you need to display a message to a human user, return a `FrontendResponse`
-- or a structured type with translation keys (so we can localize the errors).
orInternalError ::
(MonadThrow m, MonadLogger m) =>
-- | The message to add as a context to the error being thrown
Text ->
-- | Result to unwrap and potentially throw
Either Error a ->
m a
orInternalError outerMsg eErrA = orInternalErrorTree outerMsg (first singleError eErrA)
-- | Unwrap the `Either` and if `Left` throw an internal error. Will pretty-print the 'ErrorTree'.
--
-- Intended to use in a pipeline, e.g.:
--
-- @@
-- doSomething
-- >>= orInternalErrorTree "Oh no something did not work"
-- >>= doSomethingElse
-- @@
--
-- “Internal” here means some assertion that we depend on failed,
-- e.g. some database request returned a wrong result/number of results
-- or some invariant that we expect to hold failed.
--
-- This prints the full error to the log,
-- and returns a “HTTP 500” error without the message.
--
-- If you want to signify a mishandling of the API (e.g. a wrong request), throw a `userError`.
-- If you need to display a message to a human user, return a `FrontendResponse`
-- or a structured type with translation keys (so we can localize the errors).
orInternalErrorTree ::
(MonadThrow m, MonadLogger m) =>
-- | The message to add as a context to the 'ErrorTree' being thrown
Text ->
-- | Result to unwrap and potentially throw
Either ErrorTree a ->
m a
orInternalErrorTree outerMsg = \case
Right a -> pure a
Left err -> do
-- TODO: this outer message should probably be added as a separate root instead of adding to the root error?
let tree = errorTreeContext outerMsg err
-- TODO: should we make this into a macro to keep the line numbers?
$logError (tree & prettyErrorTree)
throwM $ emptyServerError Http.internalServerError500
|
