CLI disconnect/reconnect on every retry

fission-cli/library/Fission/CLI/Handler/App/Publish.hs

@@ -7,8 +7,8 @@ import qualified Crypto.PubKey.Ed25519                     as Ed25519
 import           System.FSNotify                           as FS
 
 import           RIO.Directory
-import           Web.Browser
 import           Servant.Client
+import           Web.Browser
 
 import           Network.HTTP.Types.Status
 import qualified Network.IPFS.Process.Error                as IPFS.Process
@@ -37,7 +37,10 @@ import qualified Fission.CLI.Display.Error                 as CLI.Error
 import qualified Fission.CLI.Display.Success               as CLI.Success
 
 import qualified Fission.CLI.IPFS.Add                      as CLI.IPFS.Add
+import           Fission.CLI.IPFS.Connect
 import           Fission.CLI.IPFS.Daemon                   as IPFS.Daemon
+import           Fission.CLI.IPFS.Peers                    as Peers
+import           Fission.IPFS.Error.Types                  as IPFS
 
 import           Fission.CLI.App.Environment               as App
 import           Fission.CLI.Parser.Open.Types
@@ -49,23 +52,25 @@ import           Fission.CLI.WebNative.Mutation.Auth.Store as UCAN
 
 -- | Sync the current working directory to the server over IPFS
 publish :: forall m .
-  ( MonadIO          m
-  , MonadCleanup     m
-  , MonadLogger      m
-  , MonadLocalIPFS   m
-  , MonadIPFSDaemon  m
-  , UCAN.MonadStore  m
-  , MonadEnvironment m
-  , MonadRemote      m
-  , MonadWebClient   m
-  , MonadTime        m
-  , MonadWebAuth     m Token
-  , MonadWebAuth     m Ed25519.SecretKey
-  , ServerDID        m
+  ( MonadIO             m
+  , MonadBaseControl IO m
+  , MonadCleanup        m
+  , MonadLogger         m
+  , MonadLocalIPFS      m
+  , MonadIPFSDaemon     m
+  , UCAN.MonadStore     m
+  , MonadEnvironment    m
+  , MonadRemote         m
+  , MonadWebClient      m
+  , MonadTime           m
+  , MonadWebAuth        m Token
+  , MonadWebAuth        m Ed25519.SecretKey
+  , ServerDID           m
   , m `Raises` YAML.ParseException
   , m `Raises` ClientError
-  , m `Raises` IPFS.Process.Error
   , m `Raises` NotFound FilePath
+  , m `Raises` IPFS.Process.Error
+  , m `Raises` IPFS.UnableToConnect
   , Show (OpenUnion (Errors m))
   , CheckErrors m
   )
@@ -104,11 +109,15 @@ publish
 
         Right cid@(CID hash) -> do
           logDebug $ "📱 Directory CID is " <> hash
-          _ <- IPFS.Daemon.runDaemon
+          _     <- IPFS.Daemon.runDaemon
+          peers <- Peers.getPeers
 
           let
             runUpdate :: CID -> m (ClientM ())
             runUpdate cid' = do
+              swarmDisconnect peers
+              swarmConnectWithRetry peers 25
+
               proof <- getRootUserProof
               ucan  <- Client.attachAuth proof
               return $ updateApp appURL cid' (Just updateData) ucan

fission-cli/library/Fission/CLI/IPFS/Connect.hs

@@ -1,6 +1,7 @@
 -- | Module for connecting to the Fission IPFS service
 module Fission.CLI.IPFS.Connect
   ( swarmConnectWithRetry
+  , swarmDisconnect
   , couldNotSwarmConnect
   ) where
 
@@ -54,6 +55,23 @@ swarmConnectWithRetry peers retries = do
           UTF8.putText "🛰 🔁 Unable to connect to the Fission IPFS peer, trying again...\n"
           swarmConnectWithRetry retryPeers (retries - 1)
 
+swarmDisconnect ::
+  ( MonadIO             m
+  , MonadBaseControl IO m
+  , MonadLogger         m
+  , MonadLocalIPFS      m
+  )
+  => NonEmpty IPFS.Peer
+  -> m ()
+swarmDisconnect peers = do
+  logDebug @Text "🌌🔌 Disconnecting peers"
+
+  liftBaseWith \runInBase ->
+    forConcurrently peers \peer ->
+      runInBase $ IPFS.Peer.disconnect peer
+
+  return ()
+
 connectTo :: forall m .
   ( MonadIO             m
   , MonadBaseControl IO m

fission-cli/package.yaml

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

stack.yaml

@@ -1,4 +1,4 @@
-resolver: lts-18.10
+resolver: lts-18.13
 allow-newer: true
 
 packages:
@@ -14,7 +14,7 @@ extra-deps:
   - cryptostore-0.2.1.0
   - dimensions-2.1.1.0
   - hfsevents-0.1.6
-  - ipfs-1.3.1
+  - ipfs-1.4.0
   - lzma-clib-5.2.2
   - raven-haskell-0.1.4.0
   - rescue-0.4.2.1

stack.yaml.lock

@@ -40,12 +40,12 @@ packages:
   original:
     hackage: hfsevents-0.1.6
 - completed:
-    hackage: ipfs-1.3.1@sha256:69634b279a61777d391f9a6fac42f645df2e6485dee337400a2ac861602474ae,6223
+    hackage: ipfs-1.4.0@sha256:1a6f8b8ec4d8cf1e1bd8f5ed7a2a1a0758855c1304d3dc60101ec1ca16dacf69,6207
     pantry-tree:
-      size: 4198
-      sha256: 1df7822f65be2a6877c9478cc692d06479449eae215b802bc5a65f73f0107d94
+      size: 4350
+      sha256: 114e26db47980b29a3ce3635e0e36fe1d866e8c77fb854063cf872abe638135b
   original:
-    hackage: ipfs-1.3.1
+    hackage: ipfs-1.4.0
 - completed:
     hackage: lzma-clib-5.2.2@sha256:25eb43d5fd8a8ab58380f475b91fb1fa907381f8a81c8d8ba63ba428d97ae0cc,4900
     pantry-tree:
@@ -125,7 +125,7 @@ packages:
     hackage: http-link-header-1.0.3.1
 snapshots:
 - completed:
-    size: 587546
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/10.yaml
-    sha256: 88b4f81e162ba3adc230a9fcccc4d19ac116377656bab56c7382ca88598b257a
-  original: lts-18.10
+    size: 586268
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/13.yaml
+    sha256: d9e658a22cfe8d87a64fdf219885f942fef5fe2bcb156a9800174911c5da2443
+  original: lts-18.13