Merge branch 'dev-tree-reload' of ssh://gitlab.iscpif.fr:20022/gargantext/haskell...
[gargantext.git] / src / Gargantext / API / Admin / Auth.hs
index 0a6e00ae3719cb0e6e5ffb012457f4c3e7437996..beaa0ef12e469a38fc91501d42472c722bf92891 100644 (file)
@@ -21,67 +21,36 @@ TODO-ACCESS Critical
 -}
 
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell     #-}
 
 module Gargantext.API.Admin.Auth
-      where
+  ( 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