Skip to content

Commit

Permalink
remove MWid wrapper?
Browse files Browse the repository at this point in the history
  • Loading branch information
@KtorZ
KtorZ committed May 15, 2019
1 parent 642dc4b commit 492dd74
Showing 1 changed file with 41 additions and 45 deletions.
86 changes: 41 additions & 45 deletions lib/core/test/unit/Cardano/Wallet/DBSpec2.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -98,11 +98,11 @@ import qualified Test.StateMachine.Types.Rank2 as Rank2
-------------------------------------------------------------------------------}

data Expr fp =
Val MWid
Val WalletId
| Var fp
deriving (Show, Functor, Foldable, Traversable)

eval :: Expr MWid -> MWid
eval :: Expr WalletId -> WalletId
eval (Val f) = f
eval (Var f) = f

Expand All @@ -111,41 +111,37 @@ eval (Var f) = f
-------------------------------------------------------------------------------}

data Err
= NoSuchWallet MWid
| WalletAlreadyExists MWid
= NoSuchWallet WalletId
| WalletAlreadyExists WalletId
deriving (Show, Eq)

errNoSuchWallet :: ErrNoSuchWallet -> Err
errNoSuchWallet (ErrNoSuchWallet wid) = NoSuchWallet (MWid wid)
errNoSuchWallet (ErrNoSuchWallet wid) = NoSuchWallet wid

errWalletAlreadyExists :: ErrWalletAlreadyExists -> Err
errWalletAlreadyExists (ErrWalletAlreadyExists wid) = WalletAlreadyExists (MWid wid)
errWalletAlreadyExists (ErrWalletAlreadyExists wid) = WalletAlreadyExists wid

{-------------------------------------------------------------------------------
Mock implementation
-------------------------------------------------------------------------------}

-- fixme: remove MWid silliness
newtype MWid = MWid WalletId
deriving (Show, Eq, Ord, Generic)

type MWallet = Wallet DummyState DummyTarget
type MPrivKey = (String, String)

widPK :: MWid -> PrimaryKey WalletId
widPK (MWid wid) = PrimaryKey wid
widPK :: WalletId -> PrimaryKey WalletId
widPK = PrimaryKey

widPK' :: Expr MWid -> PrimaryKey WalletId
widPK' :: Expr WalletId -> PrimaryKey WalletId
widPK' expr = widPK (eval expr)

pkWid :: PrimaryKey WalletId -> MWid
pkWid (PrimaryKey wid) = MWid wid
pkWid :: PrimaryKey WalletId -> WalletId
pkWid (PrimaryKey wid) = wid

data Mock = M
{ checkpoints :: Map MWid MWallet
, metas :: Map MWid WalletMetadata
, txs :: Map MWid TxHistory
, privateKey :: Map MWid MPrivKey
{ checkpoints :: Map WalletId MWallet
, metas :: Map WalletId WalletMetadata
, txs :: Map WalletId TxHistory
, privateKey :: Map WalletId MPrivKey
}
deriving (Show, Generic)

Expand All @@ -154,54 +150,54 @@ emptyMock = M Map.empty Map.empty Map.empty Map.empty

type MockOp a = Mock -> (Either Err a, Mock)

mCreateWallet :: MWid -> MWallet -> WalletMetadata -> MockOp ()
mCreateWallet :: WalletId -> MWallet -> WalletMetadata -> MockOp ()
mCreateWallet wid wal meta m@(M cp metas txs pk)
| wid `Map.member` cp = (Left (WalletAlreadyExists wid), m)
| otherwise = (Right (), M (Map.insert wid wal cp) (Map.insert wid meta metas) txs pk)

mRemoveWallet :: MWid -> MockOp ()
mRemoveWallet :: WalletId -> MockOp ()
mRemoveWallet wid m@(M cp metas txs pk)
| wid `Map.member` cp = (Right (), M (Map.delete wid cp) (Map.delete wid metas) txs pk)
| otherwise = (Left (NoSuchWallet wid), m)

mListWallets :: MockOp [MWid]
mListWallets :: MockOp [WalletId]
mListWallets m@(M cp _ _ _) = (Right (Map.keys cp), m)

mPutCheckpoint :: MWid -> MWallet -> MockOp ()
mPutCheckpoint :: WalletId -> MWallet -> MockOp ()
mPutCheckpoint wid wal m@(M cp metas txs pk)
| wid `Map.member` cp = (Right (), M (Map.insert wid wal cp) metas txs pk)
| otherwise = (Left (NoSuchWallet wid), m)

mReadCheckpoint :: MWid -> MockOp (Maybe MWallet)
mReadCheckpoint :: WalletId -> MockOp (Maybe MWallet)
mReadCheckpoint wid m@(M cp _ _ _)
= (Right (Map.lookup wid cp), m)

mPutWalletMeta :: MWid -> WalletMetadata -> MockOp ()
mPutWalletMeta :: WalletId -> WalletMetadata -> MockOp ()
mPutWalletMeta wid meta m@(M cp metas txs pk)
| wid `Map.member` cp = (Right (), M cp (Map.insert wid meta metas) txs pk)
| otherwise = (Left (NoSuchWallet wid), m)

mReadWalletMeta :: MWid -> MockOp (Maybe WalletMetadata)
mReadWalletMeta :: WalletId -> MockOp (Maybe WalletMetadata)
mReadWalletMeta wid m@(M _ meta _ _)
= (Right (Map.lookup wid meta), m)

mPutTxHistory :: MWid -> TxHistory -> MockOp ()
mPutTxHistory :: WalletId -> TxHistory -> MockOp ()
mPutTxHistory wid txs' m@(M cp metas txs pk)
| wid `Map.member` cp = (Right (), M cp metas (Map.alter appendTxs wid txs) pk)
| otherwise = (Left (NoSuchWallet wid), m)
where appendTxs = Just . (<> txs') . fromMaybe mempty

mReadTxHistory :: MWid -> MockOp TxHistory
mReadTxHistory :: WalletId -> MockOp TxHistory
mReadTxHistory wid m@(M cp _ txs _)
| wid `Map.member` cp = (Right (fromMaybe mempty (Map.lookup wid txs)), m)
| otherwise = (Right mempty, m)

mPutPrivateKey :: MWid -> MPrivKey -> MockOp ()
mPutPrivateKey :: WalletId -> MPrivKey -> MockOp ()
mPutPrivateKey wid pk' m@(M cp metas txs pk)
| wid `Map.member` cp = (Right (), M cp metas txs (Map.insert wid pk' pk))
| otherwise = (Left (NoSuchWallet wid), m)

mReadPrivateKey :: MWid -> MockOp (Maybe MPrivKey)
mReadPrivateKey :: WalletId -> MockOp (Maybe MPrivKey)
mReadPrivateKey wid m@(M cp _ _ pk)
| wid `Map.member` cp = (Right (Map.lookup wid pk), m)
| otherwise = (Left (NoSuchWallet wid), m)
Expand All @@ -213,7 +209,7 @@ mReadPrivateKey wid m@(M cp _ _ pk)
type TxHistory = Map (Hash "Tx") (Tx, TxMeta)

data Cmd wid
= CreateWallet MWid MWallet WalletMetadata -- fixme: MWid -> wid
= CreateWallet WalletId MWallet WalletMetadata -- fixme: WalletId -> wid
| RemoveWallet (Expr wid)
| ListWallets
| PutCheckpoint (Expr wid) MWallet
Expand Down Expand Up @@ -243,7 +239,7 @@ newtype Resp wid = Resp (Either Err (Success wid))
Interpreter: mock implementation
-------------------------------------------------------------------------------}

runMock :: Cmd MWid -> Mock -> (Resp MWid, Mock)
runMock :: Cmd WalletId -> Mock -> (Resp WalletId, Mock)
runMock (CreateWallet wid wal meta) = first (Resp . fmap (const (NewWallet wid))) . mCreateWallet wid wal meta
runMock (RemoveWallet wid) = first (Resp . fmap Unit) . mRemoveWallet (eval wid)
runMock ListWallets = first (Resp . fmap WalletIds) . mListWallets
Expand Down Expand Up @@ -302,11 +298,11 @@ nextHandle conns = maximum (map dbLayerHandle conns) + 1

runIO
:: DBLayerTest
-> Cmd MWid
-> IO (Resp MWid)
-> Cmd WalletId
-> IO (Resp WalletId)
runIO db = fmap Resp . go
where
go :: Cmd MWid -> IO (Either Err (Success MWid))
go :: Cmd WalletId -> IO (Either Err (Success WalletId))
go (CreateWallet wid wal meta) =
catchWalletAlreadyExists (const (NewWallet wid)) $
createWallet (dbLayer db) (widPK wid) wal meta
Expand Down Expand Up @@ -346,9 +342,9 @@ runIO db = fmap Resp . go
Working with references
-------------------------------------------------------------------------------}

newtype At f r = At (f (Reference MWid r))
newtype At f r = At (f (Reference WalletId r))

deriving instance Show (f (Reference MWid r)) => Show (At f r)
deriving instance Show (f (Reference WalletId r)) => Show (At f r)

type f :@ r = At f r

Expand All @@ -361,7 +357,7 @@ env ! r = fromJust (lookup r env)
Relating the mock model to the real implementation
-------------------------------------------------------------------------------}

type WidRefs r = RefEnv MWid MWid r -- fixme: WalletId -> MWid
type WidRefs r = RefEnv WalletId WalletId r -- fixme: WalletId -> MWid

data Model r = Model Mock (WidRefs r)
deriving (Generic)
Expand All @@ -371,10 +367,10 @@ deriving instance Show1 r => Show (Model r)
initModel :: Model r
initModel = Model emptyMock []

toMock :: (Functor f, Eq1 r) => Model r -> f :@ r -> f MWid
toMock :: (Functor f, Eq1 r) => Model r -> f :@ r -> f WalletId
toMock (Model _ wids) (At fr) = fmap (wids !) fr

step :: Eq1 r => Model r -> Cmd :@ r -> (Resp MWid, Mock)
step :: Eq1 r => Model r -> Cmd :@ r -> (Resp WalletId, Mock)
step m@(Model mock _) c = runMock (toMock m c) mock

{-------------------------------------------------------------------------------
Expand All @@ -385,7 +381,7 @@ data Event r = Event {
before :: Model r
, cmd :: Cmd :@ r
, after :: Model r
, mockResp :: Resp MWid
, mockResp :: Resp WalletId
}

deriving instance Show1 r => Show (Event r)
Expand Down Expand Up @@ -441,8 +437,8 @@ generator (Model _ wids) = Just $ QC.oneof $ concat
-- , fmap At $ ReadPrivateKey <$> genId
]

genId :: Gen MWid
genId = MWid . WalletId . hash . B8.pack <$> QC.elements ["a", "b", "c"]
genId :: Gen WalletId
genId = WalletId . hash . B8.pack <$> QC.elements ["a", "b", "c"]

genId' = Val <$> genId

Expand All @@ -467,7 +463,7 @@ shrinker (Model _ wids) (At cmd) = case cmd of
_ -> []

where
matches :: MWid -> (r, MWid) -> Maybe r
matches :: WalletId -> (r, WalletId) -> Maybe r
matches w (r, w') | w == w' = Just r
| otherwise = Nothing

Expand Down Expand Up @@ -572,7 +568,7 @@ instance ToExpr Tx where
instance ToExpr TxMeta where
toExpr = defaultExprViaShow

instance ToExpr MWid where
instance ToExpr WalletId where
toExpr = defaultExprViaShow

{-------------------------------------------------------------------------------
Expand Down

0 comments on commit 492dd74

Please sign in to comment.