Adapt test to new data types

shelley/chain-and-ledger/executable-spec/test/Generator.hs

@@ -33,7 +33,10 @@ import           Hedgehog
 import qualified Hedgehog.Gen    as Gen
 import qualified Hedgehog.Range  as Range
 
-import           TxData (pattern AddrVKey, StakeObject(..))
+import           TxData (pattern AddrVKey, pattern KeyHashStake, pattern Delegation,
+                         pattern PoolParams, RewardAcnt(..), pattern Delegate,
+                         pattern DeRegKey, pattern RegKey, pattern RegPool,
+                         pattern RetirePool, StakeKeys(..))
 import           BaseTypes
 import           Coin
 import           Keys (pattern KeyPair, hashKey, vKey)
@@ -46,11 +49,6 @@ import           Updates
 import           Tx(pattern Tx, pattern TxBody, pattern TxOut)
 import           UTxO (pattern UTxO, balance, makeWitnessVKey)
 import           PParams (PParams(..), emptyPParams)
-import           Delegation.Certificates (pattern Delegate, pattern DeRegKey,
-                     pattern RegKey, pattern RegPool, pattern RetirePool,
-                     StakeKeys(..))
-import           Delegation.PoolParams (pattern Delegation, pattern PoolParams,
-                     RewardAcnt(..))
 
 import           MockTypes
 import           Mutator
@@ -240,9 +238,10 @@ findPayKeyPair (AddrVKey addr _) keyList =
 findPayKeyPair _ _ = error "currently no such keys should be generated"
 
 -- | Find first matching key pair for stake key in 'AddrTxin'.
-findStakeKeyPair :: KeyHash -> KeyPairs -> KeyPair
-findStakeKeyPair addr keyList =
-    snd $ head $ filter (\(_, stake) -> addr == (hashKey $ vKey stake)) keyList
+findStakeKeyPair :: StakeObject -> KeyPairs -> KeyPair
+findStakeKeyPair (KeyHashStake hk) keyList =
+    snd $ head $ filter (\(_, stake) -> hk == (hashKey $ vKey stake)) keyList
+findStakeKeyPair _ _ = undefined -- TODO treat script case
 
 -- | Returns the hashed 'addr' part of a 'TxOut'.
 getTxOutAddr :: TxOut -> Addr
@@ -325,13 +324,13 @@ genStakePool keys = do
   let interval = case mkUnitInterval $ fromIntegral marginPercent % 100 of
                    Just i  -> i
                    Nothing -> interval0
-  pure $ PoolParams poolKey pledge Map.empty cost interval Nothing (RewardAcnt $ hashKey acntKey) Set.empty
+  pure $ PoolParams poolKey pledge Map.empty cost interval Nothing (RewardAcnt $ KeyHashStake $ hashKey acntKey) Set.empty
 
 genDelegation :: KeyPairs -> DPState -> Gen Delegation
 genDelegation keys d = do
   poolKey      <- Gen.element $ Map.keys stKeys'
   delegatorKey <- getAnyStakeKey keys
-  pure $ Delegation delegatorKey $ (vKey $ findStakeKeyPair poolKey keys)
+  pure $ Delegation (KeyHashStake $ hashKey delegatorKey) $ (hashKey $ vKey $ findStakeKeyPair poolKey keys)
        where (StakeKeys stKeys') = d ^. dstate . stKeys
 
 genDCertRegPool :: KeyPairs -> Gen DCert

shelley/chain-and-ledger/executable-spec/test/MockTypes.hs

@@ -6,7 +6,6 @@ import           Cardano.Crypto.KES (MockKES)
 
 import qualified BlockChain
 import qualified Delegation.Certificates
-import qualified Delegation.PoolParams
 import qualified Keys
 import qualified LedgerState
 import qualified OCert
@@ -17,11 +16,11 @@ import qualified UTxO
 
 type DCert = Delegation.Certificates.DCert ShortHash MockDSIGN
 
-type Delegation = Delegation.PoolParams.Delegation MockDSIGN
+type Delegation = TxData.Delegation ShortHash MockDSIGN
 
-type PoolParams = Delegation.PoolParams.PoolParams ShortHash MockDSIGN
+type PoolParams = TxData.PoolParams ShortHash MockDSIGN
 
-type RewardAcnt = Delegation.PoolParams.RewardAcnt ShortHash MockDSIGN
+type RewardAcnt = TxData.RewardAcnt ShortHash MockDSIGN
 
 type KeyHash = Keys.KeyHash ShortHash MockDSIGN
 
@@ -74,3 +73,5 @@ type HashHeader = BlockChain.HashHeader ShortHash MockDSIGN MockKES
 type NewEpochState = LedgerState.NewEpochState ShortHash MockDSIGN
 
 type CHAIN = STS.Chain.CHAIN ShortHash MockDSIGN MockKES
+
+type StakeObject = TxData.StakeObject ShortHash MockDSIGN

shelley/chain-and-ledger/executable-spec/test/Mutator.hs

@@ -31,15 +31,14 @@ import           Coin
 import           Delegation.Certificates  (pattern Delegate, pattern DeRegKey,
                      pattern GenesisDelegate, pattern RegKey, pattern RegPool,
                      pattern RetirePool)
-import           Delegation.PoolParams
 import           Keys (vKey, hashKey)
 import           Updates
 
 import           Slot
 import           Tx (pattern Tx, pattern TxBody, pattern TxIn, pattern TxOut,
                       _body, _certs, _inputs, _outputs, _ttl, _txfee, _wdrls,
                       _witnessVKeySet, _witnessMSigMap)
-import           TxData (StakeObject(..))
+import           TxData (StakeObject(..), PoolParams(..), pattern Delegation)
 
 import           MockTypes
 
@@ -176,7 +175,7 @@ mutateDCert keys _ (RegPool (PoolParams _ pledge pledges cost margin altacnt rwd
 mutateDCert keys _ (Delegate (Delegation _ _)) = do
   delegator' <- getAnyStakeKey keys
   delegatee' <- getAnyStakeKey keys
-  pure $ Delegate $ Delegation delegator' delegatee'
+  pure $ Delegate $ Delegation (KeyHashStake $ hashKey delegator') (hashKey delegatee')
 
 mutateDCert keys _ (GenesisDelegate (gk, _)) = do
   _delegatee <- getAnyStakeKey keys

shelley/chain-and-ledger/executable-spec/test/UnitTests.hs

@@ -15,16 +15,16 @@ import           Test.Tasty
 import           Test.Tasty.HUnit
 
 import           Address
-import           TxData (pattern AddrVKey, pattern Ptr, StakeObject(..))
+import           TxData (pattern AddrVKey, pattern Ptr, StakeObject(..),
+                         Delegation (..), pattern PoolParams, pattern RewardAcnt,
+                         _poolAltAcnt, _poolCost, _poolMargin, _poolOwners,
+                         _poolPubKey, _poolPledge, _poolPledges, _poolRAcnt)
 import           BaseTypes
 import           Coin
 import           Delegation.Certificates (pattern Delegate, pattern RegKey,
                      pattern RegPool, pattern RetirePool, StakePools(..),
                      StakeKeys(..))
-import           Delegation.PoolParams (Delegation (..), pattern PoolParams,
-                     pattern RewardAcnt, _poolAltAcnt, _poolCost, _poolMargin,
-                     _poolOwners, _poolPubKey, _poolPledge, _poolPledges,
-                     _poolRAcnt)
+
 import           Keys (pattern Dms, pattern KeyPair, hashKey, vKey)
 import           LedgerState (pattern LedgerState, pattern UTxOState,
                      ValidationError(..), _delegationState, _dms, _dstate,
@@ -117,7 +117,8 @@ testValidDelegation txs utxoState' stakeKeyRegistration pool =
          (LedgerState
           utxoState'
           (stakeKeyRegistration
-           & dstate . delegations .~ Map.fromList [(hashKey $ vKey aliceStake, poolhk)]
+           & dstate . delegations .~
+                Map.fromList [(KeyHashStake $ hashKey $ vKey aliceStake, poolhk)]
            & pstate . stPools .~ (StakePools $ Map.fromList [(poolhk, Slot 0)])
            & pstate . pParams .~ Map.fromList [(poolhk, pool)])
           (fromIntegral $ length txs))
@@ -132,7 +133,8 @@ testValidRetirement txs utxoState' stakeKeyRegistration e pool =
          (LedgerState
           utxoState'
           (stakeKeyRegistration
-           & dstate . delegations .~ Map.fromList [(hashKey $ vKey aliceStake, poolhk)]
+           & dstate . delegations .~
+                Map.fromList [(KeyHashStake $ hashKey $ vKey aliceStake, poolhk)]
            & pstate . stPools .~  (StakePools $ Map.fromList [(poolhk, Slot 0)])
            & pstate . pParams .~ Map.fromList [(poolhk, pool)]
            & pstate . retiring .~ Map.fromList [(poolhk, e)])
@@ -281,7 +283,9 @@ tx3Body = TxBody
           (Set.fromList [TxIn (txid $ tx2 ^. body) 0])
           [ TxOut aliceAddr (Coin 3950) ]
           [ RegPool stakePool
-          , Delegate (Delegation (vKey aliceStake) (vKey stakePoolKey1))]
+          , Delegate (Delegation
+                       (KeyHashStake $ hashKey $ vKey aliceStake)
+                       (hashKey $ vKey stakePoolKey1))]
           Map.empty
           (Coin 1200)
           (Slot 100)
@@ -308,13 +312,13 @@ stakeKeyRegistration1 = LedgerState.emptyDelegation
                    , (mkRwdAcnt bobStake, Coin 0)
                    , (mkRwdAcnt stakePoolKey1, Coin 0)]
   & dstate . stKeys .~ (StakeKeys $
-      Map.fromList [ (hashKey $ vKey aliceStake, Slot 0)
-                   , (hashKey $ vKey bobStake, Slot 0)
-                   , (hashKey $ vKey stakePoolKey1, Slot 0)])
+      Map.fromList [ (KeyHashStake $ hashKey $ vKey aliceStake, Slot 0)
+                   , (KeyHashStake $ hashKey $ vKey bobStake, Slot 0)
+                   , (KeyHashStake $ hashKey $ vKey stakePoolKey1, Slot 0)])
   & dstate . ptrs .~
-      Map.fromList [ (Ptr (Slot 0) 0 0, hashKey $ vKey aliceStake)
-                   , (Ptr (Slot 0) 0 1, hashKey $ vKey bobStake)
-                   , (Ptr (Slot 0) 0 2, hashKey $ vKey stakePoolKey1)
+      Map.fromList [ (Ptr (Slot 0) 0 0, KeyHashStake $ hashKey $ vKey aliceStake)
+                   , (Ptr (Slot 0) 0 1, KeyHashStake $ hashKey $ vKey bobStake)
+                   , (Ptr (Slot 0) 0 2, KeyHashStake $ hashKey $ vKey stakePoolKey1)
                    ]
 
 stakePool :: PoolParams
@@ -326,7 +330,7 @@ stakePool = PoolParams
             , _poolCost = Coin 0      -- TODO: what is a sensible value?
             , _poolMargin = interval0     --          or here?
             , _poolAltAcnt = Nothing  --          or here?
-            , _poolRAcnt   = RewardAcnt (hashKey . vKey $ stakePoolKey1)
+            , _poolRAcnt   = RewardAcnt (KeyHashStake . hashKey . vKey $ stakePoolKey1)
             , _poolOwners  = Set.empty
             }
 
@@ -343,7 +347,7 @@ stakePoolUpdate = PoolParams
                    , _poolCost = Coin 100      -- TODO: what is a sensible value?
                    , _poolMargin = halfInterval     --          or here?
                    , _poolAltAcnt = Nothing  --          or here?
-                   , _poolRAcnt   = RewardAcnt (hashKey . vKey $ stakePoolKey1)
+                   , _poolRAcnt   = RewardAcnt (KeyHashStake . hashKey . vKey $ stakePoolKey1)
                    , _poolOwners  = Set.empty
                    }