Add --open flag to CLI app publishing (#505)

Co-authored-by: Austin Erlandson <[email protected]>
fission-codes · Apr 29, 2021 · dc82350 · dc82350
1 parent 4c21435
commit dc82350
Show file tree

Hide file tree

Showing 9 changed files with 62 additions and 24 deletions.
diff --git a/fission-cli/library/Fission/CLI/App.hs b/fission-cli/library/Fission/CLI/App.hs
@@ -60,7 +60,7 @@ interpret baseCfg cmd = do
               logError @Text "Problem setting up new app"
               raise errs
 
-    Up App.Up.Options {watch, updateDNS, updateData, filePath, ipfsCfg = IPFS.Config {..}} -> do
+    Up App.Up.Options {open, watch, updateDNS, updateData, filePath, ipfsCfg = IPFS.Config {..}} -> do
       let
         run' :: FissionCLI errs Connected.Config () -> FissionCLI errs Base.Config ()
         run' = ensureM . Connected.run baseCfg timeoutSeconds
@@ -71,7 +71,7 @@ interpret baseCfg cmd = do
       attempt App.Env.read >>= \case
         Right Env {appURL, ipfsIgnored} ->
           run' . local (addAppIgnore ipfsIgnored) $ -- Local because only need to add for this one scenario
-            Handler.publish watch runIO appURL filePath updateDNS updateData
+            Handler.publish open watch runIO appURL filePath updateDNS updateData
 
         Left _ -> do
           CLI.Error.put (NotFound @URL) "You have not set up an app. Please run `fission app register`"

diff --git a/fission-cli/library/Fission/CLI/Connected.hs b/fission-cli/library/Fission/CLI/Connected.hs
@@ -126,7 +126,7 @@ mkConnected ::
 mkConnected inCfg ipfsTimeout = do
   attempt (Key.Store.fetch $ Proxy @SigningKey) >>= \case
     Left _err -> do
-      CLI.Error.put NoKeyFile "Cannot find key. Please run: fission user register"
+      CLI.Error.put NoKeyFile "Cannot find key. Try 'fission setup' if this is your first time or 'fission user login' if you have an existing account."
       raise NoKeyFile
 
     Right secretKey -> do
@@ -166,7 +166,7 @@ mkConnected inCfg ipfsTimeout = do
             proof <- getRootUserProof
             attempt (sendAuthedRequest proof User.verify) >>= \case
               Left err -> do
-                CLI.Error.put err "Not registered. Please run: fission user register"
+                CLI.Error.put err "Not registered. Please run: fission user login"
                 raise NotRegistered
 
               Right _ -> do

diff --git a/fission-cli/library/Fission/CLI/Handler/App/Init.hs b/fission-cli/library/Fission/CLI/Handler/App/Init.hs
@@ -81,12 +81,7 @@ appInit appDir mayBuildDir' mayAppName = do
       UTF8.putText "⏯️  Next run "
 
       colourized [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Blue] do
-        UTF8.putText "fission app publish"
-
-      UTF8.putText " or "
-
-      colourized [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Blue] do
-        UTF8.putText "fission app publish --watch"
+        UTF8.putText "fission app publish [--open|--watch]"
 
       UTF8.putText " to sync data\n"
 

diff --git a/fission-cli/library/Fission/CLI/Handler/App/Publish.hs b/fission-cli/library/Fission/CLI/Handler/App/Publish.hs
@@ -7,6 +7,7 @@ import qualified Crypto.PubKey.Ed25519                     as Ed25519
 import           System.FSNotify                           as FS
 
 import           RIO.Directory
+import           Web.Browser
 
 import           Network.HTTP.Types.Status
 import qualified Network.IPFS.Process.Error                as IPFS.Process
@@ -41,7 +42,9 @@ import qualified Fission.CLI.IPFS.Add                      as CLI.IPFS.Add
 import           Fission.CLI.IPFS.Daemon                   as IPFS.Daemon
 
 import           Fission.CLI.App.Environment               as App
+import           Fission.CLI.Parser.Open.Types
 import           Fission.CLI.Parser.Watch.Types
+import           Fission.CLI.Remote
 
 import           Fission.CLI.Environment                   (MonadEnvironment)
 import           Fission.CLI.WebNative.Mutation.Auth.Store as UCAN
@@ -55,6 +58,7 @@ publish ::
   , MonadIPFSDaemon  m
   , UCAN.MonadStore  m
   , MonadEnvironment m
+  , MonadRemote      m
   , MonadWebClient   m
   , MonadTime        m
   , MonadWebAuth     m Token
@@ -67,14 +71,23 @@ publish ::
   , Show (OpenUnion (Errors m))
   , CheckErrors m
   )
-  => WatchFlag
+  => OpenFlag
+  -> WatchFlag
   -> (m () -> IO ())
   -> URL
   -> FilePath
   -> Bool
   -> Bool
   -> m ()
-publish watchFlag runner appURL appPath _updateDNS updateData = do -- TODO updateDNS
+publish
+  (OpenFlag open)
+  (WatchFlag watching)
+  runner
+  appURL
+  appPath
+  _updateDNS -- TODO updateDNS
+  updateData
+    = do
   logDebug @Text "📱 App publish"
   attempt (App.readFrom appPath) >>= \case
     Left err -> do
@@ -103,17 +116,20 @@ publish watchFlag runner appURL appPath _updateDNS updateData = do -- TODO updat
               CLI.Error.put err "Server unable to sync data"
               raise err
 
-            Right _ ->
-              case watchFlag of
-                WatchFlag False ->
-                  success appURL
-
-                WatchFlag True ->
-                  liftIO $ FS.withManager \watchMgr -> do
-                    hashCache <- newMVar hash
-                    timeCache <- newMVar =<< getCurrentTime
-                    void $ handleTreeChanges runner proof appURL updateData timeCache hashCache watchMgr absBuildPath
-                    forever . liftIO $ threadDelay 1_000_000 -- Sleep main thread
+            Right _ -> do
+              ipfsGateway <- getIpfsGateway
+
+              when open do
+                liftIO . void . openBrowser $ ipfsGateway <> "/" <> show appURL
+
+              when watching do
+                liftIO $ FS.withManager \watchMgr -> do
+                  hashCache <- newMVar hash
+                  timeCache <- newMVar =<< getCurrentTime
+                  void $ handleTreeChanges runner proof appURL updateData timeCache hashCache watchMgr absBuildPath
+                  forever . liftIO $ threadDelay 1_000_000 -- Sleep main thread
+
+              success appURL
 
 handleTreeChanges ::
   ( MonadIO        m

diff --git a/fission-cli/library/Fission/CLI/Parser/Command/App/Up.hs b/fission-cli/library/Fission/CLI/Parser/Command/App/Up.hs
@@ -12,6 +12,7 @@ import           Fission.Prelude
 import           Fission.CLI.Parser.Command.App.Up.Types
 import qualified Fission.CLI.Parser.Config.IPFS          as IPFS
 import           Fission.CLI.Parser.Internal
+import           Fission.CLI.Parser.Open.Types
 import           Fission.CLI.Parser.Watch.Types
 
 parserWithInfo :: ParserInfo Options
@@ -43,6 +44,13 @@ parser = do
     , value True
     ]
 
+  open <- fmap OpenFlag . switch $ mconcat
+    [ help  "Open your default browser after publish"
+    ----------
+    , long  "open"
+    , short 'o'
+    ]
+
   watch <- fmap WatchFlag . switch $ mconcat
     [ help  "Watch for changes & automatically trigger upload"
     ----------

diff --git a/fission-cli/library/Fission/CLI/Parser/Command/App/Up/Types.hs b/fission-cli/library/Fission/CLI/Parser/Command/App/Up/Types.hs
@@ -4,9 +4,11 @@ import           Fission.Prelude
 
 import qualified Fission.CLI.Parser.Config.IPFS.Types as IPFS
 import           Fission.CLI.Parser.Watch.Types
+import           Fission.CLI.Parser.Open.Types
 
 data Options = Options
-  { watch      :: WatchFlag
+  { open       :: OpenFlag
+  , watch      :: WatchFlag
   , updateDNS  :: Bool
   , updateData :: Bool
   , filePath   :: FilePath

diff --git a/fission-cli/library/Fission/CLI/Parser/Open/Types.hs b/fission-cli/library/Fission/CLI/Parser/Open/Types.hs
@@ -0,0 +1,7 @@
+module Fission.CLI.Parser.Open.Types (OpenFlag (..)) where
+
+import           Fission.Prelude
+
+newtype OpenFlag = OpenFlag
+  { unFlag :: Bool }
+  deriving newtype (Show, Eq)
diff --git a/fission-cli/library/Fission/CLI/Remote.hs b/fission-cli/library/Fission/CLI/Remote.hs
@@ -2,6 +2,7 @@ module Fission.CLI.Remote
   ( getRemoteURL
   , getRemoteBaseUrl
   , getNameService
+  , getIpfsGateway
   -- * Reexports
   , module Fission.CLI.Remote.Class
   , module Fission.Web.API.Remote
@@ -19,6 +20,14 @@ import           Fission.CLI.Remote.Class
 getRemoteBaseUrl :: MonadRemote m => m BaseUrl
 getRemoteBaseUrl = toBaseUrl <$> getRemote
 
+getIpfsGateway :: MonadRemote m => m String
+getIpfsGateway = do
+  url <- getRemoteBaseUrl
+  let BaseUrl {..} = url
+      ipfsGateway = url { baseUrlHost = "ipfs." <> baseUrlHost, baseUrlPath = "ipns" }
+
+  pure $ showBaseUrl ipfsGateway
+
 getRemoteURL :: MonadRemote m => m URL
 getRemoteURL = toURL <$> getRemote
 

diff --git a/fission-cli/package.yaml b/fission-cli/package.yaml
@@ -130,6 +130,7 @@ dependencies:
   - rescue
 
   ## File System ##
+  - open-browser
   - file-embed
   - path-pieces
   - fsnotify