]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/API/Auth.hs
[API][AUTH] if authorized then id of tree is given (with token).
[gargantext.git] / src / Gargantext / API / Auth.hs
1 {-|
2 Module : Gargantext.API.Auth
3 Description : Server API Auth Module
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
8 Portability : POSIX
9
10 Main authorisation of Gargantext are managed in this module
11
12 -- 1: Implement the Server / Client JWT authentication
13 -> Client towards Python Backend
14 -> Server towards Purescript Front-End
15
16 -- 2: Implement the Auth API backend
17 https://github.com/haskell-servant/servant-auth
18
19 -}
20
21 {-# LANGUAGE NoImplicitPrelude #-}
22 {-# LANGUAGE DeriveGeneric #-}
23 {-# LANGUAGE DataKinds #-}
24 {-# LANGUAGE OverloadedStrings #-}
25 {-# LANGUAGE TemplateHaskell #-}
26
27 module Gargantext.API.Auth
28 where
29
30 import Data.Aeson.TH (deriveJSON)
31 import Data.List (elem)
32 import Data.Swagger
33 import Data.Text (Text, reverse)
34 import Database.PostgreSQL.Simple (Connection)
35 import GHC.Generics (Generic)
36 import Gargantext.Core.Utils.Prefix (unPrefix)
37 import Gargantext.Database.Node (getRootUsername)
38 import Gargantext.Database.Types.Node (NodePoly(_node_id))
39 import Gargantext.Prelude hiding (reverse)
40 import Test.QuickCheck (elements)
41 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
42
43 ---------------------------------------------------
44
45 -- | Main types for AUTH API
46 type Username = Text
47 type Password = Text
48
49 data AuthRequest = AuthRequest { _authReq_username :: Username
50 , _authReq_password :: Password
51 }
52 deriving (Generic)
53
54 data AuthResponse = AuthResponse { _authRes_valid :: Maybe AuthValid
55 , _authRes_inval :: Maybe AuthInvalid
56 }
57 deriving (Generic)
58
59 data AuthInvalid = AuthInvalid { _authInv_message :: Text }
60 deriving (Generic)
61
62 data AuthValid = AuthValid { _authVal_token :: Token
63 , _authVal_tree_id :: TreeId
64 }
65 deriving (Generic)
66
67 type Token = Text
68 type TreeId = Int
69
70 -- | Main functions of authorization
71
72
73 -- | Main types of authorization
74 data CheckAuth = InvalidUser | InvalidPassword | Valid Token TreeId
75 deriving (Eq)
76
77 arbitraryUsername :: [Username]
78 arbitraryUsername = ["user1", "user2"]
79
80 arbitraryPassword :: [Password]
81 arbitraryPassword = map reverse arbitraryUsername
82
83 checkAuthRequest :: Username -> Password -> Connection -> IO CheckAuth
84 checkAuthRequest u p c = case elem u arbitraryUsername of
85 False -> pure InvalidUser
86 True -> case u == (reverse p) of
87 False -> pure InvalidPassword
88 True -> do
89 muId <- getRootUsername u c
90 let uId = maybe (panic "API.AUTH: no user node") _node_id $ head muId
91 pure $ Valid "token" uId
92
93
94 auth' :: Connection -> AuthRequest -> IO AuthResponse
95 auth' c (AuthRequest u p) = do
96 checkAuthRequest' <- checkAuthRequest u p c
97 case checkAuthRequest' of
98 InvalidUser -> pure $ AuthResponse Nothing (Just $ AuthInvalid "Invalid user")
99 InvalidPassword -> pure $ AuthResponse Nothing (Just $ AuthInvalid "Invalid password")
100 Valid to trId -> pure $ AuthResponse (Just $ AuthValid to trId) Nothing
101
102 -- | Instances
103 $(deriveJSON (unPrefix "_authReq_") ''AuthRequest)
104 instance ToSchema AuthRequest
105
106 instance Arbitrary AuthRequest where
107 arbitrary = elements [ AuthRequest u p
108 | u <- arbitraryUsername
109 , p <- arbitraryPassword
110 ]
111
112 $(deriveJSON (unPrefix "_authRes_") ''AuthResponse)
113 instance ToSchema AuthResponse
114 instance Arbitrary AuthResponse where
115 arbitrary = AuthResponse <$> arbitrary <*> arbitrary
116
117 $(deriveJSON (unPrefix "_authInv_") ''AuthInvalid)
118 instance ToSchema AuthInvalid
119 instance Arbitrary AuthInvalid where
120 arbitrary = elements [ AuthInvalid m
121 | m <- [ "Invalid user", "Invalid password"]
122 ]
123
124 $(deriveJSON (unPrefix "_authVal_") ''AuthValid)
125 instance ToSchema AuthValid
126 instance Arbitrary AuthValid where
127 arbitrary = elements [ AuthValid to tr
128 | to <- ["token0", "token1"]
129 , tr <- [1..3]
130 ]
131