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
Hide 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
...
@@ -29,6 +29,7 @@ import qualified Data.Text as T
import
qualified
Servant.Client
as
C
import
qualified
Servant.Client
as
C
import
qualified
Servant.Job.Async
as
SJ
import
qualified
Servant.Job.Async
as
SJ
import
qualified
Servant.Job.Client
as
SJ
import
qualified
Servant.Job.Client
as
SJ
import
qualified
Servant.Job.Core
as
SJ
import
qualified
Servant.Job.Types
as
SJ
import
qualified
Servant.Job.Types
as
SJ
serveJobsAPI
serveJobsAPI
...
@@ -65,7 +66,7 @@ serveJobAPI t joberr jid' = wrap' (killJob t)
...
@@ -65,7 +66,7 @@ serveJobAPI t joberr jid' = wrap' (killJob t)
->
m
a
->
m
a
wrap
g
=
do
wrap
g
=
do
jid
<-
handleIDError
joberr
(
checkJID
jid'
)
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
g
jid
job
wrap'
g
limit
offset
=
wrap
(
g
limit
offset
)
wrap'
g
limit
offset
=
wrap
(
g
limit
offset
)
...
...
src/Gargantext/Utils/Jobs/Monad.hs
View file @
b313927a
...
@@ -112,10 +112,13 @@ findJob jid = do
...
@@ -112,10 +112,13 @@ findJob jid = do
liftIO
$
lookupJob
jid
jmap
liftIO
$
lookupJob
jid
jmap
data
JobError
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
|
InvalidMacID
T
.
Text
|
UnknownJob
|
UnknownJob
Int
|
JobException
SomeException
|
JobException
SomeException
deriving
Show
deriving
Show
...
@@ -126,8 +129,8 @@ checkJID
...
@@ -126,8 +129,8 @@ checkJID
checkJID
(
SJ
.
PrivateID
tn
n
t
d
)
=
do
checkJID
(
SJ
.
PrivateID
tn
n
t
d
)
=
do
now
<-
liftIO
getCurrentTime
now
<-
liftIO
getCurrentTime
js
<-
getJobsSettings
js
<-
getJobsSettings
if
|
tn
/=
"job"
->
pure
(
Left
InvalidIDType
)
if
|
tn
/=
"job"
->
pure
(
Left
$
InvalidIDType
$
T
.
pack
tn
)
|
now
>
addUTCTime
(
fromIntegral
$
jsIDTimeout
js
)
t
->
pure
(
Left
IDExpired
)
|
now
>
addUTCTime
(
fromIntegral
$
jsIDTimeout
js
)
t
->
pure
(
Left
$
IDExpired
n
)
|
d
/=
SJ
.
macID
tn
(
jsSecretKey
js
)
t
n
->
pure
(
Left
$
InvalidMacID
$
T
.
pack
d
)
|
d
/=
SJ
.
macID
tn
(
jsSecretKey
js
)
t
n
->
pure
(
Left
$
InvalidMacID
$
T
.
pack
d
)
|
otherwise
->
pure
$
Right
(
SJ
.
PrivateID
tn
n
t
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