Add PrivateKey store module.

lib/wallet/cardano-wallet.cabal

@@ -268,6 +268,7 @@ library
     Cardano.Wallet.DB.Store.Meta.Layer
     Cardano.Wallet.DB.Store.Meta.Model
     Cardano.Wallet.DB.Store.Meta.Store
+    Cardano.Wallet.DB.Store.PrivateKey.Store
     Cardano.Wallet.DB.Store.Submissions.Layer
     Cardano.Wallet.DB.Store.Submissions.Operations
     Cardano.Wallet.DB.Store.Transactions.Decoration

lib/wallet/src/Cardano/Wallet/DB/Store/PrivateKey/Store.hs

@@ -0,0 +1,94 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+-- |
+-- Copyright: © 2023 IOHK
+-- License: Apache-2.0
+module Cardano.Wallet.DB.Store.PrivateKey.Store
+    ( mkStorePrivateKey
+    ) where
+
+import Prelude
+
+import Cardano.Address.Derivation
+    ( XPrv )
+import Cardano.Wallet.Address.Derivation
+    ( Depth (..) )
+import Cardano.Wallet.Address.Keys.PersistPrivateKey
+    ( serializeXPrv, unsafeDeserializeXPrv )
+import Cardano.Wallet.DB.Errors
+    ( ErrWalletNotInitialized (ErrWalletNotInitialized) )
+import Cardano.Wallet.Flavor
+    ( KeyFlavorS )
+import Cardano.Wallet.Primitive.Passphrase.Types
+    ( PassphraseHash )
+import Cardano.Wallet.Primitive.Types
+    ( WalletId )
+import Control.Exception
+    ( SomeException (..) )
+import Control.Monad.Class.MonadThrow
+    ( throwIO )
+import Data.Delta
+    ( Replace (..) )
+import Data.Store
+    ( UpdateStore, mkUpdateStore, updateLoad )
+import Database.Persist
+    ( Entity (entityVal), Filter, PersistQueryRead (selectFirst), insert_ )
+import Database.Persist.Sql
+    ( SqlPersistT, deleteWhere )
+
+import qualified Cardano.Wallet.DB.Sqlite.Schema as Schema
+
+-- | A 'PrivateKey' for a given 'KeyFlavor'.
+data PrivateKey k = PrivateKey (k 'RootK XPrv) PassphraseHash
+
+-- | A 'Delta' for 'PrivateKey'.
+type DeltaPrivateKey k = Replace (PrivateKey k)
+
+-- | A 'Store' for 'PrivateKey'.
+type StorePrivateKey k = UpdateStore (SqlPersistT IO) (DeltaPrivateKey k)
+
+-- | Construct a 'StorePrivateKey' for a given 'KeyFlavor'.  ATM a WalletId is
+-- required to be able to store the private key.  This limitation is due to the
+-- fact that the table for the private key requires a foreign key to the table
+-- of the wallet.
+mkStorePrivateKey
+    :: forall k
+     . KeyFlavorS k
+    -> WalletId
+    -> StorePrivateKey k
+mkStorePrivateKey kF wid = mkUpdateStore load write update
+    where
+        load :: SqlPersistT IO (Either SomeException (PrivateKey k))
+        load = do
+            keys <- selectFirst [] []
+            case keys of
+                Nothing -> pure $ Left $ SomeException ErrWalletNotInitialized
+                Just key -> pure $ Right $ privateKeyFromEntity $ entityVal key
+            where
+                privateKeyFromEntity :: Schema.PrivateKey -> PrivateKey k
+                privateKeyFromEntity (Schema.PrivateKey _ k h) =
+                    uncurry PrivateKey $ unsafeDeserializeXPrv kF (k, h)
+
+        write :: PrivateKey k -> SqlPersistT IO ()
+        write key = do
+            deleteWhere ([] :: [Filter Schema.PrivateKey])
+            insert_ (mkPrivateKeyEntity key)
+
+        update :: Maybe (PrivateKey k) -> DeltaPrivateKey k -> SqlPersistT IO ()
+        update = updateLoad load throwIO $ \_ -> \case
+            Replace key -> do
+                deleteWhere ([] :: [Filter Schema.PrivateKey])
+                insert_ (mkPrivateKeyEntity key)
+
+        mkPrivateKeyEntity (PrivateKey k h) =
+            Schema.PrivateKey
+                { Schema.privateKeyWalletId = wid
+                , Schema.privateKeyRootKey = root
+                , Schema.privateKeyHash = hash
+                }
+          where
+            (root, hash) = serializeXPrv kF (k, h)