Merge pull request #2078 from IntersectMBO/2077-fix-CI-builds

Fix CI build failures

Author: sgillespie

.github/workflows/haskell.yml

@@ -29,7 +29,7 @@ jobs:
     env:
       # Increment this value to "invalidate" the cabal cache. Be sure to do this
       # after updating dependencies (Hackage or chap)
-      CABAL_CACHE_VERSION: 1
+      CABAL_CACHE_VERSION: 2
 
     steps:
       - name: Checkout code
@@ -47,19 +47,12 @@ jobs:
           minimal: false
           # enable IOG-full flavour to bring in all the crypto libraries we need.
           iog-full: true
-      # TODO: remove when input-output-hk/devx is fixed
-      - name: Install system dependencies
-        uses: input-output-hk/actions/base@latest
-        with:
-          use-sodium-vrf: true
-      - name: Add LMDB to Nix environment
+      - name: Export devx environment variables
         run: |
-          nix-env -f '<nixpkgs>' -iA lmdb
-          LMDB_STORE=$(find /nix/store -maxdepth 1 -name '*lmdb*-dev' -type d | head -1)
-          if [ -n "$LMDB_STORE" ]; then
-            echo "LMDB_PKGCONFIG=${LMDB_STORE}/lib/pkgconfig" >> $GITHUB_ENV
-          fi
-        shell: devx {0}
+          echo "PKG_CONFIG_PATH=$PKG_CONFIG_PATH_FOR_TARGET" >> $GITHUB_ENV
+          echo "PKG_CONFIG_PATH_FOR_TARGET=$PKG_CONFIG_PATH_FOR_TARGET" >> $GITHUB_ENV
+          echo "NIX_LDFLAGS=$NIX_LDFLAGS" >> $GITHUB_ENV
+          echo "LD_LIBRARY_PATH=$(echo $NIX_LDFLAGS | tr ' ' '\n' | grep '^-L' | sed 's/^-L//' | tr '\n' ':')" >> $GITHUB_ENV
       - name: cache cabal
         uses: actions/cache@v3
         with:
@@ -70,18 +63,17 @@ jobs:
           restore-keys: ${{ env.CABAL_CACHE_VERSION }}-${{ runner.os }}-${{ matrix.compiler-nix-name }}-
       - name: cabal update
         run: |
-          export PKG_CONFIG_PATH_FOR_TARGET=${{ env.LMDB_PKGCONFIG }}:${PKG_CONFIG_PATH_FOR_TARGET:-}
+          export PATH="/usr/bin:$PATH"
           cabal update
       - name: cabal build dependencies
         run: |
-          export PKG_CONFIG_PATH_FOR_TARGET=${{ env.LMDB_PKGCONFIG }}:${PKG_CONFIG_PATH_FOR_TARGET:-}
+          export PATH="/usr/bin:$PATH"
           cabal build all -j --enable-tests --only-dependencies
       - name: cabal build
         run: |
-          export PKG_CONFIG_PATH_FOR_TARGET=${{ env.LMDB_PKGCONFIG }}:${PKG_CONFIG_PATH_FOR_TARGET:-}
+          export PATH="/usr/bin:$PATH"
           cabal build all -j --enable-tests
       - name: postgres init
-        working-directory:
         run: |
           # Set up environment
           PG_DIR="$(mktemp -d)"
@@ -103,7 +95,7 @@ jobs:
             start
       - name: cabal test
         run: |
-          export PKG_CONFIG_PATH_FOR_TARGET=${{ env.LMDB_PKGCONFIG }}:${PKG_CONFIG_PATH_FOR_TARGET:-}
+          export PATH="/usr/bin:$PATH"
           # Create pgpass file
           export PGPASSFILE="${PG_DIR}/pgpass-testing"
           echo "${PG_DIR}:5432:$DBUSER:$DBUSER:*" > $PGPASSFILE

cardano-chain-gen/src/Cardano/Mock/ChainSync/Server.hs

@@ -14,6 +14,7 @@ module Cardano.Mock.ChainSync.Server (
   withServerHandle,
   stopServer,
   restartServer,
+  waitForNextConnection,
 
   -- * ServerHandle api
   ServerHandle (..),
@@ -42,8 +43,8 @@ import Control.Concurrent.Class.MonadSTM.Strict (
   retry,
   writeTVar,
  )
-import Control.Exception (bracket)
-import Control.Monad (forever)
+import Control.Exception (IOException, bracket, try)
+import Control.Monad (forever, unless)
 import Control.Tracer
 import Data.ByteString.Lazy.Char8 (ByteString)
 import qualified Data.Map.Strict as Map
@@ -101,13 +102,15 @@ import Ouroboros.Network.Snocket
 import qualified Ouroboros.Network.Snocket as Snocket
 import Ouroboros.Network.Socket
 import Ouroboros.Network.Util.ShowProxy (Proxy (..), ShowProxy (..))
+import System.Directory (removeFile)
 
 {- HLINT ignore "Use readTVarIO" -}
 
 data ServerHandle m blk = ServerHandle
   { chainProducerState :: StrictTVar m (ChainProducerState blk)
   , threadHandle :: StrictTVar m (Async ())
   , forkAgain :: m (Async ())
+  , socketPath :: FilePath
   }
 
 replaceGenesis :: MonadSTM m => ServerHandle m blk -> State blk -> STM m ()
@@ -142,9 +145,11 @@ rollback handle point =
 restartServer :: ServerHandle IO blk -> IO ()
 restartServer sh = do
   stopServer sh
-  -- TODO not sure why, but this delay is necessary. Without it reconnection doesn't happen
-  -- some times.
-  threadDelay 1_000_000
+  -- On Unix, closing the socket fd does not remove the socket file. If the
+  -- file still exists when the new server tries to bind, bind() fails with
+  -- EADDRINUSE and the server thread dies silently. Explicitly remove the
+  -- file here so the new server can always bind successfully.
+  _ <- (try @IOException) $ removeFile (socketPath sh)
   thread <- forkAgain sh
   atomically $ writeTVar (threadHandle sh) thread
 
@@ -153,6 +158,20 @@ stopServer sh = do
   srvThread <- atomically $ readTVar $ threadHandle sh
   cancel srvThread
 
+-- | Block until db-sync has made a new connection to the (restarted) server.
+-- This is detected by watching 'nextFollowerId' in 'ChainProducerState': each
+-- new client connection calls 'newFollower', incrementing the counter.
+-- Call this after 'restartServer' to ensure the test does not race ahead
+-- before db-sync has actually reconnected.
+waitForNextConnection :: ServerHandle IO blk -> IO ()
+waitForNextConnection sh = do
+  -- Snapshot the current follower id before the restart connection comes in.
+  currentId <- atomically $ nextFollowerId <$> readTVar (chainProducerState sh)
+  -- Block until a new follower (with a higher id) has been registered.
+  atomically $ do
+    cps <- readTVar (chainProducerState sh)
+    unless (nextFollowerId cps > currentId) retry
+
 type MockServerConstraint blk =
   ( SerialiseNodeToClientConstraints blk
   , BlockSupportsLedgerQuery blk
@@ -182,7 +201,7 @@ forkServerThread iom config initSt netMagic path = do
   let runThread = async $ runLocalServer iom (configCodec config) netMagic path chainSt
   thread <- runThread
   threadVar <- newTVarIO thread
-  pure $ ServerHandle chainSt threadVar runThread
+  pure $ ServerHandle chainSt threadVar runThread path
 
 withServerHandle ::
   MockServerConstraint blk =>
@@ -262,7 +281,7 @@ runLocalServer iom codecConfig netMagic localDomainSock chainProdState = do
           IO ((), Maybe ByteString)
         chainSyncServer' _them channel =
           runPeer
-            nullTracer -- (showTracing stdoutTracer)
+            nullTracer
             (cChainSyncCodec codecs)
             channel
             (chainSyncServerPeer $ chainSyncServer state codecConfig blockVersion)
@@ -332,9 +351,10 @@ chainSyncServer state codec _blockVersion =
       mupdate <- tryReadChainUpdate r
       case mupdate of
         Just update -> pure (Left (sendNext r update))
-        Nothing -> pure (Right (sendNext r <$> readChainUpdate r))
-    -- Follower is at the head, have to block and wait for
-    -- the producer's state to change.
+        Nothing ->
+          -- Follower is at the head, have to block and wait for
+          -- the producer's state to change.
+          pure $ Right $ sendNext r <$> readChainUpdate r
 
     handleFindIntersect ::
       FollowerId ->
@@ -352,13 +372,14 @@ chainSyncServer state codec _blockVersion =
       ServerStNext (Serialised blk) (Point blk) (Tip blk) m ()
     sendNext r (tip, AddBlock b) =
       SendMsgRollForward (mkSerialised (encodeDisk codec) b) tip (idle' r)
-    sendNext r (tip, RollBack p) = SendMsgRollBackward (castPoint p) tip (idle' r)
+    sendNext r (tip, RollBack p) =
+      SendMsgRollBackward (castPoint p) tip (idle' r)
 
     newFollower :: m FollowerId
     newFollower = atomically $ do
       cps <- readTVar state
       let (cps', rid) = initFollower genesisPoint cps
-      _ <- writeTVar state cps'
+      writeTVar state cps'
       pure rid
 
     improveReadPoint ::

cardano-chain-gen/test/Test/Cardano/Db/Mock/Property/Property.hs

@@ -56,6 +56,8 @@ data Model r = Model
   , dbSyncMaxBlockNo :: Maybe BlockNo
   , dbSynsIsOn :: Bool
   , dbSynsHasSynced :: Bool -- This is used just to avoid restarting the node too early.
+  , dbSyncNeedsResync :: Bool -- True after RestartNode until at least one RollForward, to avoid
+  -- generating AssertBlockNo before db-sync has had a chance to reconnect.
   }
   deriving stock (Generic, Show)
 
@@ -103,7 +105,7 @@ instance ToExpr (Model Symbolic)
 instance ToExpr (Model Concrete)
 
 initModel :: Model r
-initModel = Model [] [] Nothing False False
+initModel = Model [] [] Nothing False False False
 
 data Response r
   = NewBlockAdded (Reference (Opaque CardanoBlock) r)
@@ -127,6 +129,7 @@ transition m cmd resp = case (cmd, resp) of
      in m
           { serverChain = serverChain'
           , dbSyncMaxBlockNo = dbSyncMaxBlockNo'
+          , dbSyncNeedsResync = False
           }
   (RollBack blkNo, _) ->
     m {serverChain = rollbackChain blkNo (serverChain m)}
@@ -144,7 +147,7 @@ transition m cmd resp = case (cmd, resp) of
       , dbSynsHasSynced = False
       }
   (RestartNode, _) ->
-    m
+    m {dbSyncNeedsResync = True}
   (AssertBlockNo n, _) ->
     m
       { dbSynsHasSynced = True
@@ -157,13 +160,13 @@ precondition m cmd = case cmd of
   RollBack n -> n .< serverTip m -- can it be equal?
   StopDBSync -> Boolean $ dbSynsIsOn m && dbSynsHasSynced m
   StartDBSync -> Boolean $ not $ dbSynsIsOn m
-  RestartNode -> Boolean $ dbSynsHasSynced m
+  RestartNode -> Boolean $ dbSynsHasSynced m && dbSynsIsOn m
   AssertBlockNo n | Just n' <- canAssert m -> n .== n'
   _ -> Bot
 
 canAssert :: Model Symbolic -> Maybe (Maybe BlockNo)
 canAssert m =
-  if stip >= dbtip
+  if not (dbSyncNeedsResync m) && stip >= dbtip
     then Just stip
     else Nothing
   where
@@ -186,7 +189,7 @@ semantics interpreter mockServer dbSync cmd = case cmd of
       Just pnt -> Unit <$> rollbackTo interpreter mockServer pnt
   StopDBSync -> Unit <$> stopDBSync dbSync
   StartDBSync -> Unit <$> startDBSync dbSync
-  RestartNode -> Unit <$> restartServer mockServer
+  RestartNode -> Unit <$> (restartServer mockServer >> waitForNextConnection mockServer)
   AssertBlockNo mBlkNo -> runAssert dbSync mBlkNo
 
 runAssert :: DBSyncEnv -> Maybe BlockNo -> IO (Response Concrete)
@@ -220,7 +223,7 @@ generator m =
       , (if not canRollback then 0 else if isOn then 10 else 20, genRollBack m)
       , (if isOn then 30 else 0, genStopDBSync m)
       , (if isOn then 0 else 60, genStartDBSync m)
-      , (if isOn then 20 else 5, genRestartNode m)
+      , (if isOn then 20 else 0, genRestartNode m)
       , (if isOn && isJust serverNotBehind then 30 else 0, genAssertBlockNo m)
       ]
   where

cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Babbage/Simple.hs

@@ -8,7 +8,7 @@ module Test.Cardano.Db.Mock.Unit.Babbage.Simple (
 ) where
 
 import Cardano.Ledger.BaseTypes (BlockNo (BlockNo))
-import Cardano.Mock.ChainSync.Server (IOManager, addBlock, restartServer)
+import Cardano.Mock.ChainSync.Server (IOManager, addBlock, restartServer, waitForNextConnection)
 import Cardano.Mock.Forging.Interpreter (forgeNext)
 import Control.Concurrent.Class.MonadSTM.Strict (atomically)
 import Control.Monad (void)
@@ -80,13 +80,20 @@ restartDBSync =
 nodeRestart :: IOManager -> [(Text, Text)] -> Assertion
 nodeRestart =
   withFullConfig babbageConfigDir testLabel $ \interpreter mockServer dbSync -> do
-    startDBSync dbSync
+    -- Forge blocks before starting db-sync so it syncs them cleanly in one shot.
     void $ forgeAndSubmitBlocks interpreter mockServer 5
+    startDBSync dbSync
     assertBlockNoBackoff dbSync 5
 
     restartServer mockServer
-
-    void $ forgeAndSubmitBlocks interpreter mockServer 5
+    -- Wait for db-sync to actually reconnect to the restarted server before
+    -- forging new blocks. Without this, the mux bearer on macOS CI takes up to
+    -- 24s to detect the closed connection, and the 51s assertion budget may be
+    -- exhausted before db-sync reconnects.
+    waitForNextConnection mockServer
+    void $ forgeAndSubmitBlocks interpreter mockServer 1
+    assertBlockNoBackoff dbSync 6
+    void $ forgeAndSubmitBlocks interpreter mockServer 4
     assertBlockNoBackoff dbSync 10
   where
     testLabel = "nodeRestart"
@@ -99,8 +106,12 @@ nodeRestartBoundary =
     assertBlockNoBackoff dbSync $ length blks
 
     restartServer mockServer
-
-    void $ forgeAndSubmitBlocks interpreter mockServer 5
+    -- Wait for db-sync to actually reconnect to the restarted server before
+    -- forging new blocks and asserting.
+    waitForNextConnection mockServer
+    void $ forgeAndSubmitBlocks interpreter mockServer 1
+    assertBlockNoBackoff dbSync $ length blks + 1
+    void $ forgeAndSubmitBlocks interpreter mockServer 4
     assertBlockNoBackoff dbSync $ 5 + length blks
   where
     testLabel = "nodeRestartBoundary"

cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Governance.hs

@@ -485,7 +485,7 @@ hardFork =
 -- indexes them without errors.
 hardForkPostBlock :: IOManager -> [(Text, Text)] -> Assertion
 hardForkPostBlock =
-  withFullConfigLog conwayConfigDir testLabel $ \interpreter server dbSync -> do
+  withFullConfig conwayConfigDir testLabel $ \interpreter server dbSync -> do
     startDBSync dbSync
 
     -- Register SPOs, DReps, and committee to vote

cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Conway/Simple.hs

@@ -8,7 +8,7 @@ module Test.Cardano.Db.Mock.Unit.Conway.Simple (
 ) where
 
 import Cardano.Ledger.BaseTypes (BlockNo (..))
-import Cardano.Mock.ChainSync.Server (IOManager, addBlock, restartServer)
+import Cardano.Mock.ChainSync.Server (IOManager, addBlock, restartServer, waitForNextConnection)
 import Cardano.Mock.Forging.Interpreter (forgeNext)
 import Cardano.Prelude
 import Ouroboros.Network.Block (blockNo)
@@ -85,8 +85,11 @@ nodeRestart =
     assertBlockNoBackoff dbSync 5
 
     restartServer mockServer
-
-    void $ forgeAndSubmitBlocks interpreter mockServer 5
+    -- Wait for db-sync to actually reconnect before forging new blocks.
+    waitForNextConnection mockServer
+    void $ forgeAndSubmitBlocks interpreter mockServer 1
+    assertBlockNoBackoff dbSync 6
+    void $ forgeAndSubmitBlocks interpreter mockServer 4
     assertBlockNoBackoff dbSync 10
   where
     testLabel = "conwayNodeRestart"
@@ -99,8 +102,11 @@ nodeRestartBoundary =
     assertBlockNoBackoff dbSync $ length blks
 
     restartServer mockServer
-
-    void $ forgeAndSubmitBlocks interpreter mockServer 5
+    -- Wait for db-sync to actually reconnect before forging new blocks.
+    waitForNextConnection mockServer
+    void $ forgeAndSubmitBlocks interpreter mockServer 1
+    assertBlockNoBackoff dbSync $ length blks + 1
+    void $ forgeAndSubmitBlocks interpreter mockServer 4
     assertBlockNoBackoff dbSync $ 5 + length blks
   where
     testLabel = "conwayNodeRestartBoundary"