/
Store.hs
103 lines (91 loc) · 3.45 KB
/
Store.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
-- |
-- Copyright: © 2023 IOHK
-- License: Apache-2.0
module Cardano.Wallet.DB.Store.PrivateKey.Store
( mkStorePrivateKey
, PrivateKey (..)
, DeltaPrivateKey
, StorePrivateKey
) 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
deriving instance Eq (k 'RootK XPrv) => Eq (PrivateKey k)
deriving instance Show (k 'RootK XPrv) => Show (PrivateKey k)
-- | 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)