{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.API.Auth
import Data.List (elem)
import Data.Swagger
import Data.Text (Text, reverse)
-import Database.PostgreSQL.Simple (Connection)
import GHC.Generics (Generic)
import Gargantext.Core.Utils.Prefix (unPrefix)
-import Gargantext.Database.Node (getRootUsername)
-import Gargantext.Database.Types.Node (NodePoly(_node_id))
+import Gargantext.Database.Root (getRoot)
+import Gargantext.Database.Types.Node (NodePoly(_node_id), NodeId)
+import Gargantext.Database.Utils (Cmd)
import Gargantext.Prelude hiding (reverse)
import Test.QuickCheck (elements, oneof)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+import Gargantext.Core.Types.Individu (Username, Password, arbitraryUsername, arbitraryPassword)
---------------------------------------------------
-- | Main types for AUTH API
-type Username = Text
-type Password = Text
-
data AuthRequest = AuthRequest { _authReq_username :: Username
, _authReq_password :: Password
}
deriving (Generic)
type Token = Text
-type TreeId = Int
+type TreeId = NodeId
-- | Main functions of authorization
data CheckAuth = InvalidUser | InvalidPassword | Valid Token TreeId
deriving (Eq)
-arbitraryUsername :: [Username]
-arbitraryUsername = ["gargantua", "user1", "user2"]
-
-arbitraryPassword :: [Password]
-arbitraryPassword = map reverse arbitraryUsername
-
-checkAuthRequest :: Username -> Password -> Connection -> IO CheckAuth
-checkAuthRequest u p c
+checkAuthRequest :: Username -> Password -> Cmd err CheckAuth
+checkAuthRequest u p
| not (u `elem` arbitraryUsername) = pure InvalidUser
| u /= reverse p = pure InvalidPassword
| otherwise = do
- muId <- getRootUsername u c
+ muId <- getRoot "user1"
pure $ maybe InvalidUser (Valid "token" . _node_id) $ head muId
-auth' :: Connection -> AuthRequest -> IO AuthResponse
-auth' c (AuthRequest u p) = do
- checkAuthRequest' <- checkAuthRequest u p c
+auth :: AuthRequest -> Cmd err AuthResponse
+auth (AuthRequest u p) = do
+ checkAuthRequest' <- checkAuthRequest u p
case checkAuthRequest' of
InvalidUser -> pure $ AuthResponse Nothing (Just $ AuthInvalid "Invalid user")
InvalidPassword -> pure $ AuthResponse Nothing (Just $ AuthInvalid "Invalid password")