Fix network layer logging

cardano-foundation · Sep 17, 2020 · e571aaf · e571aaf
1 parent 323fb02
commit e571aaf
Show file tree

Hide file tree

Showing 3 changed files with 54 additions and 55 deletions.
diff --git a/lib/shelley/src/Cardano/Wallet/Shelley.hs b/lib/shelley/src/Cardano/Wallet/Shelley.hs
@@ -468,7 +468,7 @@ data Tracers' f = Tracers
     , poolsEngineTracer  :: f (WorkerLog Text StakePoolLog)
     , poolsDbTracer      :: f PoolDbLog
     , ntpClientTracer    :: f NtpTrace
-    , networkTracer      :: f (NetworkLayerLog StandardCrypto)
+    , networkTracer      :: f NetworkLayerLog
     }
 
 -- | All of the Shelley 'Tracer's.

diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs
@@ -923,9 +923,9 @@ instance EncodeStakeAddress ('Testnet pm) where
     encodeStakeAddress = _encodeStakeAddress SL.Testnet
 
 instance DecodeStakeAddress 'Mainnet where
-    decodeStakeAddress = _decodeStakeAddress @StandardCrypto SL.Mainnet
+    decodeStakeAddress = _decodeStakeAddress SL.Mainnet
 instance DecodeStakeAddress ('Testnet pm) where
-    decodeStakeAddress = _decodeStakeAddress @StandardCrypto SL.Testnet
+    decodeStakeAddress = _decodeStakeAddress SL.Testnet
 
 stakeAddressPrefix :: Word8
 stakeAddressPrefix = 0xE0
@@ -953,14 +953,13 @@ _encodeStakeAddress network (W.ChimericAccount acct) =
         putByteString acct
 
 _decodeStakeAddress
-    :: forall c. SL.Crypto c
-    => SL.Network
+    :: SL.Network
     -> Text
     -> Either TextDecodingError W.ChimericAccount
 _decodeStakeAddress serverNetwork txt = do
     (_, dp) <- left (const errBech32) $ Bech32.decodeLenient txt
     bytes <- maybe (Left errBech32) Right $ dataPartToBytes dp
-    rewardAcnt <- runGetOrFail' (SL.getRewardAcnt @(SL.Shelley c)) bytes
+    rewardAcnt <- runGetOrFail' (SL.getRewardAcnt @(SL.Shelley StandardCrypto)) bytes
 
     guardNetwork (SL.getRwdNetwork rewardAcnt) serverNetwork
 

diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Network.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Network.hs
@@ -274,16 +274,16 @@ data instance Cursor (m Shelley) = Cursor
 
 -- | Create an instance of the network layer
 withNetworkLayer
-    :: forall sc a. (HasCallStack, sc ~ StandardCrypto)
-    => Tracer IO (NetworkLayerLog sc)
+    :: HasCallStack
+    => Tracer IO NetworkLayerLog
         -- ^ Logging of network layer startup
     -> W.NetworkParameters
         -- ^ Initial blockchain parameters
     -> FilePath
         -- ^ Socket for communicating with the node
     -> (NodeToClientVersionData, CodecCBORTerm Text NodeToClientVersionData)
         -- ^ Codecs for the node's client
-    -> (NetworkLayer IO (IO Shelley) (CardanoBlock sc) -> IO a)
+    -> (NetworkLayer IO (IO Shelley) (CardanoBlock StandardCrypto) -> IO a)
         -- ^ Callback function with the network layer
     -> IO a
 withNetworkLayer tr np addrInfo versionData action = do
@@ -567,7 +567,7 @@ mkWalletClient tr gp chainSyncQ = do
 -- purposes of querying delegations and rewards.
 mkDelegationRewardsClient
     :: forall m. (MonadThrow m, MonadST m, MonadTimer m)
-    => Tracer m (NetworkLayerLog StandardCrypto)
+    => Tracer m NetworkLayerLog
         -- ^ Base trace for underlying protocols
     -> CodecConfig (CardanoBlock StandardCrypto)
     -> TQueue m (LocalStateQueryCmd (CardanoBlock StandardCrypto) m)
@@ -637,7 +637,7 @@ type CardanoInterpreter sc = Interpreter (CardanoEras sc)
 --  * Querying the history interpreter as necessary.
 mkTipSyncClient
     :: forall m. (HasCallStack, MonadIO m, MonadThrow m, MonadST m, MonadTimer m)
-    => Tracer m (NetworkLayerLog StandardCrypto)
+    => Tracer m NetworkLayerLog
         -- ^ Base trace for underlying protocols
     -> W.NetworkParameters
         -- ^ Initial blockchain parameters
@@ -777,7 +777,7 @@ data Observer m key value = Observer
     }
 
 newRewardBalanceFetcher
-    :: forall sc. Tracer IO (NetworkLayerLog StandardCrypto)
+    :: Tracer IO NetworkLayerLog
     -> W.GenesisParameters
     -- ^ Used to convert tips for logging
     -> TQueue IO (LocalStateQueryCmd (CardanoBlock StandardCrypto) IO)
@@ -929,7 +929,7 @@ timeQryAndLog
     :: MonadIO m
     => String
     -- ^ Label to identify the query
-    -> Tracer m (NetworkLayerLog StandardCrypto)
+    -> Tracer m NetworkLayerLog
     -- ^ Tracer to which the measurement will be logged
     -> m a
     -- ^ The action that submits the query.
@@ -954,7 +954,7 @@ doNothingProtocol =
 --
 -- >>> connectClient (mkWalletClient tr gp queue) mainnetVersionData addrInfo
 connectClient
-    :: Tracer IO (NetworkLayerLog StandardCrypto)
+    :: Tracer IO NetworkLayerLog
     -> RetryHandlers
     -> NetworkClient IO
     -> (NodeToClientVersionData, CodecCBORTerm Text NodeToClientVersionData)
@@ -980,7 +980,7 @@ connectClient tr handlers client (vData, vCodec) addr = withIOManager $ \iocp ->
 type RetryHandlers = [RetryStatus -> Handler IO Bool]
 
 -- | Handlers that are retrying on every connection lost.
-retryOnConnectionLost :: Tracer IO (NetworkLayerLog StandardCrypto) -> RetryHandlers
+retryOnConnectionLost :: Tracer IO NetworkLayerLog -> RetryHandlers
 retryOnConnectionLost tr =
     [ const $ Handler $ handleIOException tr' True
     , const $ Handler $ handleMuxError tr' True
@@ -989,7 +989,7 @@ retryOnConnectionLost tr =
     tr' = contramap MsgConnectionLost tr
 
 -- | Handlers that are failing if the connection is lost
-failOnConnectionLost :: Tracer IO (NetworkLayerLog StandardCrypto) -> RetryHandlers
+failOnConnectionLost :: Tracer IO NetworkLayerLog -> RetryHandlers
 failOnConnectionLost tr =
     [ const $ Handler $ handleIOException tr' False
     , const $ Handler $ handleMuxError tr' False
@@ -1051,51 +1051,51 @@ handleMuxError tr onResourceVanished = pure . errorType >=> \case
                                     Logging
 -------------------------------------------------------------------------------}
 
-data NetworkLayerLog sc where
-    MsgCouldntConnect :: Int -> NetworkLayerLog sc
-    MsgConnectionLost :: Maybe IOException -> NetworkLayerLog sc
+data NetworkLayerLog where
+    MsgCouldntConnect :: Int -> NetworkLayerLog
+    MsgConnectionLost :: Maybe IOException -> NetworkLayerLog
     MsgTxSubmission
         :: (TraceSendRecv
-            (LocalTxSubmission (GenTx (CardanoBlock sc)) (CardanoApplyTxErr sc)))
-        -> NetworkLayerLog sc
+            (LocalTxSubmission (GenTx (CardanoBlock StandardCrypto)) (CardanoApplyTxErr StandardCrypto)))
+        -> NetworkLayerLog
     MsgLocalStateQuery
         :: QueryClientName
         -> (TraceSendRecv
-            (LocalStateQuery (CardanoBlock sc) (Query (CardanoBlock sc))))
-        -> NetworkLayerLog sc
+            (LocalStateQuery (CardanoBlock StandardCrypto) (Query (CardanoBlock StandardCrypto))))
+        -> NetworkLayerLog
     MsgHandshakeTracer ::
-      (WithMuxBearer (ConnectionId LocalAddress) HandshakeTrace) -> NetworkLayerLog sc
-    MsgFindIntersection :: [W.BlockHeader] -> NetworkLayerLog sc
-    MsgIntersectionFound :: (W.Hash "BlockHeader") -> NetworkLayerLog sc
-    MsgFindIntersectionTimeout :: NetworkLayerLog sc
-    MsgPostTx :: CardanoGenTx sc -> NetworkLayerLog sc
-    MsgPostSealedTx :: W.SealedTx -> NetworkLayerLog sc
-    MsgNodeTip :: W.BlockHeader -> NetworkLayerLog sc
-    MsgProtocolParameters :: W.ProtocolParameters -> NetworkLayerLog sc
-    MsgLocalStateQueryError :: QueryClientName -> String -> NetworkLayerLog sc
-    MsgLocalStateQueryEraMismatch :: MismatchEraInfo (CardanoEras sc) -> NetworkLayerLog sc
+      (WithMuxBearer (ConnectionId LocalAddress) HandshakeTrace) -> NetworkLayerLog
+    MsgFindIntersection :: [W.BlockHeader] -> NetworkLayerLog
+    MsgIntersectionFound :: (W.Hash "BlockHeader") -> NetworkLayerLog
+    MsgFindIntersectionTimeout :: NetworkLayerLog
+    MsgPostTx :: CardanoGenTx StandardCrypto -> NetworkLayerLog
+    MsgPostSealedTx :: W.SealedTx -> NetworkLayerLog
+    MsgNodeTip :: W.BlockHeader -> NetworkLayerLog
+    MsgProtocolParameters :: W.ProtocolParameters -> NetworkLayerLog
+    MsgLocalStateQueryError :: QueryClientName -> String -> NetworkLayerLog
+    MsgLocalStateQueryEraMismatch :: MismatchEraInfo (CardanoEras StandardCrypto) -> NetworkLayerLog
     MsgGetRewardAccountBalance
         :: W.BlockHeader
         -> Set W.ChimericAccount
-        -> NetworkLayerLog sc
+        -> NetworkLayerLog
     MsgAccountDelegationAndRewards
-        :: (Map (SL.Credential 'SL.Staking (SL.Shelley sc)) (SL.KeyHash 'SL.StakePool (SL.Shelley sc)))
-        -> SL.RewardAccounts (SL.Shelley sc)
-        -> NetworkLayerLog sc
-    MsgDestroyCursor :: ThreadId -> NetworkLayerLog sc
-    MsgWillQueryRewardsForStake :: W.Coin -> NetworkLayerLog sc
-    MsgFetchedNodePoolLsqData :: Maybe NodePoolLsqData -> NetworkLayerLog sc
-    MsgFetchedNodePoolLsqDataSummary :: Int -> Int -> NetworkLayerLog sc
+        :: (Map (SL.Credential 'SL.Staking (SL.Shelley StandardCrypto)) (SL.KeyHash 'SL.StakePool (SL.Shelley StandardCrypto)))
+        -> SL.RewardAccounts (SL.Shelley StandardCrypto)
+        -> NetworkLayerLog
+    MsgDestroyCursor :: ThreadId -> NetworkLayerLog
+    MsgWillQueryRewardsForStake :: W.Coin -> NetworkLayerLog
+    MsgFetchedNodePoolLsqData :: Maybe NodePoolLsqData -> NetworkLayerLog
+    MsgFetchedNodePoolLsqDataSummary :: Int -> Int -> NetworkLayerLog
       -- ^ Number of pools in stake distribution, and rewards map,
       -- respectively.
-    MsgWatcherUpdate :: W.BlockHeader -> BracketLog -> NetworkLayerLog sc
-    MsgChainSyncCmd :: (ChainSyncLog Text Text) -> NetworkLayerLog sc
-    MsgInterpreter :: CardanoInterpreter sc -> NetworkLayerLog sc
-    MsgInterpreterPastHorizon :: PastHorizonException -> NetworkLayerLog sc
-    MsgQueryTime :: String -> NominalDiffTime -> NetworkLayerLog sc
+    MsgWatcherUpdate :: W.BlockHeader -> BracketLog -> NetworkLayerLog
+    MsgChainSyncCmd :: (ChainSyncLog Text Text) -> NetworkLayerLog
+    MsgInterpreter :: CardanoInterpreter StandardCrypto -> NetworkLayerLog
+    MsgInterpreterPastHorizon :: PastHorizonException -> NetworkLayerLog
+    MsgQueryTime :: String -> NominalDiffTime -> NetworkLayerLog
     MsgObserverLog
         :: ObserverLog W.ChimericAccount W.Coin
-        -> NetworkLayerLog sc
+        -> NetworkLayerLog
 
 data QueryClientName
     = TipSyncClient
@@ -1104,7 +1104,7 @@ data QueryClientName
 
 type HandshakeTrace = TraceSendRecv (Handshake NodeToClientVersion CBOR.Term)
 
-instance ToText (NetworkLayerLog sc) where
+instance ToText NetworkLayerLog where
     toText = \case
         MsgCouldntConnect n -> T.unwords
             [ "Couldn't connect to node (x" <> toText (n + 1) <> ")."
@@ -1113,11 +1113,11 @@ instance ToText (NetworkLayerLog sc) where
         MsgConnectionLost Nothing  ->
             "Connection lost with the node."
         MsgConnectionLost (Just e) -> T.unwords
-            [ toText @(NetworkLayerLog sc) (MsgConnectionLost Nothing)
+            [ toText (MsgConnectionLost Nothing)
             , T.pack (show e)
             ]
         MsgTxSubmission msg ->
-            T.pack "fixme" -- (show msg)
+            T.pack (show msg)
         MsgHandshakeTracer (WithMuxBearer conn h) ->
             pretty conn <> " " <> T.pack (show h)
         MsgFindIntersectionTimeout ->
@@ -1134,10 +1134,10 @@ instance ToText (NetworkLayerLog sc) where
             ]
         MsgPostTx genTx -> T.unwords
             [ "Posting transaction:"
-            , T.pack "fixme" -- $ show genTx
+            , T.pack $ show genTx
             ]
         MsgLocalStateQuery client msg ->
-            T.pack (show client <> " " <> "fixme") -- show msg)
+            T.pack (show client <> " " <> show msg)
         MsgNodeTip bh -> T.unwords
             [ "Network node tip is"
             , pretty bh
@@ -1154,7 +1154,7 @@ instance ToText (NetworkLayerLog sc) where
             ]
         MsgLocalStateQueryEraMismatch mismatch ->
             "Local state query for the wrong era - this is fine. " <>
-            T.pack "fixme" -- (show mismatch)
+            T.pack (show mismatch)
         MsgGetRewardAccountBalance tip accts -> T.unwords
             [ "Querying the reward account balance for"
             , fmt $ listF accts
@@ -1193,8 +1193,8 @@ instance ToText (NetworkLayerLog sc) where
 
         MsgObserverLog msg -> toText msg
 
-instance HasPrivacyAnnotation (NetworkLayerLog b)
-instance HasSeverityAnnotation (NetworkLayerLog b) where
+instance HasPrivacyAnnotation NetworkLayerLog
+instance HasSeverityAnnotation NetworkLayerLog where
     getSeverityAnnotation = \case
         MsgCouldntConnect 0                -> Debug
         MsgCouldntConnect 1                -> Notice