Split the Types out of G.API.Admin.Auth

src/Gargantext/API.hs

@@ -49,7 +49,7 @@ import Servant
 import System.IO (FilePath)
 import Data.Text.IO (putStrLn)
 
-import Gargantext.API.Admin.Auth (AuthContext)
+import Gargantext.API.Admin.Auth.Types (AuthContext)
 import Gargantext.API.Admin.Settings (newEnv)
 import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, jwtSettings, settings)
 import Gargantext.API.Ngrams (saveRepo)

src/Gargantext/API/Admin/Auth.hs

@@ -21,67 +21,36 @@ TODO-ACCESS Critical
 -}
 
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell     #-}
 
 module Gargantext.API.Admin.Auth
+  ( auth
+  , withAccess
+  )
   where
 
 import Control.Lens (view)
-import Data.Aeson.TH (deriveJSON)
-import Data.Swagger
-import Data.Text (Text)
 import Data.Text.Lazy (toStrict)
 import Data.Text.Lazy.Encoding (decodeUtf8)
-import GHC.Generics (Generic)
 import Servant
 import Servant.Auth.Server
-import Test.QuickCheck (elements, oneof)
-import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 import qualified Gargantext.Prelude.Crypto.Auth as Auth
 
 import Gargantext.API.Admin.Types
+import Gargantext.API.Admin.Auth.Types
 import Gargantext.API.Prelude (HasJoseError(..), joseError, HasServerError, GargServerC)
-import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..), arbitraryUsername, arbitraryPassword)
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..))
 import Gargantext.Database.Query.Tree (isDescendantOf, isIn)
 import Gargantext.Database.Query.Tree.Root (getRoot)
 import Gargantext.Database.Schema.Node (NodePoly(_node_id))
-import Gargantext.Database.Admin.Types.Node (NodeId(..), UserId, ListId, DocId)
+import Gargantext.Database.Admin.Types.Node (NodeId(..), UserId)
 import Gargantext.Database.Prelude (Cmd', CmdM, HasConnectionPool, HasConfig)
 import Gargantext.Prelude hiding (reverse)
 import Gargantext.Database.Query.Table.User
 
 ---------------------------------------------------
 
--- | Main types for AUTH API
-data AuthRequest = AuthRequest { _authReq_username :: Username
-                               , _authReq_password :: GargPassword
-                               }
-  deriving (Generic)
-
--- TODO: Use an HTTP error to wrap AuthInvalid
-data AuthResponse = AuthResponse { _authRes_valid :: Maybe AuthValid
-                                 , _authRes_inval :: Maybe AuthInvalid
-                                 }
-  deriving (Generic)
-
-data AuthInvalid = AuthInvalid { _authInv_message :: Text }
-  deriving (Generic)
-
-data AuthValid = AuthValid { _authVal_token   :: Token
-                           , _authVal_tree_id :: TreeId
-                           }
-  deriving (Generic)
-
-type Token  = Text
-type TreeId = NodeId
-
 -- | Main functions of authorization
 
--- | Main types of authorization
-data CheckAuth = InvalidUser | InvalidPassword | Valid Token TreeId
-  deriving (Eq)
-
 makeTokenForUser :: (HasSettings env, HasJoseError err)
                  => NodeId -> Cmd' env err Token
 makeTokenForUser uid = do
@@ -119,23 +88,8 @@ auth (AuthRequest u p) = do
     InvalidPassword -> pure $ AuthResponse Nothing (Just $ AuthInvalid "Invalid password")
     Valid to trId   -> pure $ AuthResponse (Just $ AuthValid to trId) Nothing
 
-newtype AuthenticatedUser = AuthenticatedUser
-  { _authUser_id :: NodeId
-  } deriving (Generic)
-
-$(deriveJSON (unPrefix "_authUser_") ''AuthenticatedUser)
-
-instance ToSchema AuthenticatedUser where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authUser_")
-
-instance ToJWT AuthenticatedUser
-instance FromJWT AuthenticatedUser
-
 --type instance BasicAuthCfg = BasicAuthData -> IO (AuthResult AuthenticatedUser)
 
--- TODO-SECURITY why is the CookieSettings necessary?
-type AuthContext = '[JWTSettings, CookieSettings] -- , BasicAuthCfg
-
 {-
 instance FromBasicAuthData AuthenticatedUser where
   fromBasicAuthData authData authCheckFunction = authCheckFunction authData
@@ -147,43 +101,6 @@ authCheck _env (BasicAuthData login password) = pure $
   maybe Indefinite Authenticated $ TODO
 -}
 
--- | Instances
-$(deriveJSON (unPrefix "_authReq_") ''AuthRequest)
-instance ToSchema AuthRequest where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authReq_")
-
-instance Arbitrary AuthRequest where
-  arbitrary = elements [ AuthRequest u p
-                       | u <- arbitraryUsername
-                       , p <- arbitraryPassword
-                       ]
-
-$(deriveJSON (unPrefix "_authRes_") ''AuthResponse)
-instance ToSchema AuthResponse where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authRes_")
-instance Arbitrary AuthResponse where
-  arbitrary = oneof [ AuthResponse Nothing . Just      <$> arbitrary
-                    , flip AuthResponse Nothing . Just <$> arbitrary ]
-
-$(deriveJSON (unPrefix "_authInv_") ''AuthInvalid)
-instance ToSchema AuthInvalid where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authInv_")
-instance Arbitrary AuthInvalid where
-  arbitrary = elements [ AuthInvalid m 
-                       | m <- [ "Invalid user", "Invalid password"]
-                       ]
-
-$(deriveJSON (unPrefix "_authVal_") ''AuthValid)
-instance ToSchema AuthValid where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authVal_")
-instance Arbitrary AuthValid where
-  arbitrary = elements [ AuthValid to tr
-                       | to <- ["token0", "token1"]
-                       , tr <- [1..3]
-                       ]
-
-data PathId = PathNode NodeId | PathNodeNode ListId DocId
-
 withAccessM :: (CmdM env err m, HasServerError err)
             => UserId
             -> PathId

src/Gargantext/API/Admin/Auth/Types.hs

+{-|
+Module      : Gargantext.API.Admin.Auth.Types
+Description : Types for Server API Auth Module
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
+
+{-# LANGUAGE TemplateHaskell #-}
+
+module Gargantext.API.Admin.Auth.Types
+      where
+
+import Data.Aeson.TH (deriveJSON)
+import Data.Swagger
+import Data.Text (Text)
+import GHC.Generics (Generic)
+import Servant.Auth.Server
+import Test.QuickCheck (elements, oneof)
+import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+
+import Gargantext.Core.Types.Individu (Username, GargPassword(..), arbitraryUsername, arbitraryPassword)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Database.Admin.Types.Node (NodeId(..), ListId, DocId)
+import Gargantext.Prelude hiding (reverse)
+
+---------------------------------------------------
+
+-- | Main types for AUTH API
+data AuthRequest = AuthRequest { _authReq_username :: Username
+                               , _authReq_password :: GargPassword
+                               }
+  deriving (Generic)
+
+-- TODO: Use an HTTP error to wrap AuthInvalid
+data AuthResponse = AuthResponse { _authRes_valid :: Maybe AuthValid
+                                 , _authRes_inval :: Maybe AuthInvalid
+                                 }
+  deriving (Generic)
+
+data AuthInvalid = AuthInvalid { _authInv_message :: Text }
+  deriving (Generic)
+
+data AuthValid = AuthValid { _authVal_token   :: Token
+                           , _authVal_tree_id :: TreeId
+                           }
+  deriving (Generic)
+
+type Token  = Text
+type TreeId = NodeId
+
+data CheckAuth = InvalidUser | InvalidPassword | Valid Token TreeId
+  deriving (Eq)
+
+newtype AuthenticatedUser = AuthenticatedUser
+  { _authUser_id :: NodeId
+  } deriving (Generic)
+
+$(deriveJSON (unPrefix "_authUser_") ''AuthenticatedUser)
+
+instance ToSchema AuthenticatedUser where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authUser_")
+
+instance ToJWT AuthenticatedUser
+instance FromJWT AuthenticatedUser
+
+-- TODO-SECURITY why is the CookieSettings necessary?
+type AuthContext = '[JWTSettings, CookieSettings] -- , BasicAuthCfg
+
+-- | Instances
+$(deriveJSON (unPrefix "_authReq_") ''AuthRequest)
+instance ToSchema AuthRequest where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authReq_")
+
+instance Arbitrary AuthRequest where
+  arbitrary = elements [ AuthRequest u p
+                       | u <- arbitraryUsername
+                       , p <- arbitraryPassword
+                       ]
+
+$(deriveJSON (unPrefix "_authRes_") ''AuthResponse)
+instance ToSchema AuthResponse where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authRes_")
+instance Arbitrary AuthResponse where
+  arbitrary = oneof [ AuthResponse Nothing . Just      <$> arbitrary
+                    , flip AuthResponse Nothing . Just <$> arbitrary ]
+
+$(deriveJSON (unPrefix "_authInv_") ''AuthInvalid)
+instance ToSchema AuthInvalid where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authInv_")
+instance Arbitrary AuthInvalid where
+  arbitrary = elements [ AuthInvalid m 
+                       | m <- [ "Invalid user", "Invalid password"]
+                       ]
+
+$(deriveJSON (unPrefix "_authVal_") ''AuthValid)
+instance ToSchema AuthValid where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authVal_")
+instance Arbitrary AuthValid where
+  arbitrary = elements [ AuthValid to tr
+                       | to <- ["token0", "token1"]
+                       , tr <- [1..3]
+                       ]
+
+data PathId = PathNode NodeId | PathNodeNode ListId DocId
\ No newline at end of file

src/Gargantext/API/Node.hs

@@ -40,7 +40,8 @@ import Servant
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
-import Gargantext.API.Admin.Auth (withAccess, PathId(..))
+import Gargantext.API.Admin.Auth.Types (PathId(..))
+import Gargantext.API.Admin.Auth (withAccess)
 import Gargantext.API.Metrics
 import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableCorpus)
 import Gargantext.API.Ngrams.Types (TabType(..))

src/Gargantext/API/Routes.hs

@@ -28,7 +28,8 @@ import Control.Concurrent (threadDelay)
 import Control.Lens (view)
 import Data.Text (Text)
 import Data.Validity
-import Gargantext.API.Admin.Auth (AuthRequest, AuthResponse, AuthenticatedUser(..), withAccess, PathId(..))
+import Gargantext.API.Admin.Auth.Types (AuthRequest, AuthResponse, AuthenticatedUser(..), PathId(..))
+import Gargantext.API.Admin.Auth (withAccess)
 import Gargantext.API.Admin.FrontEnd (FrontEndAPI)
 import Gargantext.API.Count  (CountAPI, count, Query)
 import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableDoc)

src/Gargantext/API/Server.hs

@@ -25,7 +25,8 @@ import qualified Paths_gargantext           as PG -- cabal magic build module
 
 import qualified Gargantext.API.Public      as Public
 
-import Gargantext.API.Admin.Auth (AuthContext, auth)
+import Gargantext.API.Admin.Auth.Types (AuthContext)
+import Gargantext.API.Admin.Auth (auth)
 import Gargantext.API.Admin.FrontEnd (frontEndServer)
 import Gargantext.API.Prelude
 import Gargantext.API.Routes

src/Gargantext/Prelude/Crypto/Auth.hs

 {-|
-Module      : Gargantext.API.Admin.Auth.Check
+Module      : Gargantext.Prelude.Crypto.Auth
 Description :
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3