Merge pull request #460 from input-output-hk/scp-4880-get-transaction SCP-4880 G… - input-output-hk/marlowe-cardano@d5127343 - Cardano Updates

Home / Input Output / marlowe-cardano / d5127343

View on GitHub

File Changes

m

marlowe-runtime/marlowe-runtime.cabal

+1/-0

    Language.Marlowe.Runtime.Sync.Database.PostgreSQL.GetNextSteps

    Language.Marlowe.Runtime.Sync.Database.PostgreSQL.GetTip

    Language.Marlowe.Runtime.Sync.Database.PostgreSQL.GetTipForContract

+

    Language.Marlowe.Runtime.Sync.Database.PostgreSQL.GetTransaction

    Language.Marlowe.Runtime.Sync.MarloweHeaderSyncServer

    Language.Marlowe.Runtime.Sync.MarloweSyncServer

    Language.Marlowe.Runtime.Sync.QueryServer

m

marlowe-runtime/sync-api/Language/Marlowe/Protocol/Query/Client.hs

+4/-0

import Control.Monad.IO.Class (MonadIO(..))

import Control.Monad.Trans.Class (MonadTrans(..))

import Language.Marlowe.Protocol.Query.Types

+

import Language.Marlowe.Runtime.ChainSync.Api (TxId)

import Language.Marlowe.Runtime.Core.Api (ContractId)

import Language.Marlowe.Runtime.Discovery.Api (ContractHeader)

import Network.TypedProtocol

getContractState :: Applicative m => ContractId -> MarloweQueryClient m (Maybe SomeContractState)

getContractState = request . ReqContractState

+

getTransaction :: Applicative m => TxId -> MarloweQueryClient m (Maybe SomeTransaction)

+

getTransaction = request . ReqTransaction

+

hoistMarloweQueryClient :: Functor m => (forall x. m x -> n x) -> MarloweQueryClient m a -> MarloweQueryClient n a

hoistMarloweQueryClient f = \case

  ClientPure a -> ClientPure a

m

marlowe-runtime/sync-api/Language/Marlowe/Protocol/Query/Codec.hs

+2/-0

    TokBoth a b -> (,) <$> getResult a <*> getResult b

    TokContractHeaders -> get

    TokContractState -> get

+

    TokTransaction -> get

  putResult :: StRes a -> a -> Put

  putResult = \case

    TokBoth ta tb -> \(a, b) -> putResult ta a *> putResult tb b

    TokContractHeaders -> put

    TokContractState -> put

+

    TokTransaction -> put

m

marlowe-runtime/sync-api/Language/Marlowe/Protocol/Query/Server.hs

+4/-1

import Control.Concurrent.Async.Lifted (concurrently)

import Control.Monad.Trans.Control (MonadBaseControl)

import Language.Marlowe.Protocol.Query.Types

+

import Language.Marlowe.Runtime.ChainSync.Api (TxId)

import Language.Marlowe.Runtime.Core.Api (ContractId)

import Language.Marlowe.Runtime.Discovery.Api (ContractHeader)

import Network.TypedProtocol

   . MonadBaseControl IO m

  => (Range ContractId -> m (Page ContractId ContractHeader))

  -> (ContractId -> m (Maybe SomeContractState))

+

  -> (TxId -> m (Maybe SomeTransaction))

  -> MarloweQueryServer m ()

-

marloweQueryServer getContractHeaders getContractState = go

+

marloweQueryServer getContractHeaders getContractState getTransaction = go

  where

    go = Await (ClientAgency TokReq) \case

      MsgRequest req -> Effect do

    serviceRequest = \case

      ReqContractHeaders range -> getContractHeaders range

      ReqContractState range -> getContractState range

+

      ReqTransaction range -> getTransaction range

      ReqBoth a b -> concurrently (serviceRequest a) (serviceRequest b)

m

marlowe-runtime/sync-api/Language/Marlowe/Protocol/Query/Types.hs

+69/-2

import Data.Type.Equality (testEquality, type (:~:)(Refl))

import GHC.Generics (Generic)

import GHC.Show (showCommaSpace, showSpace)

-

import Language.Marlowe.Runtime.ChainSync.Api (BlockHeader, PolicyId, TransactionMetadata, TxOutRef)

+

import Language.Marlowe.Runtime.ChainSync.Api (BlockHeader, PolicyId, TransactionMetadata, TxId, TxOutRef)

import Language.Marlowe.Runtime.Core.Api

-

  (ContractId, MarloweVersion(..), MarloweVersionTag(..), Payout, SomeMarloweVersion(..), TransactionScriptOutput)

+

  ( ContractId

+

  , MarloweVersion(..)

+

  , MarloweVersionTag(..)

+

  , Payout

+

  , SomeMarloweVersion(..)

+

  , Transaction

+

  , TransactionScriptOutput

+

import Language.Marlowe.Runtime.Discovery.Api (ContractHeader)

import Network.Protocol.Codec.Spec (MessageEq(..), ShowProtocol(..))

import Network.Protocol.Driver (MessageToJSON(..))

data Request a where

  ReqContractHeaders :: Range ContractId -> Request (Page ContractId ContractHeader)

  ReqContractState :: ContractId -> Request (Maybe SomeContractState)

+

  ReqTransaction :: TxId -> Request (Maybe SomeTransaction)

  ReqBoth :: Request a -> Request b -> Request (a, b)

data SomeRequest where

        pure $ SomeRequest $ ReqBoth a b

      0x01 -> SomeRequest . ReqContractHeaders <$> get

      0x02 -> SomeRequest . ReqContractState <$> get

+

      0x03 -> SomeRequest . ReqTransaction <$> get

      _ -> fail "Invalid Request tag"

  put (SomeRequest req) = case req of

    ReqContractState contractId -> do

      putWord8 0x02

      put contractId

+

    ReqTransaction txId -> do

+

      putWord8 0x03

+

      put txId

deriving instance Eq (Request a)

deriving instance Show (Request a)

    ReqContractState contractId -> object

      [ "get-contract-state" .= contractId

+

    ReqTransaction txId -> object

+

      [ "get-transaction" .= txId

+

data StRes a where

  TokContractHeaders :: StRes (Page ContractId ContractHeader)

  TokContractState :: StRes (Maybe SomeContractState)

+

  TokTransaction :: StRes (Maybe SomeTransaction)

  TokBoth :: StRes a -> StRes b -> StRes (a, b)

deriving instance Show (StRes a)

    , "state" .= state

+

data SomeTransaction = forall v. SomeTransaction

+

  { version :: MarloweVersion v

+

  , input :: TxOutRef

+

  , consumedBy :: Maybe TxId

+

  , transaction :: Transaction v

+

+

+

instance Show SomeTransaction where

+

  showsPrec p (SomeTransaction MarloweV1 input consumedBy transaction) = showParen (p >= 11)

+

    ( showString "SomeTransaction"

+

    . showSpace

+

    . showsPrec 11 MarloweV1

+

    . showSpace

+

    . showsPrec 11 input

+

    . showSpace

+

    . showsPrec 11 consumedBy

+

    . showSpace

+

    . showsPrec 11 transaction

+

+

+

instance Eq SomeTransaction where

+

  SomeTransaction v input consumedBy tx == SomeTransaction v' input' consumedBy' tx' = case testEquality v v' of

+

    Nothing -> False

+

    Just Refl -> case v of

+

      MarloweV1 -> input == input' && consumedBy == consumedBy' && tx == tx'

+

+

instance Binary SomeTransaction where

+

  put (SomeTransaction MarloweV1 input consumedBy tx) = do

+

    put $ SomeMarloweVersion MarloweV1

+

    put input

+

    put consumedBy

+

    put tx

+

  get = do

+

    SomeMarloweVersion MarloweV1 <- get

+

    SomeTransaction MarloweV1 <$> get <*> get <*> get

+

+

instance ToJSON SomeTransaction where

+

  toJSON (SomeTransaction MarloweV1 input consumedBy tx) = object

+

    [ "version" .= MarloweV1

+

    , "input" .= input

+

    , "consumedBy" .= consumedBy

+

    , "transaction" .= tx

+

+

data ContractState v = ContractState

  { contractId :: ContractId

  , roleTokenMintingPolicyId :: PolicyId

      responseToJSON = \case

        TokContractHeaders -> toJSON

        TokContractState -> toJSON

+

        TokTransaction -> toJSON

        TokBoth a b -> toJSON . bimap (responseToJSON a) (responseToJSON b)

instance ShowProtocol MarloweQuery where

      showsPrecResult = \case

        TokContractHeaders -> showsPrec

        TokContractState -> showsPrec

+

        TokTransaction -> showsPrec

        TokBoth ta tb -> \_ (a, b) -> showParen True (showsPrecResult ta 0 a . showCommaSpace . showsPrecResult tb 0 b)

  showsPrecServerHasAgency p (TokRes req) = showParen (p >= 11) (showString "TokRes" . showSpace . showsPrec 11 req)

  showsPrecClientHasAgency _ TokReq = showString "TokReq"

      reqEq (ReqContractHeaders _) _ = False

      reqEq (ReqContractState contractId) (ReqContractState contractId') = contractId == contractId'

      reqEq (ReqContractState _) _ = False

+

      reqEq (ReqTransaction txId) (ReqTransaction txId') = txId == txId'

+

      reqEq (ReqTransaction _) _ = False

      resultEq :: StRes a -> StRes b -> a -> b -> Bool

      resultEq (TokBoth ta tb) (TokBoth ta' tb') = \(a, b) (a', b') ->

      resultEq TokContractHeaders _ = const $ const False

      resultEq TokContractState TokContractState = (==)

      resultEq TokContractState _ = const $ const False

+

      resultEq TokTransaction TokTransaction = (==)

+

      resultEq TokTransaction _ = const $ const False

requestToSt :: Request x -> StRes x

requestToSt = \case

  ReqContractHeaders _ -> TokContractHeaders

  ReqContractState _ -> TokContractState

+

  ReqTransaction _ -> TokTransaction

  ReqBoth r1 r2 -> TokBoth (requestToSt r1) (requestToSt r2)

m

marlowe-runtime/sync/Language/Marlowe/Runtime/Sync/Database.hs

+12/-3

import Data.Text (Text)

import Data.Void (Void)

import GHC.Generics (Generic)

-

import Language.Marlowe.Protocol.Query.Types (Page, Range, SomeContractState)

-

import Language.Marlowe.Runtime.ChainSync.Api (BlockHeader, ChainPoint)

+

import Language.Marlowe.Protocol.Query.Types (Page, Range, SomeContractState, SomeTransaction)

+

import Language.Marlowe.Runtime.ChainSync.Api (BlockHeader, ChainPoint, TxId)

import Language.Marlowe.Runtime.Core.Api (ContractId, MarloweVersion(..), SomeMarloweVersion)

import Language.Marlowe.Runtime.Discovery.Api (ContractHeader)

import Language.Marlowe.Runtime.History.Api (ContractStep, SomeCreateStep)

import Observe.Event (EventBackend, addField, withEvent)

-

import Observe.Event.Component (FieldConfig(..), GetSelectorConfig, SelectorConfig(SelectorConfig), SomeJSON(SomeJSON))

+

import Observe.Event.Component (FieldConfig(..), GetSelectorConfig, SelectorConfig(..), SomeJSON(..))

data DatabaseSelector f where

  GetTip :: DatabaseSelector (QueryField Void ChainPoint)

  GetNextSteps :: MarloweVersion v -> DatabaseSelector (QueryField (GetNextStepsArguments v) (Next (ContractStep v)))

  GetHeaders :: DatabaseSelector (QueryField (Range ContractId) (Page ContractId ContractHeader))

  GetContractState :: DatabaseSelector (QueryField ContractId (Maybe SomeContractState))

+

  GetTransaction :: DatabaseSelector (QueryField TxId (Maybe SomeTransaction))

data QueryField p r

  = Arguments p

      result <- getContractState contractId

      addField ev $ Result result

      pure result

+

  , getTransaction = \txId -> withEvent eventBackend GetTransaction \ev -> do

+

      addField ev $ Arguments txId

+

      result <- getTransaction txId

+

      addField ev $ Result result

+

      pure result

hoistDatabaseQueries :: (forall x. m x -> n x) -> DatabaseQueries m -> DatabaseQueries n

  , getNextSteps = (fmap . fmap) f . getNextSteps

  , getHeaders = f . getHeaders

  , getContractState = f . getContractState

+

  , getTransaction = f . getTransaction

data DatabaseQueries m = DatabaseQueries

  , getNextSteps :: forall v. MarloweVersion v -> ContractId -> ChainPoint -> m (Next (ContractStep v))

  , getHeaders :: Range ContractId -> m (Page ContractId ContractHeader)

  , getContractState :: ContractId -> m (Maybe SomeContractState)

+

  , getTransaction :: TxId -> m (Maybe SomeTransaction)

data Next a

  GetNextSteps MarloweV1 -> getQuerySelectorConfig "get-next-steps"

  GetHeaders -> getQuerySelectorConfig "get-headers"

  GetContractState -> getQuerySelectorConfig "get-contract-state"

+

  GetTransaction -> getQuerySelectorConfig "get-transaction"

getQuerySelectorConfig :: (ToJSON p, ToJSON r) => Text -> SelectorConfig (QueryField p r)

getQuerySelectorConfig key = SelectorConfig key True FieldConfig

m

marlowe-runtime/sync/Language/Marlowe/Runtime/Sync/Database/PostgreSQL.hs

+2/-0

import Language.Marlowe.Runtime.Sync.Database.PostgreSQL.GetNextSteps (getNextSteps)

import Language.Marlowe.Runtime.Sync.Database.PostgreSQL.GetTip (getTip)

import Language.Marlowe.Runtime.Sync.Database.PostgreSQL.GetTipForContract (getTipForContract)

+

import Language.Marlowe.Runtime.Sync.Database.PostgreSQL.GetTransaction (getTransaction)

databaseQueries :: DatabaseQueries H.Session

databaseQueries = DatabaseQueries

  (\version contractId -> T.transaction T.Serializable T.Read . getNextSteps version contractId)

  (T.transaction T.Serializable T.Read . getHeaders)

  (T.transaction T.Serializable T.Read . getContractState)

+

  (T.transaction T.Serializable T.Read . getTransaction)

a

marlowe-runtime/sync/Language/Marlowe/Runtime/Sync/Database/PostgreSQL/GetTransaction.hs

+172/-0

+

{-# LANGUAGE DataKinds #-}

+

{-# LANGUAGE GADTs #-}

+

{-# LANGUAGE QuasiQuotes #-}

+

+

module Language.Marlowe.Runtime.Sync.Database.PostgreSQL.GetTransaction

+

  where

+

+

import Control.Monad.Trans.Class (lift)

+

import Control.Monad.Trans.Maybe (MaybeT(MaybeT), runMaybeT)

+

import Data.ByteString (ByteString)

+

import Data.Int (Int16, Int64)

+

import qualified Data.Map as Map

+

import Data.Time (LocalTime, localTimeToUTC, utc)

+

import Data.Vector (Vector)

+

import qualified Data.Vector as V

+

import Hasql.TH (maybeStatement, vectorStatement)

+

import qualified Hasql.Transaction as T

+

import Language.Marlowe.Protocol.Query.Types

+

import Language.Marlowe.Runtime.ChainSync.Api (TxId(..))

+

import Language.Marlowe.Runtime.Core.Api (MarloweVersion(..), Transaction(..), TransactionOutput(..))

+

import Language.Marlowe.Runtime.Sync.Database.PostgreSQL.GetContractState

+

  ( decodeBlockHeader

+

  , decodeContractId

+

  , decodeDatumBytes

+

  , decodeMetadata

+

  , decodePayout

+

  , decodeTransactionScriptOutput

+

  , decodeTxOutRef

+

+

import Prelude hiding (init)

+

+

getTransaction :: TxId -> T.Transaction (Maybe SomeTransaction)

+

getTransaction txId = runMaybeT do

+

  SomeTransaction MarloweV1 input consumedBy tx <- fmap decodeTransaction $ MaybeT $ T.statement (unTxId txId)

+

    [maybeStatement|

+

      SELECT

+

        applyTx.txId :: bytea,

+

        (ARRAY_AGG(applyTx.createTxId))[1] :: bytea,

+

        (ARRAY_AGG(applyTx.createTxIx))[1] :: smallint,

+

        (ARRAY_AGG(applyTx.outputTxIx))[1] :: smallint?,

+

        (ARRAY_AGG(applyTx.inputTxId))[1] :: bytea,

+

        (ARRAY_AGG(applyTx.inputTxIx))[1] :: smallint,

+

        (ARRAY_AGG(consumer.txId))[1] :: bytea?,

+

        (ARRAY_AGG(applyTx.metadata))[1] :: bytea?,

+

        (ARRAY_AGG(applyTx.inputs))[1] :: bytea,

+

        (ARRAY_AGG(applyTx.invalidBefore))[1] :: timestamp,

+

        (ARRAY_AGG(applyTx.invalidHereafter))[1] :: timestamp,

+

        (ARRAY_AGG(applyTx.slotNo))[1] :: bigint,

+

        (ARRAY_AGG(applyTx.blockId))[1] :: bytea,

+

        (ARRAY_AGG(applyTx.blockNo))[1] :: bigint,

+

        (ARRAY_AGG(contractTxOut.rolesCurrency))[1] :: bytea?,

+

        (ARRAY_AGG(contractTxOut.state))[1] :: bytea?,

+

        (ARRAY_AGG(contractTxOut.contract))[1] :: bytea?,

+

        (ARRAY_AGG(txOut.address))[1] :: bytea?,

+

        (ARRAY_AGG(txOut.lovelace))[1] :: bigint?,

+

        ARRAY_REMOVE(ARRAY_AGG(txOutAsset.policyId), NULL) :: bytea[],

+

        ARRAY_REMOVE(ARRAY_AGG(txOutAsset.name), NULL) :: bytea[],

+

        ARRAY_REMOVE(ARRAY_AGG(txOutAsset.quantity), NULL) :: bigint[]

+

      FROM marlowe.applyTx

+

      LEFT JOIN marlowe.contractTxOut

+

        ON contractTxOut.txId = applyTx.txId

+

        AND contractTxOut.txIx = applyTx.outputTxIx

+

      LEFT JOIN marlowe.txOut

+

        ON txOut.txId = applyTx.txId

+

        AND txOut.txIx = applyTx.outputTxIx

+

      LEFT JOIN marlowe.txOutAsset

+

        ON txOutAsset.txId = applyTx.txId

+

        AND txOutAsset.txIx = applyTx.outputTxIx

+

      LEFT JOIN marlowe.applyTx AS consumer

+

        ON consumer.inputTxId = applyTx.txId

+

        AND consumer.inputTxIx = applyTx.outputTxIx

+

      WHERE applyTx.txId = $1 :: bytea

+

      GROUP BY applyTx.txId

+

|]

+

+

  payouts <- lift

+

    $ Map.fromDistinctAscList . V.toList . fmap decodePayout

+

    <$> T.statement (unTxId txId) [vectorStatement|

+

      SELECT

+

        payoutTxOut.txId :: bytea,

+

        payoutTxOut.txIx :: smallint,

+

        (ARRAY_AGG(payoutTxOut.rolesCurrency))[1] :: bytea,

+

        (ARRAY_AGG(payoutTxOut.role))[1] :: bytea,

+

        (ARRAY_AGG(txOut.address))[1] :: bytea,

+

        (ARRAY_AGG(txOut.lovelace))[1] :: bigint,

+

        ARRAY_REMOVE(ARRAY_AGG(txOutAsset.policyId), NULL) :: bytea[],

+

        ARRAY_REMOVE(ARRAY_AGG(txOutAsset.name), NULL) :: bytea[],

+

        ARRAY_REMOVE(ARRAY_AGG(txOutAsset.quantity), NULL) :: bigint[]

+

      FROM marlowe.payoutTxOut

+

      JOIN marlowe.txOut USING (txId, txIx)

+

      LEFT JOIN marlowe.txOutAsset USING (txId, txIx)

+

      WHERE payoutTxOut.txId = $1 :: bytea

+

      GROUP BY payoutTxOut.txId, payoutTxOut.txIx

+

      ORDER BY payoutTxOut.txId, payoutTxOut.txIx

+

|]

+

+

  pure $ SomeTransaction MarloweV1 input consumedBy tx { output = (output tx) { payouts } }

+

+

type ResultRow =

+

  ( ByteString

+

  , ByteString

+

  , Int16

+

  , Maybe Int16

+

  , ByteString

+

  , Int16

+

  , Maybe ByteString

+

  , Maybe ByteString

+

  , ByteString

+

  , LocalTime

+

  , LocalTime

+

  , Int64

+

  , ByteString

+

  , Int64

+

  , Maybe ByteString

+

  , Maybe ByteString

+

  , Maybe ByteString

+

  , Maybe ByteString

+

  , Maybe Int64

+

  , Vector ByteString

+

  , Vector ByteString

+

  , Vector Int64

+

+

+

decodeTransaction :: ResultRow -> SomeTransaction

+

decodeTransaction row = SomeTransaction

+

  { version = MarloweV1

+

  , input = decodeTxOutRef inputTxId inputTxIx

+

  , consumedBy = TxId <$> consumedBy

+

  , transaction = Transaction

+

      { transactionId = TxId txId

+

      , contractId = decodeContractId createTxId createTxIx

+

      , metadata = decodeMetadata metadata

+

      , blockHeader = decodeBlockHeader slotNo hash blockNo

+

      , validityUpperBound = localTimeToUTC utc invalidBefore

+

      , validityLowerBound = localTimeToUTC utc invalidHereafter

+

      , inputs = decodeDatumBytes inputs

+

      , output = TransactionOutput mempty $ decodeTransactionScriptOutput txId

+

          <$> outputTxIx

+

          <*> address

+

          <*> lovelace

+

          <*> pure policyIds

+

          <*> pure tokenNames

+

          <*> pure quantities

+

          <*> rolesCurrency

+

          <*> state

+

          <*> contract

+

+

+

  where

+

  ( txId

+

    , createTxId

+

    , createTxIx

+

    , outputTxIx

+

    , inputTxId

+

    , inputTxIx

+

    , consumedBy

+

    , metadata

+

    , inputs

+

    , invalidBefore

+

    , invalidHereafter

+

    , slotNo

+

    , hash

+

    , blockNo

+

    , rolesCurrency

+

    , state

+

    , contract

+

    , address

+

    , lovelace

+

    , policyIds

+

    , tokenNames

+

    , quantities

+

    ) = row

m

marlowe-runtime/sync/Language/Marlowe/Runtime/Sync/QueryServer.hs

+1/-1

worker WorkerDependencies{..} = do

  let DatabaseQueries{..} = databaseQueries

  let RunServer runServer = runMarloweQueryServer

-

  runServer $ marloweQueryServer getHeaders getContractState

+

  runServer $ marloweQueryServer getHeaders getContractState getTransaction

m

marlowe-runtime/test/Language/Marlowe/Protocol/QuerySpec.hs

+12/-0

      arbitraryResult = \case

        TokContractHeaders -> arbitrary

        TokContractState -> arbitrary

+

        TokTransaction -> arbitrary

        TokBoth a b -> resized (`div` 2) $ (,) <$> arbitraryResult a <*> arbitraryResult b

  shrinkMessage = \case

  arbitrary = SomeContractState MarloweV1 <$> arbitrary

  shrink (SomeContractState MarloweV1 state) = SomeContractState MarloweV1 <$> shrink state

+

instance Arbitrary SomeTransaction where

+

  arbitrary = SomeTransaction MarloweV1 <$> arbitrary <*> arbitrary <*> arbitrary

+

  shrink (SomeTransaction MarloweV1 input consumedBy state) = fold

+

    [ SomeTransaction MarloweV1 input consumedBy <$> shrink state

+

    , SomeTransaction MarloweV1 input <$> shrink consumedBy <*> pure state

+

+

instance Arbitrary (ContractState 'V1) where

  arbitrary = ContractState

    <$> arbitrary

    , (Leaf, pure $ SomeStRes TokContractHeaders)

    , (Leaf, pure $ SomeStRes TokContractState)

+

    , (Leaf, pure $ SomeStRes TokTransaction)

instance Arbitrary SomeRequest where

  shrink (SomeRequest req) = case req of

    ReqContractHeaders range -> SomeRequest . ReqContractHeaders <$> shrink range

    ReqContractState contractId -> SomeRequest . ReqContractState <$> shrink contractId

+

    ReqTransaction txId -> SomeRequest . ReqTransaction <$> shrink txId

    ReqBoth a b -> fold

      [ [ SomeRequest $ ReqBoth a' b | SomeRequest a' <- shrink (SomeRequest a) ]

      , [ SomeRequest $ ReqBoth a b' | SomeRequest b' <- shrink (SomeRequest b) ]

shrinkRequest = \case

  ReqContractHeaders range -> ReqContractHeaders <$> shrink range

  ReqContractState contractId -> ReqContractState <$> shrink contractId

+

  ReqTransaction txId -> ReqTransaction <$> shrink txId

  ReqBoth a b -> fold

    [ [ ReqBoth a' b | a' <- shrinkRequest a ]

    , [ ReqBoth a b' | b' <- shrinkRequest b ]

shrinkResponse = \case

  TokContractHeaders -> shrink

  TokContractState -> shrink

+

  TokTransaction -> shrink

  TokBoth ta tb -> \(a, b) -> fold

    [ [ (a', b) | a' <- shrinkResponse ta a ]

    , [ (a, b') | b' <- shrinkResponse tb b ]

m

nix/pkgs/haskell/materialized-darwin/.plan.nix/marlowe-runtime.nix

+1/-0

            "Language/Marlowe/Runtime/Sync/Database/PostgreSQL/GetNextSteps"

            "Language/Marlowe/Runtime/Sync/Database/PostgreSQL/GetTip"

            "Language/Marlowe/Runtime/Sync/Database/PostgreSQL/GetTipForContract"

+

            "Language/Marlowe/Runtime/Sync/Database/PostgreSQL/GetTransaction"

            "Language/Marlowe/Runtime/Sync/MarloweHeaderSyncServer"

            "Language/Marlowe/Runtime/Sync/MarloweSyncServer"

            "Language/Marlowe/Runtime/Sync/QueryServer"

m

nix/pkgs/haskell/materialized-linux/.plan.nix/marlowe-runtime.nix

+1/-0

            "Language/Marlowe/Runtime/Sync/Database/PostgreSQL/GetNextSteps"

            "Language/Marlowe/Runtime/Sync/Database/PostgreSQL/GetTip"

            "Language/Marlowe/Runtime/Sync/Database/PostgreSQL/GetTipForContract"

+

            "Language/Marlowe/Runtime/Sync/Database/PostgreSQL/GetTransaction"

            "Language/Marlowe/Runtime/Sync/MarloweHeaderSyncServer"

            "Language/Marlowe/Runtime/Sync/MarloweSyncServer"

            "Language/Marlowe/Runtime/Sync/QueryServer"

Yesterday's Report

Friday, March 31, 2023

592 commits in 52 repos

New Repo Discovered

Tue, 28 Mar 23 20:22:36 +0000 · dapp-example

JavaScript · No license

New Releases

Fri, 31 Mar 23 16:07:27 +0000 · Unstable Development Builds mithril Fri, 31 Mar 23 15:30:37 +0000 · Marlowe Runtime v0.0.1 marlowe-cardano Fri, 31 Mar 23 01:01:17 +0000 · v0.33.0 go-ouroboros-network Thu, 30 Mar 23 16:39:24 +0000 · release-58 awesome-starter-kits Wed, 29 Mar 23 11:37:31 +0000 · neo4j-rc.30 yoroi-graphql-migration-backend Wed, 29 Mar 23 07:55:31 +0000 · Mithril v2313.0-prerelease mithril

3,563 commits this week Mar 25, 2023 - Apr 01, 2023

Showing 25 of 3563 recent commits.