]> Git — Sourcephile - gargantext.git/blob - bin/gargantext-client/Auth.hs
Merge branch '90-dev-hal-box-fix' of ssh://gitlab.iscpif.fr:20022/gargantext/haskell...
[gargantext.git] / 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) -> 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"