bin/gargantext-client/Auth.hs

   1 module Auth where
   2
   3 import Core
   4 import Options
   5
   6 import Control.Monad.IO.Class
   7 import Data.Text.Encoding (encodeUtf8)
   8 import Options.Generic
   9 import Servant.Client
  10 import qualified Servant.Auth.Client as SA
  11
  12 import Gargantext.API.Client
  13 import qualified Gargantext.API.Admin.Auth.Types as Auth
  14 import qualified Gargantext.Core.Types.Individu  as Auth
  15 import qualified Gargantext.Database.Admin.Types.Node as Node
  16
  17 -- | Authenticate and use the resulting Token to perform
  18 --   auth-restricted actions
  19 withAuthToken
  20   :: ClientOpts -- ^ source of user/pass data
  21   -> (SA.Token -> Node.NodeId -> ClientM a) -- ^ do something once authenticated
  22   -> ClientM a
  23 withAuthToken opts act
  24   -- both user and password CLI arguments passed
  25   | Helpful (Just usr) <- user opts
  26   , Helpful (Just pw)  <- pass opts = do
  27       authRes <- postAuth (Auth.AuthRequest usr (Auth.GargPassword pw))
  28       case Auth._authRes_valid authRes of
  29         -- authentication failed, this function critically needs it to
  30         -- be able to run the action, so we abort
  31         Nothing -> problem $
  32           "invalid auth response: " ++
  33           maybe "" (show . Auth._authInv_message)
  34                    (Auth._authRes_inval authRes)
  35         -- authentication went through, we can run the action
  36         Just (Auth.AuthValid tok tree_id) -> do
  37           let tok' = SA.Token (encodeUtf8 tok)
  38           whenVerbose opts $ do
  39             liftIO . putStrLn $ "[Debug] Authenticated: token=" ++ show tok ++
  40                                 ", tree_id=" ++ show tree_id
  41           act tok' tree_id
  42   -- user and/or pass CLI arguments not passed
  43   | otherwise =
  44       problem "auth-protected actions require --user and --pass"