[cli] Use settings to set the GitHub authentication

Author: paolino

cli/src/Cli.hs

@@ -12,7 +12,7 @@ import Core.Types.Tx (TxHash, WithTxHash (..))
 import Core.Types.Wallet (Wallet)
 import Data.Functor.Identity (Identity (..))
 import Facts (FactsSelection, factsCmd)
-import Lib.GitHub (getOAUth)
+import GitHub (Auth)
 import Lib.JSON.Canonical.Extra
 import MPFS.API
     ( MPFS (..)
@@ -48,15 +48,18 @@ import Validation (mkValidation)
 import Wallet.Cli (WalletCommand, walletCmd)
 
 data Command a where
-    RequesterCommand :: MPFSClient -> RequesterCommand a -> Command a
-    OracleCommand :: MPFSClient -> OracleCommand a -> Command a
-    AgentCommand :: MPFSClient -> AgentCommand NotReady a -> Command a
+    RequesterCommand
+        :: Auth -> MPFSClient -> RequesterCommand a -> Command a
+    OracleCommand :: Auth -> MPFSClient -> OracleCommand a -> Command a
+    AgentCommand
+        :: Auth -> MPFSClient -> AgentCommand NotReady a -> Command a
     RetractRequest
         :: MPFSClient -> Wallet -> RequestRefId -> Command TxHash
     GetFacts :: MPFSClient -> TokenId -> FactsSelection a -> Command a
     Wallet :: WalletCommand a -> Command a
     GetToken
-        :: MPFSClient
+        :: Auth
+        -> MPFSClient
         -> TokenId
         -> Command
             (AValidationResult TokenInfoFailure (Token WithValidation))
@@ -67,29 +70,29 @@ data SetupError = TokenNotSpecified
 cmd :: Command a -> IO a
 cmd = \case
     RequesterCommand
+        auth
         MPFSClient{runMPFS, submitTx}
         requesterCommand -> do
-            auth <- getOAUth
             runMPFS
                 $ withContext
                     mpfsClient
                     (mkValidation auth)
                     submitTx
                 $ requesterCmd requesterCommand
     OracleCommand
+        auth
         MPFSClient{runMPFS, submitTx}
         oracleCommand -> do
-            auth <- getOAUth
             runMPFS
                 $ withContext
                     mpfsClient
                     (mkValidation auth)
                     submitTx
                 $ oracleCmd oracleCommand
     AgentCommand
+        auth
         MPFSClient{runMPFS, submitTx}
         agentCommand -> do
-            auth <- getOAUth
             runMPFS
                 $ withContext
                     mpfsClient
@@ -110,9 +113,9 @@ cmd = \case
         runMPFS $ factsCmd mpfsClient tokenId factsCommand
     Wallet walletCommand -> liftIO $ walletCmd walletCommand
     GetToken
+        auth
         MPFSClient{runMPFS, submitTx}
         tk -> do
-            auth <- getOAUth
             runMPFS
                 $ withContext
                     mpfsClient

cli/src/Lib/GitHub.hs

@@ -8,7 +8,6 @@ module Lib.GitHub
     , githubGetFile
     , githubGetCodeOwnersFile
     , githubRepositoryExists
-    , getOAUth
     ) where
 
 import Control.Exception
@@ -22,7 +21,6 @@ import Core.Types.Basic
     , Username (..)
     )
 import Data.ByteString.Base64 qualified as B64
-import Data.ByteString.Char8 qualified as BC
 import Data.Foldable (Foldable (..))
 import Data.Text qualified as T
 import Data.Text.Encoding qualified as T
@@ -36,14 +34,8 @@ import Network.HTTP.Client
     , Response (..)
     )
 import Network.HTTP.Types (Status (..))
-import System.Environment (getEnv)
 import Text.JSON.Canonical
 
-getOAUth :: IO Auth
-getOAUth = do
-    tk <- BC.pack <$> getEnv "GITHUB_PERSONAL_ACCESS_TOKEN"
-    return $ OAuth tk
-
 data GithubResponseError
     = GithubResponseErrorRepositoryNotFound
     | GithubResponseErrorSSHPublicKeysCannotBeFetched String

cli/src/Options.hs

@@ -20,15 +20,32 @@ import Core.Options
     , walletOption
     )
 import Core.Types.MPFS (mpfsClientOption)
+import Core.Types.Mnemonics.Options (queryConsole)
+import Data.ByteString.Char8 qualified as B
+import Data.Functor (($>))
+import Data.Text (Text)
+import Data.Text qualified as T
+import Data.Text.Encoding qualified as T
 import Data.Version (Version)
 import Facts (FactsSelection (..), TestRunSelection (..))
+import GitHub (Auth (..))
 import Lib.Box (Box (..), fmapBox)
 import MPFS.API (mpfsClient)
 import OptEnvConf
     ( Parser
+    , auto
     , command
     , commands
+    , env
+    , help
+    , long
+    , mapIO
+    , metavar
+    , option
+    , reader
     , runParser
+    , setting
+    , str
     , (<|>)
     )
 import Oracle.Options (oracleCommandParser)
@@ -40,20 +57,47 @@ newtype Options a = Options
     { optionsCommand :: Command a
     }
 
+githubAuthOption :: Parser Auth
+githubAuthOption =
+    fmap OAuth
+        $ mapIO id
+        $ setting
+            [ help "Prompt for the passphrase for the encrypted mnemonics"
+            , env "ANTI_INTERACTIVE_PASSWORD"
+            , metavar "NONE"
+            , long "ask-passphrase"
+            , option
+            , reader
+                $ str @String
+                    $> ( T.encodeUtf8
+                            <$> queryConsole "Enter your GitHub personal access token: "
+                       )
+            ]
+        <|> setting
+            [ env "GITHUB_PERSONAL_ACCESS_TOKEN"
+            , metavar "PASSPHRASE"
+            , help
+                "A GitHub personal access token with access to public repositories"
+            , reader $ fmap (pure . B.pack) str
+            ]
+
 commandParser :: Parser (Box Command)
 commandParser =
     commands
         [ command "oracle" "Manage oracle operations"
-            $ (\c -> fmapBox (OracleCommand c))
-                <$> mpfsClientOption
+            $ (\a c -> fmapBox (OracleCommand a c))
+                <$> githubAuthOption
+                <*> mpfsClientOption
                 <*> oracleCommandParser
         , command "requester" "Manage requester operations"
-            $ (\c -> fmapBox (RequesterCommand c))
-                <$> mpfsClientOption
+            $ (\a c -> fmapBox (RequesterCommand a c))
+                <$> githubAuthOption
+                <*> mpfsClientOption
                 <*> requesterCommandParser
         , command "agent" "Manage agent operations"
-            $ (\c -> fmapBox (AgentCommand c))
-                <$> mpfsClientOption
+            $ (\a c -> fmapBox (AgentCommand a c))
+                <$> githubAuthOption
+                <*> mpfsClientOption
                 <*> agentCommandParser
         , command "wallet" "Manage wallet operations"
             $ fmapBox Wallet <$> walletCommandParser
@@ -67,7 +111,10 @@ commandParser =
                 <*> tokenIdOption
                 <*> factsSelectionParser
         , command "token" "Get the token content"
-            $ fmap Box . GetToken <$> mpfsClientOption <*> tokenIdOption
+            $ (\a -> fmap Box . GetToken a)
+                <$> githubAuthOption
+                <*> mpfsClientOption
+                <*> tokenIdOption
         ]
 
 factsSelectionParser :: Parser (Box FactsSelection)