CLI: add --with-key option to setup (#516)

* add --with-key option to setup

* bump version

* style cleanup

fission-cli/library/Fission/CLI.hs

@@ -100,8 +100,8 @@ interpret [email protected] {ipfsDaemonVar} cmd =
         Version _ -> do
           logUser $ Version.showVersion CLI.version
 
-        Setup Setup.Options {forceOS, maybeUsername, maybeEmail} ->
-          Setup.setup forceOS maybeUsername maybeEmail
+        Setup Setup.Options {forceOS, maybeUsername, maybeEmail, maybeKeyFile} ->
+          Setup.setup forceOS maybeUsername maybeEmail maybeKeyFile
 
         App subCmd ->
           App.interpret baseCfg subCmd

fission-cli/library/Fission/CLI/Handler/Setup.hs

@@ -1,47 +1,53 @@
 module Fission.CLI.Handler.Setup (setup) where
 
 import           Network.IPFS
-import qualified Network.IPFS.Process.Error        as IPFS.Process
+import qualified Network.IPFS.Process.Error                  as IPFS.Process
+import           RIO.FilePath
 
-import           Network.DNS                       as DNS
+import           Network.DNS                                 as DNS
 import           Servant.Client
 
 import           Fission.Prelude
 
 import           Fission.Error
-import           Fission.Key.Error                 as Key
+import           Fission.Key                                 as Key
 
 import           Fission.User.DID.Types
 import           Fission.User.Email.Types
-import qualified Fission.User.Username.Error       as Username
+import qualified Fission.User.Username.Error                 as Username
 import           Fission.User.Username.Types
 
-import           Fission.Web.Client                as Client
+import           Fission.Web.Auth.Token.JWT.Types
+import           Fission.Web.Client                          as Client
 import           Fission.Web.Client.HTTP.Class
+import qualified Fission.Web.Client.User                     as User
 
-import qualified Fission.CLI.Environment.OS        as OS
-import           Fission.CLI.Environment.Types
+import           Fission.CLI.Display.Error                   as CLI.Error
+
+import           Fission.CLI.Environment                     as Env
+import qualified Fission.CLI.Environment.OS                  as OS
 import           Fission.CLI.Remote
 
-import qualified Fission.CLI.User                  as User
+import qualified Fission.CLI.User                            as User
+
+import qualified Fission.CLI.Display.Success                 as Display
+import qualified Fission.CLI.IPFS.Executable                 as Executable
+import qualified Fission.CLI.Prompt                          as Prompt
 
-import qualified Fission.CLI.Display.Success       as Display
-import qualified Fission.CLI.IPFS.Executable       as Executable
-import qualified Fission.CLI.Prompt                as Prompt
+import           Fission.CLI.Key.Store                       as Key
+import           Fission.CLI.Key.Store                       as Key.Store
 
-import           Fission.CLI.Key.Store             as Key
-import           Fission.CLI.Key.Store             as Key.Store
+import qualified Fission.CLI.Handler.User.Login              as Login
+import qualified Fission.CLI.Handler.User.Login              as User
+import qualified Fission.CLI.Handler.User.Register           as User
 
-import qualified Fission.CLI.Handler.User.Login    as Login
-import qualified Fission.CLI.Handler.User.Login    as User
-import qualified Fission.CLI.Handler.User.Register as User
+import qualified Fission.CLI.WebNative.FileSystem.Auth.Store as WNFS
 
 setup ::
   ( MonadIO          m
   , MonadLocalIPFS   m
   , MonadManagedHTTP m
   , MonadWebAuth     m (SecretKey SigningKey)
-
   , m `Raises` AlreadyExists DID
   , m `Raises` AlreadyExists Env
   , m `Raises` ClientError
@@ -62,8 +68,9 @@ setup ::
   => Maybe OS.Supported
   -> Maybe Username
   -> Maybe Email
+  -> Maybe FilePath
   -> m ()
-setup maybeOS maybeUsername maybeEmail = do
+setup maybeOS maybeUsername maybeEmail maybeKeyFile = do
   logUser @Text "🌱 Setting up environment"
   Executable.place maybeOS
 
@@ -72,19 +79,33 @@ setup maybeOS maybeUsername maybeEmail = do
       Display.putOk "Done! You're all ready to go 🚀"
 
     Right () -> do
-      logUser @Text "🔑 Creating keys"
-      void . Key.Store.create $ Proxy @SigningKey
+      logUser @Text "🔑 Setting up keys"
       void . Key.Store.create $ Proxy @ExchangeKey
-
-      username <- do
-        Prompt.reaskYN "🏠 Do you have an existing account?" >>= \case
-          False ->
-            User.register maybeUsername maybeEmail
-
-          True -> do
-            logUser @Text "🔗 Please open auth.fission.codes on a signed-in device"
-            signingSK <- Key.Store.fetch $ Proxy @SigningKey
-            rootURL   <- getRemoteBaseUrl
-            Login.consume signingSK rootURL {baseUrlPath = "/user/link"} maybeUsername
-
-      Display.putOk $ "Done! Welcome to Fission, " <> textDisplay username <> " ✨"
+      case maybeKeyFile of
+        Just keyFile -> do
+          logDebug $ "🔑 Got a Keyfile: " <> keyFile
+          Key.Store.fromFile (Proxy @SigningKey) keyFile
+          attempt (sendAuthedRequest RootCredential User.whoami) >>= \case
+            Left err -> do
+              CLI.Error.put err "Invalid key file provided."
+              raise err
+            Right username -> do
+              baseURL <- getRemoteBaseUrl
+              signingPK  <- Key.Store.fetchPublic (Proxy @SigningKey)
+              _ <- WNFS.create (DID Key $ Ed25519PublicKey signingPK) "/"
+              Env.init username baseURL Nothing
+              Display.putOk $ "Done! Welcome to Fission, " <> textDisplay username <> " ✨"
+        Nothing -> do
+          void . Key.Store.create $ Proxy @SigningKey
+          username <- do
+            Prompt.reaskYN "🏠 Do you have an existing account?" >>= \case
+              False ->
+                User.register maybeUsername maybeEmail
+
+              True -> do
+                logUser @Text "🔗 Please open auth.fission.codes on a signed-in device"
+                signingSK <- Key.Store.fetch $ Proxy @SigningKey
+                rootURL   <- getRemoteBaseUrl
+                Login.consume signingSK rootURL {baseUrlPath = "/user/link"} maybeUsername
+
+          Display.putOk $ "Done! Welcome to Fission, " <> textDisplay username <> " ✨"

fission-cli/library/Fission/CLI/Key/Store.hs

@@ -1,6 +1,7 @@
 module Fission.CLI.Key.Store
   ( create
   , forceCreate
+  , fromFile
   , fetch
   , fetchPublic
   , delete
@@ -67,6 +68,31 @@ persist keyRole key = do
   path <- KeyStore.getPath keyRole
   forceWrite path $ B64.toByteString key
 
+fromFile ::
+  forall m key .
+  ( MonadIO       m
+  , MonadKeyStore m key
+  , MonadRaise    m
+  , MonadLogger   m
+  , m `Raises` Key.Error
+  )
+  => Proxy key
+  -> FilePath
+  -> m ()
+fromFile keyRole keyFile = do
+  scrubbed  <- getScrubbed
+  secretKey <- ensureM $ parse keyRole scrubbed
+  persist keyRole secretKey
+  where
+    getScrubbed :: m ByteArray.ScrubbedBytes
+    getScrubbed =
+      doesFileExist keyFile >>= \case
+        False ->
+          raise Key.DoesNotExist
+        True -> do
+          bs <- readFileBinary keyFile
+          return $ B64.Scrubbed.scrub bs
+
 fetch ::
   ( MonadIO       m
   , MonadKeyStore m key

fission-cli/library/Fission/CLI/Parser/Command/Setup.hs

@@ -46,6 +46,16 @@ parser = do
     , metavar "EMAIL"
     ]
 
+  maybeKeyFile <- option keyfile $ mconcat
+    [ help "A root keyfile to import"
+    -------
+    , long "with-key"
+    , short 'k'
+    -------
+    , value Nothing
+    , metavar "KEYFILE"
+    ]
+
   pure Options {..}
 
 username :: ReadM (Maybe Username)
@@ -62,6 +72,14 @@ email = do
     ""   -> Nothing
     mail -> Just mail
 
+keyfile :: ReadM (Maybe FilePath)
+keyfile = do
+  raw <- str
+  pure case raw of
+    ""   -> Nothing
+    path -> Just path
+
+
 osParser :: Parser (Maybe OS.Supported)
 osParser = do
   option mayOS $ mconcat

fission-cli/library/Fission/CLI/Parser/Command/Setup/Types.hs

@@ -10,4 +10,5 @@ data Options = Options
   { forceOS       :: Maybe OS.Supported
   , maybeUsername :: Maybe Username
   , maybeEmail    :: Maybe Email
+  , maybeKeyFile  :: Maybe FilePath
   } deriving (Show, Eq)

fission-cli/package.yaml

@@ -1,5 +1,5 @@
 name: fission-cli
-version: '2.13.0.0'
+version: '2.14.0.0'
 category: CLI
 author:
   - Brooklyn Zelenka