Merge pull request #282 from input-output-hk/rvl/154/sqlite-private-key

SQLite: Add put/readPrivateKey to DBLayer
cardano-foundation · May 20, 2019 · 44c5a55 · 44c5a55
2 parents 89d27d1 + f8ad236
commit 44c5a55
Show file tree

Hide file tree

Showing 2 changed files with 52 additions and 6 deletions.
diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedLabels #-}
@@ -14,12 +15,16 @@ module Cardano.Wallet.DB.Sqlite
 
 import Prelude
 
+import Cardano.Crypto.Wallet
+    ( XPrv )
 import Cardano.Wallet.DB
     ( DBLayer (..)
     , ErrNoSuchWallet (..)
     , ErrWalletAlreadyExists (..)
     , PrimaryKey (..)
     )
+import Cardano.Wallet.Primitive.AddressDerivation
+    ( Depth (..), deserializeXPrv, serializeXPrv )
 import Conduit
     ( runResourceT )
 import Control.Monad
@@ -42,6 +47,7 @@ import Database.Persist.Sql
     ( LogFunc
     , Update (..)
     , deleteCascadeWhere
+    , deleteWhere
     , entityVal
     , insert_
     , runMigration
@@ -63,6 +69,7 @@ import System.Log.FastLogger
 
 import Cardano.Wallet.DB.Sqlite.TH
 
+import qualified Cardano.Wallet.Primitive.AddressDerivation as W
 import qualified Cardano.Wallet.Primitive.Types as W
 import qualified Data.ByteString.Char8 as B8
 import qualified Data.Text as T
@@ -93,10 +100,7 @@ dbLogs levels _ _ level str =
 
 -- | Run a query without error handling. There will be exceptions thrown if it
 -- fails.
-runQuery
-    :: SqlBackend
-    -> SqlPersistM a
-    -> IO a
+runQuery :: SqlBackend -> SqlPersistM a -> IO a
 runQuery conn = runResourceT . runNoLoggingT . flip runSqlConn conn
 
 -- | Run an action, and convert any Sqlite constraints exception into the given
@@ -182,9 +186,19 @@ newDBLayer fp = do
                                        Keystore
         -----------------------------------------------------------------------}
 
-        , putPrivateKey = \(PrimaryKey _wid) _key -> error "unimplemented"
+        , putPrivateKey = \(PrimaryKey wid) key ->
+            ExceptT $ runQuery conn $
+            selectWallet wid >>= \case
+                Just _ -> Right <$> do
+                    deleteWhere [PrivateKeyTableWalletId ==. wid]
+                    insert_ (mkPrivateKeyEntity wid key)
+                Nothing -> pure $ Left $ ErrNoSuchWallet wid
 
-        , readPrivateKey = \(PrimaryKey _wid) -> error "unimplemented"
+        , readPrivateKey = \(PrimaryKey wid) ->
+            runQuery conn $ let
+                keys = selectFirst [PrivateKeyTableWalletId ==. wid] []
+                toMaybe = either (const Nothing) Just
+            in (>>= toMaybe . privateKeyFromEntity . entityVal) <$> keys
 
         {-----------------------------------------------------------------------
                                        Lock
@@ -233,6 +247,23 @@ metadataFromEntity wal = W.WalletMetadata
     , delegation = delegationFromText (walTableDelegation wal)
     }
 
+mkPrivateKeyEntity
+    :: W.WalletId
+    -> (W.Key 'RootK XPrv, W.Hash "encryption")
+    -> PrivateKey
+mkPrivateKeyEntity wid kh = PrivateKey
+    { privateKeyTableWalletId = wid
+    , privateKeyTableRootKey = root
+    , privateKeyTableHash = hash
+    }
+  where
+    (root, hash) = serializeXPrv kh
+
+privateKeyFromEntity
+    :: PrivateKey
+    -> Either String (W.Key 'RootK XPrv, W.Hash "encryption")
+privateKeyFromEntity (PrivateKey _ k h) = deserializeXPrv (k, h)
+
 ----------------------------------------------------------------------------
 -- DB Queries
 

diff --git a/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs b/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs
@@ -18,6 +18,8 @@ import Cardano.Wallet.DB.Sqlite
     ( newDBLayer )
 import Cardano.Wallet.DBSpec
     ( cleanDB )
+import Cardano.Wallet.Primitive.AddressDerivation
+    ( encryptPassphrase, unsafeGenerateKeyFromSeed )
 import Cardano.Wallet.Primitive.Types
     ( WalletDelegation (..)
     , WalletId (..)
@@ -32,6 +34,10 @@ import Crypto.Hash
     ( hash )
 import Data.ByteString
     ( ByteString )
+import Data.Coerce
+    ( coerce )
+import Data.Text.Class
+    ( FromText (..) )
 import Data.Time.Clock
     ( getCurrentTime )
 import Test.Hspec
@@ -55,6 +61,15 @@ spec = beforeAll (newDBLayer Nothing) $ beforeWith cleanDB $ do
             runExceptT create' `shouldReturn` (Right ())
             runExceptT create' `shouldReturn` (Left (ErrWalletAlreadyExists testWid))
 
+        it "create and get private key" $ \db -> do
+            unsafeRunExceptT $ createWallet db testPk undefined testMetadata
+            readPrivateKey db testPk `shouldReturn` Nothing
+            let Right phr = fromText "aaaaaaaaaa"
+                k = unsafeGenerateKeyFromSeed (coerce phr, coerce phr) phr
+            h <- encryptPassphrase phr
+            unsafeRunExceptT (putPrivateKey db testPk (k, h))
+            readPrivateKey db testPk `shouldReturn` Just (k, h)
+
 testMetadata :: WalletMetadata
 testMetadata = WalletMetadata
     { name = WalletName "test wallet"