add submissions primitives store

lib/wallet/cardano-wallet.cabal

@@ -236,6 +236,7 @@ library
     Cardano.Wallet.DB.Store.Meta.Model
     Cardano.Wallet.DB.Store.Meta.Store
     Cardano.Wallet.DB.Store.Submissions.Model
+    Cardano.Wallet.DB.Store.Submissions.New.Primitives
     Cardano.Wallet.DB.Store.Submissions.Store
     Cardano.Wallet.DB.Store.Transactions.Model
     Cardano.Wallet.DB.Store.Transactions.Store

lib/wallet/src/Cardano/Wallet/DB/Store/Submissions/New/Primitives.hs

@@ -0,0 +1,132 @@
+
+
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+
+{-# OPTIONS_GHC -Wno-orphans #-}
+{- |
+Copyright: 2022 IOHK
+License: Apache-2.0
+
+Implementation of a 'Store' for 'Submissions.Submissions' based on 'Primitives'.
+
+-}
+
+module Cardano.Wallet.DB.Store.Submissions.New.Primitives
+    ( mkStorePrimitivesSubmissions, Submissions', Primitive' ) where
+
+import Prelude
+
+import Cardano.Wallet.DB.Sqlite.Schema
+    ( EntityField (SubmissionWallet, SubmissionsSlotsWallet)
+    , Key (SubmissionsKey, SubmissionsSlotsKey)
+    , Submissions (Submissions)
+    , SubmissionsSlots (SubmissionsSlots)
+    )
+import Cardano.Wallet.DB.Sqlite.Types
+    ( TxId )
+import Cardano.Wallet.Primitive.Types
+    ( SlotNo (..), WalletId )
+import Cardano.Wallet.Submissions.Primitives
+    ( applyPrimitive )
+import Cardano.Wallet.Submissions.Submissions
+    ( finality, tip, transactions )
+import Control.Exception
+    ( Exception, SomeException (..) )
+import Control.Monad
+    ( forM_ )
+import Data.DBVar
+    ( Store (..) )
+import Data.Delta
+    ( Delta (..) )
+import Data.Map.Strict
+    ( Map )
+import Database.Persist
+    ( Entity (Entity), PersistStoreWrite (delete, repsert), selectList, (==.) )
+import Database.Persist.Sql
+    ( SqlPersistT )
+
+import qualified Cardano.Wallet.Primitive.Types.Tx as W
+import qualified Cardano.Wallet.Submissions.Primitives as Sbm
+import qualified Cardano.Wallet.Submissions.Submissions as Sbm
+import qualified Cardano.Wallet.Submissions.TxStatus as Sbm
+import qualified Data.Map.Strict as Map
+
+type Submissions' = Sbm.Submissions SlotNo (TxId, W.SealedTx)
+type Primitive' = Sbm.Primitive SlotNo (TxId, W.SealedTx)
+type TxStatus' = Sbm.TxStatus SlotNo (TxId, W.SealedTx)
+
+syncSubmissions :: WalletId -> Submissions' -> Submissions' -> SqlPersistT IO ()
+syncSubmissions wid old new = do
+
+    let deletes = transactions old `Map.difference` transactions new
+    forM_ (Map.keys deletes) $ \k -> delete (SubmissionsKey k)
+
+    let repserts = transactions new
+    forM_ (Map.assocs repserts) $ \(iden, status) -> do
+        let result = case status of
+                Sbm.Expired expiring (_, sealed)
+                    -> Just (sealed, expiring,Nothing,1)
+                Sbm.InSubmission expiring (_, sealed)
+                    -> Just (sealed, expiring,Nothing,0)
+                Sbm.InLedger expiring acceptance (_, sealed)
+                    -> Just (sealed, expiring, Just acceptance,2)
+                Sbm.Unknown -> Nothing
+        case result of
+            Just (sealed, expiring, acceptance,statusNumber ) -> repsert
+                (SubmissionsKey iden)
+                (Submissions iden sealed expiring acceptance wid statusNumber)
+            Nothing -> pure ()
+    repsert
+        (SubmissionsSlotsKey wid)
+        $ SubmissionsSlots (finality new) (tip new) wid
+
+instance Delta Primitive' where
+  type Base Primitive' = Submissions'
+  apply = applyPrimitive
+
+instance Sbm.HasTxId (TxId, W.SealedTx) where
+    type TxId (TxId, W.SealedTx) = TxId
+    txId (iden,_) = iden
+
+data SubmissionsError
+    = SubmissionsSlotsMissingForWallet WalletId
+    | MoreThanOneSubmissionsSlotsDefinedForWallet WalletId
+    deriving (Show, Eq, Exception)
+
+mkStorePrimitivesSubmissions :: WalletId
+    -> Store (SqlPersistT IO) Primitive'
+mkStorePrimitivesSubmissions wid =
+    Store
+    { loadS = do
+        slots <- selectList [SubmissionsSlotsWallet ==. wid] []
+        txs <- selectList [SubmissionWallet ==. wid ] []
+        pure $ case slots of
+            [] -> Left $ SomeException $ SubmissionsSlotsMissingForWallet wid
+            [Entity _ (SubmissionsSlots finality' tip' _)] -> Right
+                $ Sbm.Submissions (mkTransactions tip' txs) finality' tip'
+            _ -> Left $ SomeException
+                    $ MoreThanOneSubmissionsSlotsDefinedForWallet wid
+    , writeS = syncSubmissions wid (Sbm.Submissions mempty 0 0)
+    , updateS = \base delta ->
+            syncSubmissions wid base $ applyPrimitive delta base
+    }
+
+mkTransactions :: SlotNo -> [Entity Submissions] -> Map TxId TxStatus'
+mkTransactions tip' xs = Map.fromList $ do
+    Entity _  (Submissions iden sealed expiration acceptance _ status) <- xs
+    pure (iden, mkStatus tip' iden sealed expiration acceptance status)
+
+mkStatus :: SlotNo -> TxId -> W.SealedTx -> SlotNo -> Maybe SlotNo
+    -> Int -> TxStatus'
+mkStatus _ iden sealed expiring (Just acceptance) 2
+    = Sbm.InLedger expiring acceptance (iden, sealed)
+mkStatus tip' iden sealed expiring Nothing 0
+    | expiring > tip' = Sbm.InSubmission expiring (iden, sealed)
+    | otherwise = Sbm.Unknown
+mkStatus tip' iden sealed expiring Nothing 1
+    | expiring <= tip' = Sbm.Expired expiring (iden, sealed)
+    | otherwise = Sbm.Unknown
+mkStatus _ _ _ _ _ _ = Sbm.Unknown