{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

{- |
Copyright: 2022 IOHK
License: Apache-2.0

Implementation of a 'Store' for 'TxHistory'.

-}
module Cardano.Wallet.DB.Store.Transactions.Store
    ( selectTxHistory
    , putTxHistory
    , mkStoreTransactions ) where

import Prelude

import Cardano.Wallet.DB.Sqlite.Schema
    ( EntityField (..)
    , TxCollateral (..)
    , TxCollateralOut (..)
    , TxCollateralOutToken (..)
    , TxIn (..)
    , TxOut (..)
    , TxOutToken (..)
    , TxWithdrawal (..)
    )
import Cardano.Wallet.DB.Sqlite.Types
    ( TxId )
import Cardano.Wallet.DB.Store.Transactions.Model
    ( Decoration (Without)
    , DeltaTxHistory (..)
    , TxHistory
    , TxHistoryF (TxHistoryF)
    , TxRelationF (..)
    , tokenCollateralOrd
    , tokenOutOrd
    )
import Control.Arrow
    ( Arrow ((&&&)) )
import Data.DBVar
    ( Store (..) )
import Data.Foldable
    ( fold, forM_, toList )
import Data.List
    ( sortOn )
import Data.List.Split
    ( chunksOf )
import Data.Map.Strict
    ( Map )
import Data.Maybe
    ( maybeToList )
import Data.Monoid
    ( getFirst )
import Database.Persist.Sql
    ( Entity
    , SqlPersistT
    , deleteWhere
    , entityVal
    , keyFromRecordM
    , repsertMany
    , selectList
    , (==.)
    )

import qualified Data.Map.Strict as Map

mkStoreTransactions
    :: Store (SqlPersistT IO) DeltaTxHistory
mkStoreTransactions :: Store (SqlPersistT IO) DeltaTxHistory
mkStoreTransactions =
    Store :: forall (m :: * -> *) da.
m (Either SomeException (Base da))
-> (Base da -> m ()) -> (Base da -> da -> m ()) -> Store m da
Store
    { loadS :: SqlPersistT IO (Either SomeException (Base DeltaTxHistory))
loadS = TxHistory -> Either SomeException TxHistory
forall a b. b -> Either a b
Right (TxHistory -> Either SomeException TxHistory)
-> ReaderT SqlBackend IO TxHistory
-> ReaderT SqlBackend IO (Either SomeException TxHistory)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT SqlBackend IO TxHistory
selectTxHistory
    , writeS :: Base DeltaTxHistory -> SqlPersistT IO ()
writeS = Base DeltaTxHistory -> SqlPersistT IO ()
TxHistory -> SqlPersistT IO ()
write
    , updateS :: Base DeltaTxHistory -> DeltaTxHistory -> SqlPersistT IO ()
updateS = Base DeltaTxHistory -> DeltaTxHistory -> SqlPersistT IO ()
TxHistory -> DeltaTxHistory -> SqlPersistT IO ()
update
    }

update :: TxHistory -> DeltaTxHistory -> SqlPersistT IO ()
update :: TxHistory -> DeltaTxHistory -> SqlPersistT IO ()
update TxHistory
_ DeltaTxHistory
change = case DeltaTxHistory
change of
    Append TxHistory
txs -> TxHistory -> SqlPersistT IO ()
putTxHistory TxHistory
txs
    DeleteTx TxId
tid -> do
        [Filter TxIn] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField TxIn TxId
forall typ. (typ ~ TxId) => EntityField TxIn typ
TxInputTxId EntityField TxIn TxId -> TxId -> Filter TxIn
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. TxId
tid ]
        [Filter TxCollateral] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField TxCollateral TxId
forall typ. (typ ~ TxId) => EntityField TxCollateral typ
TxCollateralTxId EntityField TxCollateral TxId -> TxId -> Filter TxCollateral
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. TxId
tid ]
        [Filter TxOutToken] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField TxOutToken TxId
forall typ. (typ ~ TxId) => EntityField TxOutToken typ
TxOutTokenTxId EntityField TxOutToken TxId -> TxId -> Filter TxOutToken
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. TxId
tid ]
        [Filter TxOut] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField TxOut TxId
forall typ. (typ ~ TxId) => EntityField TxOut typ
TxOutputTxId EntityField TxOut TxId -> TxId -> Filter TxOut
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. TxId
tid ]
        [Filter TxCollateralOutToken] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField TxCollateralOutToken TxId
forall typ. (typ ~ TxId) => EntityField TxCollateralOutToken typ
TxCollateralOutTokenTxId EntityField TxCollateralOutToken TxId
-> TxId -> Filter TxCollateralOutToken
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. TxId
tid ]
        [Filter TxCollateralOut] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField TxCollateralOut TxId
forall typ. (typ ~ TxId) => EntityField TxCollateralOut typ
TxCollateralOutTxId EntityField TxCollateralOut TxId -> TxId -> Filter TxCollateralOut
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. TxId
tid ]
        [Filter TxWithdrawal] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField TxWithdrawal TxId
forall typ. (typ ~ TxId) => EntityField TxWithdrawal typ
TxWithdrawalTxId EntityField TxWithdrawal TxId -> TxId -> Filter TxWithdrawal
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. TxId
tid ]

write :: TxHistory -> SqlPersistT IO ()
write :: TxHistory -> SqlPersistT IO ()
write TxHistory
txs = do
    [Filter TxIn] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere @_ @_ @TxIn [Filter TxIn]
forall a. Monoid a => a
mempty
    [Filter TxCollateral] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere @_ @_ @TxCollateral [Filter TxCollateral]
forall a. Monoid a => a
mempty
    [Filter TxOutToken] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere @_ @_ @TxOutToken [Filter TxOutToken]
forall a. Monoid a => a
mempty
    [Filter TxOut] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere @_ @_ @TxOut [Filter TxOut]
forall a. Monoid a => a
mempty
    [Filter TxCollateralOutToken] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere @_ @_ @TxCollateralOutToken [Filter TxCollateralOutToken]
forall a. Monoid a => a
mempty
    [Filter TxCollateralOut] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere @_ @_ @TxCollateralOut [Filter TxCollateralOut]
forall a. Monoid a => a
mempty
    [Filter TxWithdrawal] -> SqlPersistT IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere @_ @_ @TxWithdrawal [Filter TxWithdrawal]
forall a. Monoid a => a
mempty
    TxHistory -> SqlPersistT IO ()
putTxHistory TxHistory
txs


-- | Insert multiple transactions
putTxHistory :: TxHistory -> SqlPersistT IO ()
putTxHistory :: TxHistory -> SqlPersistT IO ()
putTxHistory (TxHistoryF Map TxId (TxRelationF 'Without)
tx_map) = Map TxId (TxRelationF 'Without)
-> (TxRelationF 'Without -> SqlPersistT IO ()) -> SqlPersistT IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Map TxId (TxRelationF 'Without)
tx_map ((TxRelationF 'Without -> SqlPersistT IO ()) -> SqlPersistT IO ())
-> (TxRelationF 'Without -> SqlPersistT IO ()) -> SqlPersistT IO ()
forall a b. (a -> b) -> a -> b
$ \TxRelationF {[(TxOut, [TxOutToken])]
[TxWithdrawal]
[DecorateWithTxOut 'Without TxCollateral]
[DecorateWithTxOut 'Without TxIn]
Maybe (TxCollateralOut, [TxCollateralOutToken])
$sel:withdrawals:TxRelationF :: forall (f :: Decoration). TxRelationF f -> [TxWithdrawal]
$sel:collateralOuts:TxRelationF :: forall (f :: Decoration).
TxRelationF f -> Maybe (TxCollateralOut, [TxCollateralOutToken])
$sel:outs:TxRelationF :: forall (f :: Decoration). TxRelationF f -> [(TxOut, [TxOutToken])]
$sel:collateralIns:TxRelationF :: forall (f :: Decoration).
TxRelationF f -> [DecorateWithTxOut f TxCollateral]
$sel:ins:TxRelationF :: forall (f :: Decoration).
TxRelationF f -> [DecorateWithTxOut f TxIn]
withdrawals :: [TxWithdrawal]
collateralOuts :: Maybe (TxCollateralOut, [TxCollateralOutToken])
outs :: [(TxOut, [TxOutToken])]
collateralIns :: [DecorateWithTxOut 'Without TxCollateral]
ins :: [DecorateWithTxOut 'Without TxIn]
..} -> do
    [TxIn] -> SqlPersistT IO ()
forall (m :: * -> *) backend record.
(MonadIO m, PersistStoreWrite backend, PersistEntity record,
 PersistEntityBackend record ~ BaseBackend backend) =>
[record] -> ReaderT backend m ()
repsertMany' [TxIn]
[DecorateWithTxOut 'Without TxIn]
ins
    [TxCollateral] -> SqlPersistT IO ()
forall (m :: * -> *) backend record.
(MonadIO m, PersistStoreWrite backend, PersistEntity record,
 PersistEntityBackend record ~ BaseBackend backend) =>
[record] -> ReaderT backend m ()
repsertMany' [TxCollateral]
[DecorateWithTxOut 'Without TxCollateral]
collateralIns
    [TxOut] -> SqlPersistT IO ()
forall (m :: * -> *) backend record.
(MonadIO m, PersistStoreWrite backend, PersistEntity record,
 PersistEntityBackend record ~ BaseBackend backend) =>
[record] -> ReaderT backend m ()
repsertMany' ([TxOut] -> SqlPersistT IO ()) -> [TxOut] -> SqlPersistT IO ()
forall a b. (a -> b) -> a -> b
$ (TxOut, [TxOutToken]) -> TxOut
forall a b. (a, b) -> a
fst ((TxOut, [TxOutToken]) -> TxOut)
-> [(TxOut, [TxOutToken])] -> [TxOut]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TxOut, [TxOutToken])]
outs
    [TxOutToken] -> SqlPersistT IO ()
forall (m :: * -> *) backend record.
(MonadIO m, PersistStoreWrite backend, PersistEntity record,
 PersistEntityBackend record ~ BaseBackend backend) =>
[record] -> ReaderT backend m ()
repsertMany' ([TxOutToken] -> SqlPersistT IO ())
-> [TxOutToken] -> SqlPersistT IO ()
forall a b. (a -> b) -> a -> b
$ [(TxOut, [TxOutToken])]
outs [(TxOut, [TxOutToken])]
-> ((TxOut, [TxOutToken]) -> [TxOutToken]) -> [TxOutToken]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (TxOut, [TxOutToken]) -> [TxOutToken]
forall a b. (a, b) -> b
snd
    [TxCollateralOut] -> SqlPersistT IO ()
forall (m :: * -> *) backend record.
(MonadIO m, PersistStoreWrite backend, PersistEntity record,
 PersistEntityBackend record ~ BaseBackend backend) =>
[record] -> ReaderT backend m ()
repsertMany' ([TxCollateralOut] -> SqlPersistT IO ())
-> [TxCollateralOut] -> SqlPersistT IO ()
forall a b. (a -> b) -> a -> b
$ Maybe TxCollateralOut -> [TxCollateralOut]
forall a. Maybe a -> [a]
maybeToList (Maybe TxCollateralOut -> [TxCollateralOut])
-> Maybe TxCollateralOut -> [TxCollateralOut]
forall a b. (a -> b) -> a -> b
$ (TxCollateralOut, [TxCollateralOutToken]) -> TxCollateralOut
forall a b. (a, b) -> a
fst ((TxCollateralOut, [TxCollateralOutToken]) -> TxCollateralOut)
-> Maybe (TxCollateralOut, [TxCollateralOutToken])
-> Maybe TxCollateralOut
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TxCollateralOut, [TxCollateralOutToken])
collateralOuts
    [TxCollateralOutToken] -> SqlPersistT IO ()
forall (m :: * -> *) backend record.
(MonadIO m, PersistStoreWrite backend, PersistEntity record,
 PersistEntityBackend record ~ BaseBackend backend) =>
[record] -> ReaderT backend m ()
repsertMany' ([TxCollateralOutToken] -> SqlPersistT IO ())
-> [TxCollateralOutToken] -> SqlPersistT IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (TxCollateralOut, [TxCollateralOutToken])
-> [(TxCollateralOut, [TxCollateralOutToken])]
forall a. Maybe a -> [a]
maybeToList (Maybe (TxCollateralOut, [TxCollateralOutToken])
collateralOuts) [(TxCollateralOut, [TxCollateralOutToken])]
-> ((TxCollateralOut, [TxCollateralOutToken])
    -> [TxCollateralOutToken])
-> [TxCollateralOutToken]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (TxCollateralOut, [TxCollateralOutToken]) -> [TxCollateralOutToken]
forall a b. (a, b) -> b
snd
    [TxWithdrawal] -> SqlPersistT IO ()
forall (m :: * -> *) backend record.
(MonadIO m, PersistStoreWrite backend, PersistEntity record,
 PersistEntityBackend record ~ BaseBackend backend) =>
[record] -> ReaderT backend m ()
repsertMany' [TxWithdrawal]
withdrawals

    where
        repsertMany' :: [record] -> ReaderT backend m ()
repsertMany' [record]
xs = let
            Just record -> Key record
f = Maybe (record -> Key record)
forall record. PersistEntity record => Maybe (record -> Key record)
keyFromRecordM
            in ([(Key record, record)] -> ReaderT backend m ())
-> [(Key record, record)] -> ReaderT backend m ()
forall (m :: * -> *) e b. Monad m => ([e] -> m b) -> [e] -> m ()
chunked [(Key record, record)] -> ReaderT backend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[(Key record, record)] -> ReaderT backend m ()
repsertMany [(record -> Key record
forall record. PersistEntity record => record -> Key record
f record
x, record
x) | record
x <- [record]
xs]
        -- needed to submit large numberot transactions
        chunked :: ([e] -> m b) -> [e] -> m ()
chunked [e] -> m b
f [e]
xs = ([e] -> m b) -> [[e]] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [e] -> m b
f (Int -> [e] -> [[e]]
forall e. Int -> [e] -> [[e]]
chunksOf Int
1000 [e]
xs)

-- | Select transactions history from the database
selectTxHistory :: SqlPersistT IO TxHistory
selectTxHistory :: ReaderT SqlBackend IO TxHistory
selectTxHistory = Map TxId (TxRelationF 'Without) -> TxHistory
forall (f :: Decoration). Map TxId (TxRelationF f) -> TxHistoryF f
TxHistoryF (Map TxId (TxRelationF 'Without) -> TxHistory)
-> ReaderT SqlBackend IO (Map TxId (TxRelationF 'Without))
-> ReaderT SqlBackend IO TxHistory
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT SqlBackend IO (Map TxId (TxRelationF 'Without))
select
  where
    selectListAll :: ReaderT backend m [Entity record]
selectListAll = [Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [] []
    select :: SqlPersistT IO (Map TxId (TxRelationF 'Without))
    select :: ReaderT SqlBackend IO (Map TxId (TxRelationF 'Without))
select = do
        Map TxId [TxIn]
inputs <- (TxIn -> TxId)
-> ReaderT SqlBackend IO [Entity TxIn]
-> ReaderT SqlBackend IO (Map TxId [TxIn])
forall k (f :: * -> *) (g :: * -> *) b.
(Ord k, Functor f, Applicative g, Semigroup (g b)) =>
(b -> k) -> f [Entity b] -> f (Map k (g b))
mkMap TxIn -> TxId
txInputTxId ReaderT SqlBackend IO [Entity TxIn]
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m, PersistEntity record,
 PersistEntityBackend record ~ BaseBackend backend) =>
ReaderT backend m [Entity record]
selectListAll
        Map TxId [TxCollateral]
collaterals <- (TxCollateral -> TxId)
-> ReaderT SqlBackend IO [Entity TxCollateral]
-> ReaderT SqlBackend IO (Map TxId [TxCollateral])
forall k (f :: * -> *) (g :: * -> *) b.
(Ord k, Functor f, Applicative g, Semigroup (g b)) =>
(b -> k) -> f [Entity b] -> f (Map k (g b))
mkMap TxCollateral -> TxId
txCollateralTxId ReaderT SqlBackend IO [Entity TxCollateral]
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m, PersistEntity record,
 PersistEntityBackend record ~ BaseBackend backend) =>
ReaderT backend m [Entity record]
selectListAll
        Map TxId [TxOut]
outputs <- (TxOut -> TxId)
-> ReaderT SqlBackend IO [Entity TxOut]
-> ReaderT SqlBackend IO (Map TxId [TxOut])
forall k (f :: * -> *) (g :: * -> *) b.
(Ord k, Functor f, Applicative g, Semigroup (g b)) =>
(b -> k) -> f [Entity b] -> f (Map k (g b))
mkMap TxOut -> TxId
txOutputTxId ReaderT SqlBackend IO [Entity TxOut]
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m, PersistEntity record,
 PersistEntityBackend record ~ BaseBackend backend) =>
ReaderT backend m [Entity record]
selectListAll
        Map TxId (Maybe TxCollateralOut)
collateralOutputs
            <- (First TxCollateralOut -> Maybe TxCollateralOut)
-> Map TxId (First TxCollateralOut)
-> Map TxId (Maybe TxCollateralOut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap First TxCollateralOut -> Maybe TxCollateralOut
forall a. First a -> Maybe a
getFirst (Map TxId (First TxCollateralOut)
 -> Map TxId (Maybe TxCollateralOut))
-> ReaderT SqlBackend IO (Map TxId (First TxCollateralOut))
-> ReaderT SqlBackend IO (Map TxId (Maybe TxCollateralOut))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxCollateralOut -> TxId)
-> ReaderT SqlBackend IO [Entity TxCollateralOut]
-> ReaderT SqlBackend IO (Map TxId (First TxCollateralOut))
forall k (f :: * -> *) (g :: * -> *) b.
(Ord k, Functor f, Applicative g, Semigroup (g b)) =>
(b -> k) -> f [Entity b] -> f (Map k (g b))
mkMap TxCollateralOut -> TxId
txCollateralOutTxId ReaderT SqlBackend IO [Entity TxCollateralOut]
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m, PersistEntity record,
 PersistEntityBackend record ~ BaseBackend backend) =>
ReaderT backend m [Entity record]
selectListAll
        Map TxId [TxWithdrawal]
withdrawals <- (TxWithdrawal -> TxId)
-> ReaderT SqlBackend IO [Entity TxWithdrawal]
-> ReaderT SqlBackend IO (Map TxId [TxWithdrawal])
forall k (f :: * -> *) (g :: * -> *) b.
(Ord k, Functor f, Applicative g, Semigroup (g b)) =>
(b -> k) -> f [Entity b] -> f (Map k (g b))
mkMap TxWithdrawal -> TxId
txWithdrawalTxId ReaderT SqlBackend IO [Entity TxWithdrawal]
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m, PersistEntity record,
 PersistEntityBackend record ~ BaseBackend backend) =>
ReaderT backend m [Entity record]
selectListAll
        Map TxId [TxOutToken]
outTokens <- (TxOutToken -> TxId)
-> ReaderT SqlBackend IO [Entity TxOutToken]
-> ReaderT SqlBackend IO (Map TxId [TxOutToken])
forall k (f :: * -> *) (g :: * -> *) b.
(Ord k, Functor f, Applicative g, Semigroup (g b)) =>
(b -> k) -> f [Entity b] -> f (Map k (g b))
mkMap TxOutToken -> TxId
txOutTokenTxId ReaderT SqlBackend IO [Entity TxOutToken]
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m, PersistEntity record,
 PersistEntityBackend record ~ BaseBackend backend) =>
ReaderT backend m [Entity record]
selectListAll
        Map TxId [TxCollateralOutToken]
collateralTokens <- (TxCollateralOutToken -> TxId)
-> ReaderT SqlBackend IO [Entity TxCollateralOutToken]
-> ReaderT SqlBackend IO (Map TxId [TxCollateralOutToken])
forall k (f :: * -> *) (g :: * -> *) b.
(Ord k, Functor f, Applicative g, Semigroup (g b)) =>
(b -> k) -> f [Entity b] -> f (Map k (g b))
mkMap TxCollateralOutToken -> TxId
txCollateralOutTokenTxId ReaderT SqlBackend IO [Entity TxCollateralOutToken]
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m, PersistEntity record,
 PersistEntityBackend record ~ BaseBackend backend) =>
ReaderT backend m [Entity record]
selectListAll
        let ids :: Set TxId
ids =
                [Set TxId] -> Set TxId
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
                    [Map TxId [TxIn] -> Set TxId
forall k a. Map k a -> Set k
Map.keysSet Map TxId [TxIn]
inputs
                   , Map TxId [TxCollateral] -> Set TxId
forall k a. Map k a -> Set k
Map.keysSet Map TxId [TxCollateral]
collaterals
                   , Map TxId [TxOut] -> Set TxId
forall k a. Map k a -> Set k
Map.keysSet Map TxId [TxOut]
outputs
                   , Map TxId (Maybe TxCollateralOut) -> Set TxId
forall k a. Map k a -> Set k
Map.keysSet Map TxId (Maybe TxCollateralOut)
collateralOutputs
                   , Map TxId [TxWithdrawal] -> Set TxId
forall k a. Map k a -> Set k
Map.keysSet Map TxId [TxWithdrawal]
withdrawals
                   , Map TxId [TxOutToken] -> Set TxId
forall k a. Map k a -> Set k
Map.keysSet Map TxId [TxOutToken]
outTokens
                   , Map TxId [TxCollateralOutToken] -> Set TxId
forall k a. Map k a -> Set k
Map.keysSet Map TxId [TxCollateralOutToken]
collateralTokens
                    ]
            selectOutTokens :: TxId -> TxOut -> [TxOutToken]
            selectOutTokens :: TxId -> TxOut -> [TxOutToken]
selectOutTokens TxId
txId TxOut
txOut =
                (TxOutToken -> Bool) -> [TxOutToken] -> [TxOutToken]
forall a. (a -> Bool) -> [a] -> [a]
filter
                    (\TxOutToken
token -> TxOutToken -> Word32
txOutTokenTxIndex TxOutToken
token Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== TxOut -> Word32
txOutputIndex TxOut
txOut)
                ([TxOutToken] -> [TxOutToken]) -> [TxOutToken] -> [TxOutToken]
forall a b. (a -> b) -> a -> b
$ [TxOutToken] -> TxId -> Map TxId [TxOutToken] -> [TxOutToken]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] TxId
txId Map TxId [TxOutToken]
outTokens
            selectCollateralTokens
                :: TxId -> TxCollateralOut -> [TxCollateralOutToken]
            selectCollateralTokens :: TxId -> TxCollateralOut -> [TxCollateralOutToken]
selectCollateralTokens TxId
txId TxCollateralOut
_ =
                [TxCollateralOutToken]
-> TxId
-> Map TxId [TxCollateralOutToken]
-> [TxCollateralOutToken]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] TxId
txId Map TxId [TxCollateralOutToken]
collateralTokens
        Map TxId (TxRelationF 'Without)
-> ReaderT SqlBackend IO (Map TxId (TxRelationF 'Without))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map TxId (TxRelationF 'Without)
 -> ReaderT SqlBackend IO (Map TxId (TxRelationF 'Without)))
-> Map TxId (TxRelationF 'Without)
-> ReaderT SqlBackend IO (Map TxId (TxRelationF 'Without))
forall a b. (a -> b) -> a -> b
$ [Map TxId (TxRelationF 'Without)]
-> Map TxId (TxRelationF 'Without)
forall a. Monoid a => [a] -> a
mconcat ([Map TxId (TxRelationF 'Without)]
 -> Map TxId (TxRelationF 'Without))
-> [Map TxId (TxRelationF 'Without)]
-> Map TxId (TxRelationF 'Without)
forall a b. (a -> b) -> a -> b
$ do
            TxId
k <- Set TxId -> [TxId]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set TxId
ids
            Map TxId (TxRelationF 'Without)
-> [Map TxId (TxRelationF 'Without)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                (Map TxId (TxRelationF 'Without)
 -> [Map TxId (TxRelationF 'Without)])
-> Map TxId (TxRelationF 'Without)
-> [Map TxId (TxRelationF 'Without)]
forall a b. (a -> b) -> a -> b
$ TxId -> TxRelationF 'Without -> Map TxId (TxRelationF 'Without)
forall k a. k -> a -> Map k a
Map.singleton TxId
k
                (TxRelationF 'Without -> Map TxId (TxRelationF 'Without))
-> TxRelationF 'Without -> Map TxId (TxRelationF 'Without)
forall a b. (a -> b) -> a -> b
$ TxRelationF :: forall (f :: Decoration).
[DecorateWithTxOut f TxIn]
-> [DecorateWithTxOut f TxCollateral]
-> [(TxOut, [TxOutToken])]
-> Maybe (TxCollateralOut, [TxCollateralOutToken])
-> [TxWithdrawal]
-> TxRelationF f
TxRelationF
                { $sel:ins:TxRelationF :: [DecorateWithTxOut 'Without TxIn]
ins = (TxIn -> Int) -> [TxIn] -> [TxIn]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn TxIn -> Int
txInputOrder ([TxIn] -> [TxIn]) -> [TxIn] -> [TxIn]
forall a b. (a -> b) -> a -> b
$ [TxIn] -> TxId -> Map TxId [TxIn] -> [TxIn]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] TxId
k Map TxId [TxIn]
inputs
                , $sel:collateralIns:TxRelationF :: [DecorateWithTxOut 'Without TxCollateral]
collateralIns = (TxCollateral -> Int) -> [TxCollateral] -> [TxCollateral]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn TxCollateral -> Int
txCollateralOrder
                      ([TxCollateral] -> [TxCollateral])
-> [TxCollateral] -> [TxCollateral]
forall a b. (a -> b) -> a -> b
$ [TxCollateral] -> TxId -> Map TxId [TxCollateral] -> [TxCollateral]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] TxId
k Map TxId [TxCollateral]
collaterals
                , $sel:outs:TxRelationF :: [(TxOut, [TxOutToken])]
outs = ((TxOut, [TxOutToken]) -> (TxOut, [TxOutToken]))
-> [(TxOut, [TxOutToken])] -> [(TxOut, [TxOutToken])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([TxOutToken] -> [TxOutToken])
-> (TxOut, [TxOutToken]) -> (TxOut, [TxOutToken])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([TxOutToken] -> [TxOutToken])
 -> (TxOut, [TxOutToken]) -> (TxOut, [TxOutToken]))
-> ([TxOutToken] -> [TxOutToken])
-> (TxOut, [TxOutToken])
-> (TxOut, [TxOutToken])
forall a b. (a -> b) -> a -> b
$ (TxOutToken -> (TokenPolicyId, TokenName))
-> [TxOutToken] -> [TxOutToken]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn TxOutToken -> (TokenPolicyId, TokenName)
tokenOutOrd)
                      ([(TxOut, [TxOutToken])] -> [(TxOut, [TxOutToken])])
-> [(TxOut, [TxOutToken])] -> [(TxOut, [TxOutToken])]
forall a b. (a -> b) -> a -> b
$ ((TxOut, [TxOutToken]) -> Word32)
-> [(TxOut, [TxOutToken])] -> [(TxOut, [TxOutToken])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (TxOut -> Word32
txOutputIndex (TxOut -> Word32)
-> ((TxOut, [TxOutToken]) -> TxOut)
-> (TxOut, [TxOutToken])
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut, [TxOutToken]) -> TxOut
forall a b. (a, b) -> a
fst)
                      ([(TxOut, [TxOutToken])] -> [(TxOut, [TxOutToken])])
-> [(TxOut, [TxOutToken])] -> [(TxOut, [TxOutToken])]
forall a b. (a -> b) -> a -> b
$ (TxOut -> TxOut
forall a. a -> a
id (TxOut -> TxOut)
-> (TxOut -> [TxOutToken]) -> TxOut -> (TxOut, [TxOutToken])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& TxId -> TxOut -> [TxOutToken]
selectOutTokens TxId
k)
                      (TxOut -> (TxOut, [TxOutToken]))
-> [TxOut] -> [(TxOut, [TxOutToken])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOut] -> TxId -> Map TxId [TxOut] -> [TxOut]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] TxId
k Map TxId [TxOut]
outputs
                , $sel:collateralOuts:TxRelationF :: Maybe (TxCollateralOut, [TxCollateralOutToken])
collateralOuts = ((TxCollateralOut, [TxCollateralOutToken])
 -> (TxCollateralOut, [TxCollateralOutToken]))
-> Maybe (TxCollateralOut, [TxCollateralOutToken])
-> Maybe (TxCollateralOut, [TxCollateralOutToken])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([TxCollateralOutToken] -> [TxCollateralOutToken])
-> (TxCollateralOut, [TxCollateralOutToken])
-> (TxCollateralOut, [TxCollateralOutToken])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([TxCollateralOutToken] -> [TxCollateralOutToken])
 -> (TxCollateralOut, [TxCollateralOutToken])
 -> (TxCollateralOut, [TxCollateralOutToken]))
-> ([TxCollateralOutToken] -> [TxCollateralOutToken])
-> (TxCollateralOut, [TxCollateralOutToken])
-> (TxCollateralOut, [TxCollateralOutToken])
forall a b. (a -> b) -> a -> b
$ (TxCollateralOutToken -> (TokenPolicyId, TokenName))
-> [TxCollateralOutToken] -> [TxCollateralOutToken]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn TxCollateralOutToken -> (TokenPolicyId, TokenName)
tokenCollateralOrd)
                      (Maybe (TxCollateralOut, [TxCollateralOutToken])
 -> Maybe (TxCollateralOut, [TxCollateralOutToken]))
-> Maybe (TxCollateralOut, [TxCollateralOutToken])
-> Maybe (TxCollateralOut, [TxCollateralOutToken])
forall a b. (a -> b) -> a -> b
$ (TxCollateralOut -> TxCollateralOut
forall a. a -> a
id (TxCollateralOut -> TxCollateralOut)
-> (TxCollateralOut -> [TxCollateralOutToken])
-> TxCollateralOut
-> (TxCollateralOut, [TxCollateralOutToken])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& TxId -> TxCollateralOut -> [TxCollateralOutToken]
selectCollateralTokens TxId
k)
                      (TxCollateralOut -> (TxCollateralOut, [TxCollateralOutToken]))
-> Maybe TxCollateralOut
-> Maybe (TxCollateralOut, [TxCollateralOutToken])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TxCollateralOut
-> TxId
-> Map TxId (Maybe TxCollateralOut)
-> Maybe TxCollateralOut
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Maybe TxCollateralOut
forall a. Maybe a
Nothing TxId
k Map TxId (Maybe TxCollateralOut)
collateralOutputs
                , $sel:withdrawals:TxRelationF :: [TxWithdrawal]
withdrawals = (TxWithdrawal -> RewardAccount) -> [TxWithdrawal] -> [TxWithdrawal]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn TxWithdrawal -> RewardAccount
txWithdrawalAccount
                      ([TxWithdrawal] -> [TxWithdrawal])
-> [TxWithdrawal] -> [TxWithdrawal]
forall a b. (a -> b) -> a -> b
$ [TxWithdrawal] -> TxId -> Map TxId [TxWithdrawal] -> [TxWithdrawal]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] TxId
k Map TxId [TxWithdrawal]
withdrawals
                }

mkMap :: (Ord k, Functor f, Applicative g, Semigroup (g b))
    => (b -> k)
    -> f [Entity b]
    -> f (Map k (g b))
mkMap :: (b -> k) -> f [Entity b] -> f (Map k (g b))
mkMap b -> k
k f [Entity b]
v =
    (g b -> g b -> g b) -> [(k, g b)] -> Map k (g b)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith g b -> g b -> g b
forall a. Semigroup a => a -> a -> a
(<>)
    ([(k, g b)] -> Map k (g b))
-> ([Entity b] -> [(k, g b)]) -> [Entity b] -> Map k (g b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity b -> (k, g b)) -> [Entity b] -> [(k, g b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> k
k (b -> k) -> (b -> g b) -> b -> (k, g b)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& b -> g b
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (b -> (k, g b)) -> (Entity b -> b) -> Entity b -> (k, g b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity b -> b
forall record. Entity record -> record
entityVal)
    ([Entity b] -> Map k (g b)) -> f [Entity b] -> f (Map k (g b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [Entity b]
v