Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
148
Issues
148
List
Board
Labels
Milestones
Merge Requests
7
Merge Requests
7
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
haskell-gargantext
Commits
b313927a
Commit
b313927a
authored
Nov 06, 2023
by
Alfredo Di Napoli
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Improve internal JobError type
parent
d0c5fec3
Changes
2
Show whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
10 additions
and
6 deletions
+10
-6
Internal.hs
src/Gargantext/Utils/Jobs/Internal.hs
+2
-1
Monad.hs
src/Gargantext/Utils/Jobs/Monad.hs
+8
-5
No files found.
src/Gargantext/Utils/Jobs/Internal.hs
View file @
b313927a
...
...
@@ -29,6 +29,7 @@ import qualified Data.Text as T
import
qualified
Servant.Client
as
C
import
qualified
Servant.Job.Async
as
SJ
import
qualified
Servant.Job.Client
as
SJ
import
qualified
Servant.Job.Core
as
SJ
import
qualified
Servant.Job.Types
as
SJ
serveJobsAPI
...
...
@@ -65,7 +66,7 @@ serveJobAPI t joberr jid' = wrap' (killJob t)
->
m
a
wrap
g
=
do
jid
<-
handleIDError
joberr
(
checkJID
jid'
)
job
<-
maybe
(
throwError
$
joberr
UnknownJob
)
pure
=<<
findJob
jid
job
<-
maybe
(
throwError
$
joberr
$
UnknownJob
(
SJ
.
_id_number
jid
)
)
pure
=<<
findJob
jid
g
jid
job
wrap'
g
limit
offset
=
wrap
(
g
limit
offset
)
...
...
src/Gargantext/Utils/Jobs/Monad.hs
View file @
b313927a
...
...
@@ -112,10 +112,13 @@ findJob jid = do
liftIO
$
lookupJob
jid
jmap
data
JobError
=
InvalidIDType
|
IDExpired
=
-- | We expected to find a job tagged internall as \"job\", but we found the input @T.Text@ instead.
InvalidIDType
T
.
Text
-- | The given ID expired.
|
IDExpired
Int
|
InvalidMacID
T
.
Text
|
UnknownJob
|
UnknownJob
Int
|
JobException
SomeException
deriving
Show
...
...
@@ -126,8 +129,8 @@ checkJID
checkJID
(
SJ
.
PrivateID
tn
n
t
d
)
=
do
now
<-
liftIO
getCurrentTime
js
<-
getJobsSettings
if
|
tn
/=
"job"
->
pure
(
Left
InvalidIDType
)
|
now
>
addUTCTime
(
fromIntegral
$
jsIDTimeout
js
)
t
->
pure
(
Left
IDExpired
)
if
|
tn
/=
"job"
->
pure
(
Left
$
InvalidIDType
$
T
.
pack
tn
)
|
now
>
addUTCTime
(
fromIntegral
$
jsIDTimeout
js
)
t
->
pure
(
Left
$
IDExpired
n
)
|
d
/=
SJ
.
macID
tn
(
jsSecretKey
js
)
t
n
->
pure
(
Left
$
InvalidMacID
$
T
.
pack
d
)
|
otherwise
->
pure
$
Right
(
SJ
.
PrivateID
tn
n
t
d
)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment