{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} module Database.TigerBeetle.Response ( Response (..) -- * Internal functions , toResponse ) where import Data.Set qualified as Set import Database.TigerBeetle.Account import Database.TigerBeetle.Code import Database.TigerBeetle.Internal.FFI.Account qualified as FFA import Database.TigerBeetle.Internal.FFI.Transfer qualified as FFT import Database.TigerBeetle.Ledger import Database.TigerBeetle.Raw.Response qualified as Raw import Database.TigerBeetle.Response.Account (CreateAccountsResult) import Database.TigerBeetle.Response.Account qualified as RA import Database.TigerBeetle.Response.Transfer (CreateTransfersResult) import Database.TigerBeetle.Response.Transfer qualified as TA import Database.TigerBeetle.Timestamp import Database.TigerBeetle.Transfer (Transfer (..), TransferId (..)) import Database.TigerBeetle.Transfer qualified as T -- | The responses from each of the database commands. data Response = CreateAccountResultResponse [CreateAccountsResult] | CreateTransferResultResponse [CreateTransfersResult] | LookupAccountsResponse [Account] | LookupTransfersResponse [Transfer] | GetAccountTransfersResponse [Transfer] | GetAccountBalancesResponse [AccountBalance] | QueryAccountsResponse [Account] | QueryTransfersResponse [Transfer] deriving (Eq, Show) -- TODO: Move to an internal module toResponse :: Raw.TBResponse -> Response toResponse = \case Raw.CreateAccountResultResponse xs -> CreateAccountResultResponse $ map toCreateAccountsResult xs Raw.CreateTransferResultResponse xs -> CreateTransferResultResponse $ map toCreateTransfersResult xs Raw.LookupAccountsResponse xs -> LookupAccountsResponse $ map toAccount xs Raw.LookupTransfersResponse xs -> LookupTransfersResponse $ map toTransfer xs Raw.GetAccountTransfersResponse xs -> GetAccountTransfersResponse $ map toTransfer xs Raw.GetAccountBalancesResponse xs -> GetAccountBalancesResponse $ map toAccountBalance xs Raw.QueryAccountsResponse xs -> QueryAccountsResponse $ map toAccount xs Raw.QueryTransfersResponse xs -> QueryTransfersResponse $ map toTransfer xs toAccount :: FFA.TBAccount -> Account toAccount FFA.TBAccount{..} = Account { accountId = AccountId tbAccountId , accountDebitsPending = fromIntegral tbAccountDebitsPending , accountDebitsPosted = fromIntegral tbAccountDebitsPosted , accountCreditsPending = fromIntegral tbAccountCreditsPending , accountCreditsPosted = fromIntegral tbAccountCreditsPosted , accountLedger = LedgerId tbAccountLedger , accountCode = Code tbAccountCode , accountFlags = Set.map toAccountFlag tbAccountFlags , accountTimestamp = Timestamp tbAccountTimestamp } toAccountFlag :: FFA.TBAccountFlags -> AccountFlags toAccountFlag = \case FFA.Linked -> Linked FFA.DebitsMustNotExceedCredits -> DebitsMustNotExceedCredits FFA.CreditsMustNotExceedDebits -> CreditsMustNotExceedDebits FFA.History -> History FFA.Imported -> Imported FFA.Closed -> Closed toCreateAccountsResult :: FFA.TBCreateAccountsResult -> CreateAccountsResult toCreateAccountsResult FFA.TBCreateAccountsResult{..} = case tbCreateAccountsResultResult of FFA.Ok -> RA.Ok FFA.LinkedEventFailed -> RA.LinkedEventFailed FFA.LinkedEventChainOpen -> RA.LinkedEventChainOpen FFA.ImportedEventExpected -> RA.ImportedEventExpected FFA.ImportedEventNotExpected -> RA.ImportedEventNotExpected FFA.TimestampMustBeZero -> RA.TimestampMustBeZero FFA.ImportedEventTimestampOutOfRange -> RA.ImportedEventTimestampOutOfRange FFA.ImportedEventTimestampMustNotAdvance -> RA.ImportedEventTimestampMustNotAdvance FFA.ReservedField -> RA.ReservedField FFA.ReservedFlag -> RA.ReservedFlag FFA.IdMustNotBeZero -> RA.IdMustNotBeZero FFA.IdMustNotBeIntMax -> RA.IdMustNotBeIntMax FFA.ExistsWithDifferentFlags -> RA.ExistsWithDifferentFlags FFA.ExistsWithDifferentUserData128 -> RA.ExistsWithDifferentUserData128 FFA.ExistsWithDifferentUserData64 -> RA.ExistsWithDifferentUserData64 FFA.ExistsWithDifferentUserData32 -> RA.ExistsWithDifferentUserData32 FFA.ExistsWithDifferentLedger -> RA.ExistsWithDifferentLedger FFA.ExistsWithDifferentCode -> RA.ExistsWithDifferentCode FFA.Exists -> RA.Exists FFA.FlagsAreMutuallyExclusive -> RA.FlagsAreMutuallyExclusive FFA.DebitsPendingMustBeZero -> RA.DebitsPendingMustBeZero FFA.DebitsPostedMustBeZero -> RA.DebitsPostedMustBeZero FFA.CreditsPendingMustBeZero -> RA.CreditsPendingMustBeZero FFA.CreditsPostedMustBeZero -> RA.CreditsPostedMustBeZero FFA.LedgerMustNotBeZero -> RA.LedgerMustNotBeZero FFA.CodeMustNotBeZero -> RA.CodeMustNotBeZero FFA.ImportedEventTimestampMustNotRegress -> RA.ImportedEventTimestampMustNotRegress toCreateTransfersResult :: FFT.TBCreateTransfersResult -> CreateTransfersResult toCreateTransfersResult FFT.TBCreateTransfersResult{..} = case tbCreateTransfersResultResult of FFT.Ok -> TA.Ok FFT.LinkedEventFailed -> TA.LinkedEventFailed FFT.LinkedEventChainOpen -> TA.LinkedEventChainOpen FFT.ImportedEventExpected -> TA.ImportedEventExpected FFT.ImportedEventNotExpected -> TA.ImportedEventNotExpected FFT.TimestampMustBeZero -> TA.TimestampMustBeZero FFT.ImportedEventTimestampOutOfRange -> TA.ImportedEventTimestampOutOfRange FFT.ImportedEventTimestampMustNotAdvance -> TA.ImportedEventTimestampMustNotAdvance FFT.ReservedFlag -> TA.ReservedFlag FFT.IdMustNotBeZero -> TA.IdMustNotBeZero FFT.IdMustNotBeIntMax -> TA.IdMustNotBeIntMax FFT.ExistsWithDifferentFlags -> TA.ExistsWithDifferentFlags FFT.ExistsWithDifferentPendingId -> TA.ExistsWithDifferentPendingId FFT.ExistsWithDifferentTimeout -> TA.ExistsWithDifferentTimeout FFT.ExistsWithDifferentDebitAccountId -> TA.ExistsWithDifferentDebitAccountId FFT.ExistsWithDifferentCreditAccountId -> TA.ExistsWithDifferentCreditAccountId FFT.ExistsWithDifferentAmount -> TA.ExistsWithDifferentAmount FFT.ExistsWithDifferentUserData128 -> TA.ExistsWithDifferentUserData128 FFT.ExistsWithDifferentUserData64 -> TA.ExistsWithDifferentUserData64 FFT.ExistsWithDifferentUserData32 -> TA.ExistsWithDifferentUserData32 FFT.ExistsWithDifferentLedger -> TA.ExistsWithDifferentLedger FFT.ExistsWithDifferentCode -> TA.ExistsWithDifferentCode FFT.Exists -> TA.Exists FFT.IdAlreadyFailed -> TA.IdAlreadyFailed FFT.FlagsAreMutuallyExclusive -> TA.FlagsAreMutuallyExclusive FFT.DebitAccountIdMustNotBeZero -> TA.DebitAccountIdMustNotBeZero FFT.DebitAccountIdMustNotBeIntMax -> TA.DebitAccountIdMustNotBeIntMax FFT.CreditAccountIdMustNotBeZero -> TA.CreditAccountIdMustNotBeZero FFT.CreditAccountIdMustNotBeIntMax -> TA.CreditAccountIdMustNotBeIntMax FFT.AccountsMustBeDifferent -> TA.AccountsMustBeDifferent FFT.PendingIdMustBeZero -> TA.PendingIdMustBeZero FFT.PendingIdMustNotBeZero -> TA.PendingIdMustNotBeZero FFT.PendingIdMustNotBeIntMax -> TA.PendingIdMustNotBeIntMax FFT.PendingIdMustBeDifferent -> TA.PendingIdMustBeDifferent FFT.TimeoutReservedForPendingTransfer -> TA.TimeoutReservedForPendingTransfer FFT.ClosingTransferMustBePending -> TA.ClosingTransferMustBePending FFT.LedgerMustNotBeZero -> TA.LedgerMustNotBeZero FFT.CodeMustNotBeZero -> TA.CodeMustNotBeZero FFT.DebitAccountNotFound -> TA.DebitAccountNotFound FFT.CreditAccountNotFound -> TA.CreditAccountNotFound FFT.AccountsMustHaveTheSameLedger -> TA.AccountsMustHaveTheSameLedger FFT.TransferMustHaveTheSameLedgerAsAccounts -> TA.TransferMustHaveTheSameLedgerAsAccounts FFT.PendingTransferNotFound -> TA.PendingTransferNotFound FFT.PendingTransferNotPending -> TA.PendingTransferNotPending FFT.PendingTransferHasDifferentDebitAccountId -> TA.PendingTransferHasDifferentDebitAccountId FFT.PendingTransferHasDifferentCreditAccountId -> TA.PendingTransferHasDifferentCreditAccountId FFT.PendingTransferHasDifferentLedger -> TA.PendingTransferHasDifferentLedger FFT.PendingTransferHasDifferentCode -> TA.PendingTransferHasDifferentCode FFT.ExceedsPendingTransferAmount -> TA.ExceedsPendingTransferAmount FFT.PendingTransferHasDifferentAmount -> TA.PendingTransferHasDifferentAmount FFT.PendingTransferAlreadyPosted -> TA.PendingTransferAlreadyPosted FFT.PendingTransferAlreadyVoided -> TA.PendingTransferAlreadyVoided FFT.PendingTransferExpired -> TA.PendingTransferExpired FFT.ImportedEventTimestampMustNotRegress -> TA.ImportedEventTimestampMustNotRegress FFT.ImportedEventTimestampMustPostdateDebitAccount -> TA.ImportedEventTimestampMustPostdateDebitAccount FFT.ImportedEventTimestampMustPostdateCreditAccount -> TA.ImportedEventTimestampMustPostdateCreditAccount FFT.ImportedEventTimeoutMustBeZero -> TA.ImportedEventTimeoutMustBeZero FFT.DebitAccountAlreadyClosed -> TA.DebitAccountAlreadyClosed FFT.CreditAccountAlreadyClosed -> TA.CreditAccountAlreadyClosed FFT.OverflowsDebitsPending -> TA.OverflowsDebitsPending FFT.OverflowsCreditsPending -> TA.OverflowsCreditsPending FFT.OverflowsDebitsPosted -> TA.OverflowsDebitsPosted FFT.OverflowsCreditsPosted -> TA.OverflowsCreditsPosted FFT.OverflowsDebits -> TA.OverflowsDebits FFT.OverflowsCredits -> TA.OverflowsCredits FFT.OverflowsTimeout -> TA.OverflowsTimeout FFT.ExceedsCredits -> TA.ExceedsCredits FFT.ExceedsDebits -> TA.ExceedsDebits toTransfer :: FFT.TBTransfer -> Transfer toTransfer FFT.TBTransfer{..} = Transfer { transferId = TransferId tbTransferId , transferDebitAccountId = AccountId tbTransferDebitAccountId , transferCreditAccountId = AccountId tbTransferCreditAccountId , transferAmount = fromIntegral tbTransferAmount , transferPendingId = TransferId tbTransferPendingId , transferTimeout = fromIntegral tbTransferTimeout , transferLedger = LedgerId tbTransferLedger , transferCode = Code tbTransferCode , transferFlags = Set.map toTransferFlag tbTransferFlags , transferTimestamp = Timestamp tbTransferTimestamp } toTransferFlag :: FFT.TBTransferFlag -> T.TransferFlag toTransferFlag = \case FFT.Linked -> T.Linked FFT.Pending -> T.Pending FFT.PostPendingTransfer -> T.PostPending FFT.VoidPendingTransfer -> T.VoidPending FFT.BalancingDebit -> T.BalancingDebit FFT.BalancingCredit -> T.BalancingCredit FFT.ClosingDebit -> T.ClosingDebit FFT.ClosingCredit -> T.ClosingCredit FFT.Imported -> T.Imported toAccountBalance :: FFA.TBAccountBalance -> AccountBalance toAccountBalance FFA.TBAccountBalance{..} = AccountBalance { accountBalanceDebitsPending = fromIntegral tbAccountBalanceDebitsPending , accountBalanceDebitsPosted = fromIntegral tbAccountBalanceDebitsPosted , accountBalanceCreditsPending = fromIntegral tbAccountBalanceCreditsPending , accountBalanceCreditsPosted = fromIntegral tbAccountBalanceCreditsPosted , accountBalanceTimestamp = Timestamp tbAccountBalanceTimestamp }