QSM: Enable generating Put/ReadPrivateKey commands

cardano-foundation · May 27, 2019 · c56248a · c56248a
1 parent 9d753e9
commit c56248a
Showing 1 changed file with 13 additions and 9 deletions.
diff --git a/lib/core/test/unit/Cardano/Wallet/DBSpec2.hs b/lib/core/test/unit/Cardano/Wallet/DBSpec2.hs
@@ -32,7 +32,7 @@ import Cardano.Wallet.DB
 import Cardano.Wallet.DB.TestWallet
     ( DummyState (..), DummyTarget )
 import Cardano.Wallet.Primitive.AddressDerivation
-    ( Depth (..), Key, XPrv )
+    ( Depth (..), Key, XPrv, deserializeXPrv )
 import Cardano.Wallet.Primitive.Model
     ( Wallet )
 import Cardano.Wallet.Primitive.Types
@@ -171,7 +171,7 @@ newtype MWid = MWid String
     deriving (Show, Eq, Ord, Generic)
 
 type MWallet = Wallet DummyState DummyTarget
-type MPrivKey = (String, String)
+type MPrivKey = String
 
 newtype MConn = MConn Int
     deriving (Show, Eq, Ord, Generic)
@@ -260,7 +260,7 @@ mPutPrivateKey wid pk' m@(M cp metas txs pk n)
 mReadPrivateKey :: MWid -> MockOp (Maybe MPrivKey)
 mReadPrivateKey wid m@(M cp _ _ pk _)
     | wid `Map.member` cp = (Right (Map.lookup wid pk), m)
-    | otherwise           = (Left (NoSuchWallet wid), m)
+    | otherwise           = (Right Nothing, m)
 
 {-------------------------------------------------------------------------------
   Language
@@ -417,16 +417,17 @@ runIO connect = fmap Resp . go
         readTxHistory (dbLayer db) (widPK' wid)
     go (PutPrivateKey db wid pk) =
         catchNoSuchWallet Unit $
-        putPrivateKey (dbLayer db) (widPK' wid) (toPk pk)
+        putPrivateKey (dbLayer db) (widPK' wid) (fromMockPrivKey pk)
     go (ReadPrivateKey db wid) =
-        Right . PrivateKey . fmap fromPk <$>
+        Right . PrivateKey . fmap toMockPrivKey <$>
         readPrivateKey (dbLayer db) (widPK' wid)
 
     catchWalletAlreadyExists f = fmap (bimap errWalletAlreadyExists f) . runExceptT
     catchNoSuchWallet f = fmap (bimap errNoSuchWallet f) . runExceptT
 
-    toPk s = error "putPrivateKey"
-    fromPk (k, h) = error "readPrivateKey"
+    fromMockPrivKey s = (k, Hash (B8.pack s))
+        where Right (k, _) = deserializeXPrv (B8.replicate 256 '0', mempty)
+    toMockPrivKey (_, Hash h) = B8.unpack h
 
     unPrimaryKey :: PrimaryKey key -> key
     unPrimaryKey (PrimaryKey key) = key
@@ -538,8 +539,8 @@ generator (Model _ wids conns) = Just $ QC.oneof $ concat
         , fmap At $ ReadWalletMeta <$> genConn <*> genId'
         , fmap At $ PutTxHistory <$> genConn <*> genId' <*> fmap unGenTxHistory arbitrary
         , fmap At $ ReadTxHistory <$> genConn <*> genId'
-        -- , fmap At $ PutPrivateKey <$> genId <*> genPrivKey
-        -- , fmap At $ ReadPrivateKey <$> genId
+        , fmap At $ PutPrivateKey <$> genConn <*> genId' <*> genPrivKey
+        , fmap At $ ReadPrivateKey <$> genConn <*> genId'
         ]
 
     genId :: Gen MWid
@@ -550,6 +551,9 @@ generator (Model _ wids conns) = Just $ QC.oneof $ concat
     genConn :: Gen (Reference DBLayerTest Symbolic)
     genConn = QC.elements (map fst conns)
 
+    genPrivKey :: Gen MPrivKey
+    genPrivKey = QC.elements ["pk1", "pk2", "pk3"]
+
 instance Arbitrary (Hash a) where
     shrink _ = [] -- no way to shrink a hash
     arbitrary = Hash . B8.pack <$> replicateM 32 hex