Secure API part 3: define a withAccess combinator and use it at most places

src/Gargantext/API.hs

@@ -71,7 +71,7 @@ import           Text.Blaze.Html (Html)
 --import Gargantext.API.Swagger
 
 --import Gargantext.Database.Node.Contact (HyperdataContact)
-import Gargantext.API.Auth (AuthRequest, AuthResponse, AuthenticatedUser(..), AuthContext, auth)
+import Gargantext.API.Auth (AuthRequest, AuthResponse, AuthenticatedUser(..), AuthContext, auth, withAccess)
 import Gargantext.API.Count  ( CountAPI, count, Query)
 import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
 import Gargantext.API.Ngrams (HasRepo(..), HasRepoSaver(..), saveRepo, TableNgramsApi, apiNgramsTableDoc)
@@ -221,10 +221,15 @@ type GargAPI' =
 
 type GargPrivateAPI = SA.Auth '[SA.JWT] AuthenticatedUser :> GargPrivateAPI'
 
-type GargPrivateAPI' =
-           -- Roots endpoint
-                "user"  :> Summary "First user endpoint"
+type GargAdminAPI
+              -- Roots endpoint
+             =  "user"  :> Summary "First user endpoint"
                         :> Roots
+           :<|> "nodes" :> Summary "Nodes endpoint"
+                        :> ReqBody '[JSON] [NodeId] :> NodesAPI
+
+type GargPrivateAPI' =
+                GargAdminAPI
 
            -- Node endpoint
            :<|> "node"  :> Summary "Node endpoint"
@@ -241,16 +246,12 @@ type GargPrivateAPI' =
            -- Document endpoint
            :<|> "document":> Summary "Document endpoint"
                           :> Capture "id" DocId    :> "ngrams" :> TableNgramsApi
-                          
-           -- Corpus endpoint
-           :<|> "nodes" :> Summary "Nodes endpoint"
-                        :> ReqBody '[JSON] [NodeId] :> NodesAPI
-       
+
         -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
-           -- Corpus endpoint
+            -- TODO-SECURITY
            :<|> "count" :> Summary "Count endpoint"
                         :> ReqBody '[JSON] Query :> CountAPI
-           
+
            -- Corpus endpoint --> TODO rename s/search/filter/g
            :<|> "search":> Capture "corpus" NodeId :> SearchPairsAPI
 
@@ -308,20 +309,26 @@ serverPrivateGargAPI (Authenticated auser) = serverPrivateGargAPI' auser
 serverPrivateGargAPI _                     = throwAll' (_ServerError # err401)
 -- Here throwAll' requires a concrete type for the monad.
 
+-- TODO-SECURITY admin only: withAdmin
+-- Question: How do we mark admins?
+serverGargAdminAPI :: GargServer GargAdminAPI
+serverGargAdminAPI
+   =  roots
+ :<|> nodesAPI
+
 serverPrivateGargAPI' :: AuthenticatedUser -> GargServer GargPrivateAPI'
 serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
-       =  roots
+       =  serverGargAdminAPI
      :<|> nodeAPI  (Proxy :: Proxy HyperdataAny)      uid
      :<|> nodeAPI  (Proxy :: Proxy HyperdataCorpus)   uid
      :<|> nodeAPI  (Proxy :: Proxy HyperdataAnnuaire) uid
-     :<|> apiNgramsTableDoc
-     :<|> nodesAPI
+     :<|> withAccess (Proxy :: Proxy TableNgramsApi) Proxy uid <*> apiNgramsTableDoc
      :<|> count -- TODO: undefined
-     :<|> searchPairs -- TODO: move elsewhere
-     :<|> graphAPI -- TODO: mock
-     :<|> treeAPI
-     :<|> New.api
-     :<|> New.info uid
+     :<|> withAccess (Proxy :: Proxy SearchPairsAPI) Proxy uid <*> searchPairs -- TODO: move elsewhere
+     :<|> withAccess (Proxy :: Proxy GraphAPI)       Proxy uid <*> graphAPI -- TODO: mock
+     :<|> withAccess (Proxy :: Proxy TreeAPI)        Proxy uid <*> treeAPI
+     :<|> New.api -- TODO-SECURITY
+     :<|> New.info uid -- TODO-SECURITY
 
 serverStatic :: Server (Get '[HTML] Html)
 serverStatic = $(do

src/Gargantext/API/Auth.hs

@@ -20,12 +20,14 @@ TODO-ACCESS Critical
 
 -}
 
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes        #-}
-{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE NoImplicitPrelude   #-}
+{-# LANGUAGE DeriveGeneric       #-}
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell     #-}
 
 module Gargantext.API.Auth
       where
@@ -39,13 +41,15 @@ import Data.Text (Text, reverse)
 import Data.Text.Lazy (toStrict)
 import Data.Text.Lazy.Encoding (decodeUtf8)
 import GHC.Generics (Generic)
+import Servant
 import Servant.Auth.Server
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.API.Settings
-import Gargantext.API.Types (HasJoseError(..), joseError)
+import Gargantext.API.Types (HasJoseError(..), joseError, HasServerError, serverError, GargServerC)
 import Gargantext.Database.Root (getRoot)
-import Gargantext.Database.Types.Node (NodePoly(_node_id), NodeId)
-import Gargantext.Database.Utils (Cmd', HasConnection)
+import Gargantext.Database.Tree (isDescendantOf)
+import Gargantext.Database.Types.Node (NodePoly(_node_id), NodeId(..), UserId)
+import Gargantext.Database.Utils (Cmd', CmdM, HasConnection)
 import Gargantext.Prelude hiding (reverse)
 import Test.QuickCheck (elements, oneof)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
@@ -175,3 +179,17 @@ instance Arbitrary AuthValid where
                        , tr <- [1..3]
                        ]
 
+withAccessM :: (CmdM env err m, HasServerError err) => UserId -> NodeId -> m a -> m a
+withAccessM uId id m = do
+  d <- id `isDescendantOf` NodeId uId
+  if d then m else serverError err401
+
+withAccess :: forall env err m api.
+              (GargServerC env err m, HasServer api '[]) =>
+              Proxy api -> Proxy m ->
+              UserId -> NodeId ->
+              ServerT api m -> ServerT api m
+withAccess p _ uId id = hoistServer p f
+  where
+    f :: forall a. m a -> m a
+    f = withAccessM uId id

src/Gargantext/API/Node.hs

@@ -48,6 +48,7 @@ import Data.Swagger
 import Data.Text (Text())
 import Data.Time (UTCTime)
 import GHC.Generics (Generic)
+import Gargantext.API.Auth (withAccess)
 import Gargantext.API.Metrics
 import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, apiNgramsTableCorpus, QueryParamR, TODO)
 import Gargantext.API.Ngrams.NTree (MyTree)
@@ -60,7 +61,7 @@ import Gargantext.Database.Facet (FacetDoc, OrderBy(..))
 import Gargantext.Database.Node.Children (getChildren)
 import Gargantext.Database.Schema.Node ( getNodesWithParentId, getNode, getNode', deleteNode, deleteNodes, mkNodeWithParent, JSONB, HasNodeError(..))
 import Gargantext.Database.Schema.NodeNode (nodeNodesCategory)
-import Gargantext.Database.Tree (treeDB, isDescendantOf)
+import Gargantext.Database.Tree (treeDB)
 import Gargantext.Database.Types.Node
 import Gargantext.Database.Utils -- (Cmd, CmdM)
 import Gargantext.Prelude
@@ -159,16 +160,10 @@ type ChildrenApi a = Summary " Summary children"
                  :> QueryParam "limit"  Int
                  :> Get '[JSON] [Node a]
 
-withAccess :: (CmdM env err m, HasServerError err) => UserId -> NodeId -> m a -> m a
-withAccess uId id m = do
-  d <- id `isDescendantOf` NodeId uId
-  printDebug "withAccess" (uId, id, d)
-  if d then m else serverError err401
-
 ------------------------------------------------------------------------
 -- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
 nodeAPI :: forall proxy a. (JSONB a, ToJSON a) => proxy a -> UserId -> NodeId -> GargServer (NodeAPI a)
-nodeAPI p uId id = hoistServer (Proxy :: Proxy (NodeAPI a)) (withAccess uId id) nodeAPI'
+nodeAPI p uId id = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId id nodeAPI'
   where
     nodeAPI' :: GargServer (NodeAPI a)
     nodeAPI' =  getNode       id p
@@ -315,8 +310,7 @@ instance HasTreeError ServantErr where
 -}
 
 type TreeAPI   = Get '[JSON] (Tree NodeTree)
--- TODO-ACCESS: CanTree or CanGetNode
--- TODO-EVENTS: No events as this is a read only query.
+
 treeAPI :: NodeId -> GargServer TreeAPI
 treeAPI = treeDB