Wip

gargantext.cabal

@@ -49,6 +49,7 @@ library
       Gargantext.API.Admin.Settings
       Gargantext.API.Admin.Orchestrator.Types
       Gargantext.API.Admin.Types
+      Gargantext.API.Auth.PolicyCheck
       Gargantext.API.Dev
       Gargantext.API.HashedResponse
       Gargantext.API.Ngrams

src/Gargantext/API/Auth/PolicyCheck.hs

+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies        #-}
+{-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE LambdaCase #-}
+
+module Gargantext.API.Auth.PolicyCheck where
+
+import Servant
+import Servant.Server.Internal.Delayed
+import Servant.Server.Internal.DelayedIO
+import Servant.Ekg
+
+import qualified Servant.Swagger as Swagger
+--import Data.Proxy
+--import Servant.Auth (Cookie)
+--import Servant.Auth.Server.Internal.Class
+import Prelude
+import Gargantext.API.Admin.Auth.Types
+import Gargantext.Core.Types
+import qualified Network.HTTP.Types as HTTP
+import Data.Foldable
+import Gargantext.Database.Prelude (DBCmd)
+
+data AccessResult
+  = Allow
+  | Deny HTTP.Status
+
+instance Semigroup AccessResult where
+  Allow <> Allow        = Allow
+  Allow <> Deny status  = Deny status
+  Deny status <> Allow  = Deny status
+  Deny status <> Deny _ = Deny status
+
+instance Monoid AccessResult where
+  mempty = Allow
+
+enforce :: Applicative m => HTTP.Status -> Bool -> m AccessResult
+enforce errStatus p = pure $ if p then Allow else Deny errStatus
+
+-- | An access policy for gargantext that governs how resources are accessed
+-- and who is entitled to see what.
+newtype AccessPolicy =
+  AccessPolicy { runAccessPolicy :: forall err. [AccessCheck] -> DBCmd err AccessResult }
+
+data AccessCheck
+  = AC_node_owner AuthenticatedUser NodeId
+
+check :: Applicative m => AccessCheck -> m AccessResult
+check = \case
+  AC_node_owner (AuthenticatedUser nodeId) requestedNodeId
+    -> enforce HTTP.status403 $ nodeId == requestedNodeId
+
+stockAccessPolicy :: AccessPolicy
+stockAccessPolicy = AccessPolicy (foldlM (\acc ac -> mappend acc <$> check ac) Allow)
+
+data PolicyChecked
+
+
+instance HasServer sub ctx => HasServer (PolicyChecked :> sub) ctx where
+  type ServerT (PolicyChecked :> sub) m = AccessPolicy -> ServerT sub m
+  hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy sub) pc nt . s
+  route Proxy ctx d = route (Proxy :: Proxy sub) ctx (d `addParameterCheck` getStockAccessPolicy)
+    where
+      getStockAccessPolicy :: DelayedIO AccessPolicy
+      getStockAccessPolicy = DelayedIO $ pure stockAccessPolicy
+
+instance HasLink sub => HasLink (PolicyChecked :> sub) where
+    type MkLink (PolicyChecked :> sub) a = MkLink sub a
+    toLink f _ = toLink f (Proxy :: Proxy sub)
+
+instance Swagger.HasSwagger sub => Swagger.HasSwagger (PolicyChecked :> sub) where
+    toSwagger _ = Swagger.toSwagger (Proxy :: Proxy sub)
+
+instance HasEndpoint sub => HasEndpoint (PolicyChecked :> sub) where
+  getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
+  enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)

src/Gargantext/API/Node.hs

@@ -37,6 +37,7 @@ import GHC.Generics (Generic)
 import Gargantext.API.Admin.Auth (withAccess)
 import Gargantext.API.Admin.Auth.Types (PathId(..))
 import Gargantext.API.Admin.EnvTypes
+import Gargantext.API.Auth.PolicyCheck
 import Gargantext.API.Metrics
 import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableCorpus)
 import Gargantext.API.Ngrams.Types (TabType(..))
@@ -195,9 +196,11 @@ nodeAPI :: forall proxy a.
        ( HyperdataC a
        ) => proxy a
          -> UserId
+         -> AccessPolicy
          -> NodeId
          -> ServerT (NodeAPI a) (GargM Env GargError)
-nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode id') nodeAPI'
+nodeAPI p uId policy id' = do
+  withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode id') nodeAPI'
   where
     nodeAPI' :: ServerT (NodeAPI a) (GargM Env GargError)
     nodeAPI' =  getNodeWith   id' p

src/Gargantext/API/Routes.hs

@@ -31,6 +31,7 @@ import Gargantext.API.Admin.Auth (ForgotPasswordAPI, ForgotPasswordAsyncAPI, wit
 import Gargantext.API.Admin.Auth.Types (AuthRequest, AuthResponse, AuthenticatedUser(..), PathId(..))
 import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
 import Gargantext.API.Admin.FrontEnd (FrontEndAPI)
+import Gargantext.API.Auth.PolicyCheck
 import Gargantext.API.Context
 import Gargantext.API.Count  (CountAPI, count, Query)
 import Gargantext.API.Members (MembersAPI, members)
@@ -87,7 +88,7 @@ type GargAPI' =
           :<|> "public"      :> Public.API
 
 
-type MkProtectedAPI private = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser :> private
+type MkProtectedAPI private = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser :> PolicyChecked :> private
 
 type GargPrivateAPI = MkProtectedAPI GargPrivateAPI'
 
@@ -237,16 +238,18 @@ serverGargAdminAPI =  roots
 
 
 serverPrivateGargAPI'
-  :: AuthenticatedUser -> ServerT GargPrivateAPI' (GargM Env GargError)
-serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
+  :: AuthenticatedUser
+  -> AccessPolicy
+  -> ServerT GargPrivateAPI' (GargM Env GargError)
+serverPrivateGargAPI' (AuthenticatedUser (NodeId uid)) accessPolicy
        =  serverGargAdminAPI
-     :<|> nodeAPI     (Proxy :: Proxy HyperdataAny)      uid
+     :<|> nodeAPI     (Proxy :: Proxy HyperdataAny)      uid accessPolicy
      :<|> contextAPI  (Proxy :: Proxy HyperdataAny)      uid
-     :<|> nodeAPI     (Proxy :: Proxy HyperdataCorpus)   uid
+     :<|> nodeAPI     (Proxy :: Proxy HyperdataCorpus)   uid accessPolicy
      :<|> nodeNodeAPI (Proxy :: Proxy HyperdataAny)      uid
      :<|> CorpusExport.getCorpus   -- uid
  --    :<|> nodeAPI     (Proxy :: Proxy HyperdataContact)  uid
-     :<|> nodeAPI     (Proxy :: Proxy HyperdataAnnuaire) uid
+     :<|> nodeAPI     (Proxy :: Proxy HyperdataAnnuaire) uid accessPolicy
      :<|> Contact.api uid
 
      :<|> withAccess  (Proxy :: Proxy TableNgramsApi) Proxy uid