Bump dependencies

IntersectMBO · Jan 20, 2021 · 5193a25 · 5193a25
1 parent cf943e0
commit 5193a25
Show file tree

Hide file tree

Showing 5 changed files with 50 additions and 34 deletions.
diff --git a/cabal.project b/cabal.project
@@ -72,8 +72,8 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-ledger-specs
-  tag: cf3b01490a2cc7ebbb5ac6f7a4de79e8b1d5c70f
-  --sha256: 1v15xqy0qvb7ll4080pplrq2ygqgnf443kaq5i6mj0105941mcjc
+  tag: 3b27f2d472972f64fe2f59f9b7b2d0d2ccb1efaa
+  --sha256: 1yqx0nxi907q4a3rby31nxmryqv8in0y4fmvk3z4zjcqwn3rpi0v
   subdir:
     byron/crypto
     byron/crypto/test
@@ -91,8 +91,8 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-node
-  tag: b681ab7bbc7e21d151d9e51ded0ef995fc81d6e3
-  --sha256: 1m3c4jv728grn8gf15plldh2qbpcb203dd2x3j4qqlmr5l3xnk66
+  tag: 94f79cc9d637af569836cd30828681875c2f986a
+  --sha256: 1m2djxvm9w0y0h5d5jsg7xn91aasyh7gx8knqjw0a24ihh8cqajw
   subdir:
     cardano-api
     cardano-config
@@ -132,8 +132,8 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/ouroboros-network
-  tag: 8b176d11ccf5946fc3f715623cc779c3c449dc8d
-  --sha256: 0bn9zgx4vrxizxw79ay2dskh8l1lywz6jb4h8h2ikipi7bvkxq7m
+  tag: 7bfdf6ec5ab41e8ea690bfee994688db0d3cf3d0
+  --sha256: 11zgfwqqjvy9halv2iy2h1d5jmzdgw8pbp2a1w4zrav3mhckikpb
   subdir:
     cardano-client
     io-sim

diff --git a/cardano-db-sync/src/Cardano/DbSync.hs b/cardano-db-sync/src/Cardano/DbSync.hs
@@ -27,7 +27,7 @@ import           Control.Tracer (Tracer)
 
 import           Cardano.BM.Data.Tracer (ToLogObject (..))
 import qualified Cardano.BM.Setup as Logging
-import           Cardano.BM.Trace (Trace, appendName, logInfo, logWarning)
+import           Cardano.BM.Trace (Trace, appendName, logInfo, logWarning, logError)
 import qualified Cardano.BM.Trace as Logging
 
 import qualified Cardano.Chain.Genesis as Byron
@@ -84,7 +84,7 @@ import           Ouroboros.Consensus.Shelley.Ledger.Config (CodecConfig (Shelley
 import           Ouroboros.Consensus.Shelley.Protocol (StandardCrypto)
 
 import           Ouroboros.Network.Block (BlockNo (..), HeaderHash, Point (..), Tip (..), blockNo,
-                   genesisPoint, getTipBlockNo, getTipPoint)
+                   genesisPoint, getTipBlockNo)
 import           Ouroboros.Network.Mux (MuxPeer (..), RunMiniProtocol (..))
 import           Ouroboros.Network.NodeToClient (ClientSubscriptionParams (..), ConnectionId,
                    ErrorPolicyTrace (..), Handshake, IOManager, LocalAddress,
@@ -215,7 +215,7 @@ dbSyncProtocols
     -> ClientCodecs CardanoBlock IO
     -> ConnectionId LocalAddress
     -> NodeToClientProtocols 'InitiatorMode BSL.ByteString IO () Void
-dbSyncProtocols trce env plugin queryVar ledgerVar _version codecs _connectionId =
+dbSyncProtocols trce env plugin queryVar ledgerVar version codecs _connectionId =
     NodeToClientProtocols
       { localChainSyncProtocol = localChainSyncPtcl
       , localTxSubmissionProtocol = dummylocalTxSubmit
@@ -229,6 +229,10 @@ dbSyncProtocols trce env plugin queryVar ledgerVar _version codecs _connectionId
     localChainSyncPtcl = InitiatorProtocolOnly $ MuxPeerRaw $ \channel ->
       liftIO . logException trce "ChainSyncWithBlocksPtcl: " $ do
         logInfo trce "Starting chainSyncClient"
+        logInfo trce $ "Starting chainSyncClient"
+        when (version < minVersion) $ do
+          logError trce $ versionErrorMsg
+          throwIO $ ErrorCall $ Text.unpack versionErrorMsg
         latestPoints <- getLatestPoints (envLedgerStateDir env)
         currentTip <- getCurrentTipBlockNo
         logDbState trce
@@ -263,6 +267,14 @@ dbSyncProtocols trce env plugin queryVar ledgerVar _version codecs _connectionId
         (cStateQueryCodec codecs)
         (localStateQueryClientPeer (localStateQueryHandler queryVar))
 
+    versionErrorMsg :: Text
+    versionErrorMsg = Text.concat
+        [ Text.pack $ show version
+        , " is not enough. We need at least "
+        , Text.pack $ show minVersion ]
+
+    minVersion :: Network.NodeToClientVersion
+    minVersion = Network.NodeToClientV_8
 
 logDbState :: Trace IO Text -> IO ()
 logDbState trce = do
@@ -372,7 +384,7 @@ chainSyncClient trce env queryVar metrics latestPoints currentTip actionQueue =
                     threadDelay (60 * 1000 * 1000)
                   else do
                     Gauge.set (withOrigin 0 (fromIntegral . unBlockNo) (getTipBlockNo tip)) (mNodeHeight metrics)
-                    details <- getSlotDetails trce env queryVar (getTipPoint tip) (cardanoBlockSlotNo blk)
+                    details <- getSlotDetails trce env queryVar (cardanoBlockSlotNo blk)
                     newSize <- atomically $ do
                                 writeDbActionQueue actionQueue $ mkDbApply blk details
                                 lengthDbActionQueue actionQueue

diff --git a/cardano-db-sync/src/Cardano/DbSync/StateQuery.hs b/cardano-db-sync/src/Cardano/DbSync/StateQuery.hs
@@ -52,8 +52,7 @@ import           System.IO.Unsafe (unsafePerformIO)
 newtype StateQueryTMVar blk result = StateQueryTMVar
   { unStateQueryTMVar ::
       TMVar
-        ( Point blk
-        , Query blk result
+        ( Query blk result
         , TMVar (Either AcquireFailure result)
         )
   }
@@ -68,14 +67,14 @@ newStateQueryTMVar = StateQueryTMVar <$> newEmptyTMVarIO
 getSlotDetails
     :: Trace IO Text -> DbSyncEnv
     -> StateQueryTMVar (HardForkBlock (CardanoEras StandardCrypto)) (Interpreter (CardanoEras StandardCrypto))
-    -> Point (HardForkBlock (CardanoEras StandardCrypto)) -> SlotNo
+    -> SlotNo
     -> IO SlotDetails
-getSlotDetails tracer env queryVar point slot = do
-    einterp1 <- maybe (getHistoryInterpreter tracer queryVar point) pure =<< readIORef historyInterpVar
+getSlotDetails tracer env queryVar slot = do
+    einterp1 <- maybe (getHistoryInterpreter tracer queryVar) pure =<< readIORef historyInterpVar
     case evalSlotDetails einterp1 of
       Right sd -> insertCurrentTime sd
       Left _ -> do
-        einterp2 <- getHistoryInterpreter tracer queryVar point
+        einterp2 <- getHistoryInterpreter tracer queryVar
         case evalSlotDetails einterp2 of
           Left err -> panic $ "getSlotDetails: " <> textShow err
           Right sd -> insertCurrentTime sd
@@ -98,11 +97,10 @@ historyInterpVar = unsafePerformIO $ newIORef Nothing
 getHistoryInterpreter
     :: Trace IO Text
     -> StateQueryTMVar (HardForkBlock (CardanoEras StandardCrypto)) (Interpreter (CardanoEras StandardCrypto))
-    -> Point (HardForkBlock (CardanoEras StandardCrypto))
     -> IO (Interpreter (CardanoEras StandardCrypto))
-getHistoryInterpreter tracer queryVar point = do
+getHistoryInterpreter tracer queryVar = do
   respVar <- newEmptyTMVarIO
-  atomically $ putTMVar (unStateQueryTMVar queryVar) (point, QueryHardFork GetInterpreter, respVar)
+  atomically $ putTMVar (unStateQueryTMVar queryVar) (QueryHardFork GetInterpreter, respVar)
   res <- atomically $ takeTMVar respVar
   case res of
     Left err ->
@@ -124,9 +122,9 @@ localStateQueryHandler (StateQueryTMVar reqVar) =
   where
     idleState :: IO (StateQuery.ClientStIdle block (Point block) (Query block) IO a)
     idleState = do
-      (point, query, respVar) <- atomically $ takeTMVar reqVar
+      (query, respVar) <- atomically $ takeTMVar reqVar
       pure $
-        SendMsgAcquire point $
+        SendMsgAcquire Nothing $
           ClientStAcquiring
             { recvMsgAcquired =
                 SendMsgQuery query $

diff --git a/cardano-db-tool/cardano-db-tool.cabal b/cardano-db-tool/cardano-db-tool.cabal
@@ -50,6 +50,7 @@ library
                       , cardano-db
                       , cardano-db-sync
                       , cardano-ledger
+                      , cardano-ledger-shelley-ma
                       , cardano-prelude
                       , cardano-slotting
                       , containers

diff --git a/cardano-db-tool/src/Cardano/Db/Tool/Validate/Balance.hs b/cardano-db-tool/src/Cardano/Db/Tool/Validate/Balance.hs
@@ -15,10 +15,10 @@ import           Cardano.Chain.Common (CompactAddress, Lovelace, decodeAddressBa
                    toCompactAddress, unsafeGetLovelace)
 import qualified Cardano.Chain.UTxO as Byron
 
+import qualified Cardano.Ledger.Core as Core
 import           Cardano.Ledger.Era (Crypto)
 
 import           Cardano.Ledger.Compactible
-import           Cardano.Ledger.Shelley.Constraints
 import           Cardano.Ledger.Val
 import           Cardano.Prelude
 
@@ -63,25 +63,30 @@ getByronBalance addrText utxo = do
         then Just lovelace
         else Nothing
 
-getShelleyBalance
-    :: forall era. ShelleyBased era
-    => Text -> Shelley.UTxO era -> Either Text Word64
+getShelleyBalance :: forall era.
+                     ( Core.TxOut era ~ Shelley.TxOut era -- somewhere in ledger-spec, there is probably a better constraint synonym for these
+                     , Compactible (Core.Value era)
+                     , Val (Core.Value era))
+                  => Text -> Shelley.UTxO era -> Either Text Word64
 getShelleyBalance addrText utxo = do
-    caddr <- case Api.deserialiseAddress (Api.AsAddress Api.AsShelleyAddr) addrText of
-              Nothing ->
-                case decodeAddressBase58 addrText of
-                  Left err ->  Left $ textShow err
-                  Right badrr -> Right $ compactAddr (AddrBootstrap $ BootstrapAddress badrr)
-              Just (Api.ShelleyAddress n p s) ->
-                let addr = Addr n (coerce p) (coerce s)
-                in Right $ compactAddr addr
+    caddr <- getCompactAddress addrText
     Right . fromIntegral . sum $ unCoin <$> mapMaybe (compactTxOutValue caddr) (Map.elems $ Shelley.unUTxO utxo)
   where
-    compactTxOutValue :: CompactAddr (Crypto era) -> Shelley.TxOut era -> Maybe Coin
+    compactTxOutValue :: CompactAddr (Crypto era) -> Core.TxOut era -> Maybe Coin
     compactTxOutValue caddr (Shelley.TxOutCompact scaddr v) =
       if caddr == scaddr
         then Just $ coin (fromCompact v)
         else Nothing
 
+getCompactAddress :: Text -> Either Text (CompactAddr c)
+getCompactAddress addrText = case Api.deserialiseAddress (Api.AsAddress Api.AsShelleyAddr) addrText of
+    Nothing ->
+      case decodeAddressBase58 addrText of
+        Left err ->  Left $ textShow err
+        Right badrr -> Right $ compactAddr (AddrBootstrap $ BootstrapAddress badrr)
+    Just (Api.ShelleyAddress n p s) ->
+      let addr = Addr n (coerce p) (coerce s)
+      in Right $ compactAddr addr
+
 textShow :: Show a => a -> Text
 textShow = Text.pack . show