Skip to content

Commit

Permalink
PLT-5481 - Link Block Number to explorer
Browse files Browse the repository at this point in the history
  • Loading branch information
@palas
palas committed Apr 1, 2023
1 parent 7ca1854 commit 8fa06c7
Show file tree
Hide file tree
Showing 3 changed files with 42 additions and 31 deletions.
60 changes: 34 additions & 26 deletions src/Explorer/Web/ContractView.hs
View file
Expand Up @@ -16,7 +16,7 @@ import GHC.Utils.Misc (split)
import Text.Blaze.Html5 ( Html, Markup, ToMarkup(toMarkup), (!), a, b, code, p, string, ToValue (toValue) )
import Text.Blaze.Html5.Attributes ( href, style )
import Text.Printf (printf)
import Explorer.Web.Util ( tr, th, td, table, baseDoc, stringToHtml, prettyPrintAmount, makeLocalDateTime, generateLink, mkTransactinExplorerLink )
import Explorer.Web.Util ( tr, th, td, table, baseDoc, stringToHtml, prettyPrintAmount, makeLocalDateTime, generateLink, mkTransactionExplorerLink, mkBlockExplorerLink )
import Language.Marlowe.Pretty ( pretty )
import qualified Language.Marlowe.Runtime.Types.ContractJSON as CJ
import qualified Language.Marlowe.Runtime.Types.TransactionsJSON as TJs
Expand Down Expand Up @@ -75,9 +75,10 @@ extractInfo CInfoView blockExplHost CJ.ContractJSON { CJ.resource =
} _ _ =
ContractInfoView
(CIVR { civrContractId = cid
, civrContractIdLink = mkTransactinExplorerLink blockExplHost cid
, civrContractIdLink = mkTransactionExplorerLink blockExplHost cid
, civrBlockHeaderHash = blkHash
, civrBlockNo = blkNo
, civrBlockLink = mkBlockExplorerLink blockExplHost blkNo
, civrSlotNo = sltNo
, civrRoleTokenMintingPolicyId = mintingPolicyId
, civrTags = tagsMap
Expand All @@ -93,7 +94,7 @@ extractInfo CStateView blockExplHost CJ.ContractJSON { CJ.resource =
} _ _ =
ContractStateView
(CSVR { csvrContractId = cid
, csvrContractIdLink = mkTransactinExplorerLink blockExplHost cid
, csvrContractIdLink = mkTransactionExplorerLink blockExplHost cid
, currentContract = currContract
, initialContract = initContract
, currentState = currState
Expand All @@ -104,7 +105,7 @@ extractInfo CTxView blockExplHost CJ.ContractJSON { CJ.resource = CJ.Resource {
(Just (TJs.Transactions { TJs.transactions = txs })) mTx =
ContractTxView $ CTVRs { ctvrsContractId = cid
, ctvrs = map convertTx $ reverse txs
, ctvrsSelectedTransactionInfo = fmap convertTxDetails mTx
, ctvrsSelectedTransactionInfo = fmap (convertTxDetails blockExplHost) mTx
, ctvrsBlockExplHost = blockExplHost
}
where
Expand All @@ -116,34 +117,36 @@ extractInfo CTxView blockExplHost CJ.ContractJSON { CJ.resource = CJ.Resource {
}
} =
CTVR { ctvrBlock = blockNo'
, ctvrBlockLink = mkBlockExplorerLink blockExplHost blockNo'
, ctvrSlot = slotNo'
, ctvrContractId = txContractId
, ctvrTransactionId = transactionId'
}
extractInfo _ _blockExplHost _ Nothing _ = ContractViewError "Something went wrong, unable to display"

convertTxDetails :: TJ.Transaction -> CTVRTDetail
convertTxDetails TJ.Transaction { TJ.links = TJ.Link { TJ.next = mNext
, TJ.previous = mPrev
}
, TJ.resource = TJ.Resource { TJ.block = TJ.Block { TJ.blockHeaderHash = txDetailBlockHeaderHash
, TJ.blockNo = txDetailBlockNo
, TJ.slotNo = txDetailSlotNo
}
, TJ.inputs = txDetailInputs
, TJ.invalidBefore = txDetailInvalidBefore
, TJ.invalidHereafter = txDetailInvalidHereafter
, TJ.outputContract = txDetailOutputContract
, TJ.outputState = txDetailOutputState
, TJ.status = txDetailStatus
, TJ.tags = txDetailTags
, TJ.transactionId = txDetailTransactionId
}
}
convertTxDetails :: String -> TJ.Transaction -> CTVRTDetail
convertTxDetails blockExplHost TJ.Transaction { TJ.links = TJ.Link { TJ.next = mNext
, TJ.previous = mPrev
}
, TJ.resource = TJ.Resource { TJ.block = TJ.Block { TJ.blockHeaderHash = txDetailBlockHeaderHash
, TJ.blockNo = txDetailBlockNo
, TJ.slotNo = txDetailSlotNo
}
, TJ.inputs = txDetailInputs
, TJ.invalidBefore = txDetailInvalidBefore
, TJ.invalidHereafter = txDetailInvalidHereafter
, TJ.outputContract = txDetailOutputContract
, TJ.outputState = txDetailOutputState
, TJ.status = txDetailStatus
, TJ.tags = txDetailTags
, TJ.transactionId = txDetailTransactionId
}
}
= CTVRTDetail { txPrev= mPrev
, txNext= mNext
, txBlockHeaderHash = txDetailBlockHeaderHash
, txBlockNo = txDetailBlockNo
, txBlockLink = mkBlockExplorerLink blockExplHost txDetailBlockNo
, txSlotNo = txDetailSlotNo
, inputs = txDetailInputs
, invalidBefore = txDetailInvalidBefore
Expand Down Expand Up @@ -194,6 +197,7 @@ data CIVR = CIVR { civrContractId :: String
, civrContractIdLink :: String
, civrBlockHeaderHash :: String
, civrBlockNo :: Integer
, civrBlockLink :: String
, civrSlotNo :: Integer
, civrRoleTokenMintingPolicyId :: String
, civrTags :: Map String String
Expand All @@ -206,6 +210,7 @@ renderCIVR (CIVR { civrContractId = cid
, civrContractIdLink = cidLink
, civrBlockHeaderHash = blockHash
, civrBlockNo = blockNum
, civrBlockLink = blockLink
, civrSlotNo = slotNum
, civrRoleTokenMintingPolicyId = roleMintingPolicyId
, civrTags = civrTags'
Expand All @@ -217,7 +222,7 @@ renderCIVR (CIVR { civrContractId = cid
tr $ do td $ b "Block Header Hash"
td $ string blockHash
tr $ do td $ b "Block No"
td $ string (show blockNum)
td $ a ! href (toValue blockLink) $ string $ show blockNum
tr $ do td $ b "Slot No"
td $ string (show slotNum)
tr $ do td $ b "Role Token Minting Policy ID"
Expand Down Expand Up @@ -259,8 +264,9 @@ data CTVRTDetail = CTVRTDetail
txPrev :: Maybe String,
txNext :: Maybe String,
txBlockHeaderHash :: String,
txBlockNo :: Int,
txSlotNo :: Int,
txBlockNo :: Integer,
txBlockLink :: String,
txSlotNo :: Integer,
inputs :: [Input],
invalidBefore :: UTCTime,
invalidHereafter :: UTCTime,
Expand All @@ -274,6 +280,7 @@ data CTVRTDetail = CTVRTDetail

data CTVR = CTVR
{ ctvrBlock :: Integer
, ctvrBlockLink :: String
, ctvrSlot :: Integer
, ctvrContractId :: String
, ctvrTransactionId :: String
Expand Down Expand Up @@ -320,6 +327,7 @@ renderCTVRTDetail cid blockExplHost (Just CTVRTDetail { txPrev = txPrev'
, txNext = txNext'
, txBlockHeaderHash = txBlockHeaderHash'
, txBlockNo = txBlockNo'
, txBlockLink = txBlockLink'
, txSlotNo = txSlotNo'
, inputs = inputs'
, invalidBefore = invalidBefore'
Expand All @@ -340,7 +348,7 @@ renderCTVRTDetail cid blockExplHost (Just CTVRTDetail { txPrev = txPrev'
td $ string txBlockHeaderHash'
tr $ do
td $ b "Block number"
td $ string $ show txBlockNo'
td $ a ! href (toValue txBlockLink') $ string $ show txBlockNo'
tr $ do
td $ b "Slot number"
td $ string $ show txSlotNo'
Expand Down
9 changes: 6 additions & 3 deletions src/Explorer/Web/Util.hs
View file
@@ -1,7 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}

module Explorer.Web.Util
( baseDoc, formatTimeDiff, generateLink, linkFor, makeLocalDateTime, prettyPrintAmount, stringToHtml, table, td, th, tr, mkTransactinExplorerLink )
( baseDoc, formatTimeDiff, generateLink, linkFor, makeLocalDateTime, prettyPrintAmount, stringToHtml, table, td, th, tr, mkTransactionExplorerLink , mkBlockExplorerLink )
where

import Data.Bifunctor (Bifunctor (bimap))
Expand Down Expand Up @@ -99,5 +99,8 @@ makeLocalDateTime timestampToRender =
linkFor :: ToValue a => a -> String -> Html
linkFor x y = a ! href (toValue x) $ string y

mkTransactinExplorerLink :: String -> String -> String
mkTransactinExplorerLink = printf "https://%s/transaction/%s"
mkTransactionExplorerLink :: String -> String -> String
mkTransactionExplorerLink = printf "https://%s/transaction/%s"

mkBlockExplorerLink :: String -> Integer -> String
mkBlockExplorerLink = printf "https://%s/block/%d"
4 changes: 2 additions & 2 deletions src/Language/Marlowe/Runtime/Types/TransactionJSON.hs
View file
Expand Up @@ -19,8 +19,8 @@ data Link = Link

data Block = Block
{ blockHeaderHash :: String,
blockNo :: Int,
slotNo :: Int
blockNo :: Integer,
slotNo :: Integer
}
deriving (Show)

Expand Down

0 comments on commit 8fa06c7

Please sign in to comment.