bin/gargantext-client/Auth.hs

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