src/Gargantext/API/GraphQL/Utils.hs

   1 {-|
   2 Module      : Gargantext.API.GraphQL.Utils
   3 Description : Utils for GraphQL API
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9 -}
  10 {-# Language TypeFamilies #-}
  11 {-# Language DeriveAnyClass #-}
  12
  13 module Gargantext.API.GraphQL.Utils where
  14
  15 import Data.Morpheus ()
  16 import Data.Morpheus.Types
  17 import Data.Text (Text)
  18 import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix)
  19 import Gargantext.Prelude
  20 import Data.Function (id)
  21 import Data.Text.Encoding (encodeUtf8)
  22 import Gargantext.API.Admin.Types (jwtSettings, HasSettings (settings))
  23 import Servant.Auth.Server (verifyJWT, JWTSettings)
  24 import Control.Lens.Getter (view)
  25 import Gargantext.Database.Prelude (Cmd')
  26 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser (AuthenticatedUser, _authUser_id))
  27 import Data.ByteString (ByteString)
  28 import Gargantext.Database.Admin.Types.Node (NodeId)
  29 import GHC.Generics (Generic)
  30
  31 import qualified Data.Text as T
  32
  33 -- DOC: https://morpheusgraphql.com/server#directives
  34 data RemovePrefix = RemovePrefix {prefix :: Text}
  35   deriving (Generic, GQLType)
  36
  37 instance GQLDirective RemovePrefix where
  38   type DIRECTIVE_LOCATIONS RemovePrefix = '[ 'LOCATION_OBJECT, 'LOCATION_INPUT_OBJECT ]
  39
  40 instance VisitType RemovePrefix where
  41   visitTypeName (RemovePrefix {prefix}) _ = T.pack . unCapitalize . dropPrefix (T.unpack prefix) . T.unpack
  42   visitTypeDescription _ = id
  43
  44 data AuthStatus = Valid | Invalid
  45
  46 authUser :: (HasSettings env) => NodeId -> Text -> Cmd' env err AuthStatus
  47 authUser ui_id token = do
  48   let token' = encodeUtf8 token
  49   jwtS <- view $ settings . jwtSettings
  50   u <- liftBase $ getUserFromToken jwtS token'
  51   case u of
  52     Nothing -> pure Invalid
  53     Just au ->
  54       if nId au == ui_id
  55         then pure Valid
  56         else pure Invalid
  57         where
  58           nId AuthenticatedUser {_authUser_id} = _authUser_id
  59
  60 getUserFromToken :: JWTSettings -> ByteString -> IO (Maybe AuthenticatedUser)
  61 getUserFromToken = verifyJWT