Storage lists (#222)

* added basic list functionality

* added list to package yaml

* change delete

* fix iavl spec

* added foldl

* wip

* remove inj restriction, update tests

* sdk tests compile

* rename StoreKeyRoot

* name shuffle

* sdk and tests compile

* update nameservice

* fix tutorial

* updated test

* stylish

* added list spec boilerplate

* start with latest

* weeder

* foldl

* length

* added elemIndex

* rename files

* update tests

* lists seem to work

* fix deleteWHen

* test get at index

* MapSpec boilerplate

* map spec

* more lenient test

* weeder

* Fix query server (#223)

* put in var module

* added var testsw

* StoreQueryHandler for all storage types

* query modules compile

* bank module compiles

* sdk tests compile

* simple storage tests compile

* nameservice e2e compiles

* tutorial compiles but leaves a lot to be desired

* added Storage section to tutorial (#224)

hs-abci-docs/doc/0340-Storage.md

@@ -0,0 +1 @@
+../nameservice/tutorial/Foundations/04-Storage.md

hs-abci-docs/nameservice/interact/Interact.hs

@@ -46,22 +46,22 @@ import           Test.RandomStrings                (onlyWith, randomASCII,
 
 faucetAccount :: Signer -> Auth.Amount -> IO ()
 faucetAccount s@(Signer addr _) amount =
-  runAction_ s faucet $ N.FaucetAccount addr N.nameserviceCoinId amount
+  runAction_ s faucet $ N.FaucetAccountMsg addr N.nameserviceCoinId amount
 
-createName :: Signer -> N.Name -> Text -> IO ()
+createName :: Signer -> Text -> Text -> IO ()
 createName s name val = buyName s name val 0
 
-buyName :: Signer -> N.Name -> Text -> Auth.Amount -> IO ()
+buyName :: Signer -> Text -> Text -> Auth.Amount -> IO ()
 buyName s@(Signer addr _) name newVal amount =
-  runAction_ s buy $ N.BuyName amount name newVal addr
+  runAction_ s buy $ N.BuyNameMsg amount name newVal addr
 
-deleteName :: Signer -> N.Name -> IO ()
+deleteName :: Signer -> Text -> IO ()
 deleteName s@(Signer addr _) name =
-  runAction_ s delete $ N.DeleteName addr name
+  runAction_ s delete $ N.DeleteNameMsg addr name
 
-setName :: Signer -> N.Name -> Text -> IO ()
+setName :: Signer -> Text -> Text -> IO ()
 setName s@(Signer addr _) name val =
-  runAction_ s set $ N.SetName name addr val
+  runAction_ s set $ N.SetNameMsg name addr val
 
 runAction_
   :: Signer
@@ -144,22 +144,22 @@ runTxClientM m = runReaderT m txClientConfig
 -- Nameservice Client
 buy
   :: TxOpts
-  -> N.BuyName
+  -> N.BuyNameMsg
   -> TxClientM (TxClientResponse () ())
 
 set
   :: TxOpts
-  -> N.SetName
+  -> N.SetNameMsg
   -> TxClientM (TxClientResponse () ())
 
 delete
   :: TxOpts
-  -> N.DeleteName
+  -> N.DeleteNameMsg
   -> TxClientM (TxClientResponse () ())
 
 faucet
   :: TxOpts
-  -> N.FaucetAccount
+  -> N.FaucetAccountMsg
   -> TxClientM (TxClientResponse () ())
 
 (buy :<|> set :<|> delete :<|> faucet) :<|>
@@ -183,10 +183,8 @@ genWords = do
   ws <- replicateM numWords Lorem.word
   return . cs . unwords $ ws
 
-genName :: IO N.Name
-genName = do
-  name <- Name.name
-  return . fromString $ name
+genName :: IO Text
+genName = fromString <$> Name.name
 
 genAmount :: IO Auth.Amount
 genAmount = do

hs-abci-docs/nameservice/package.yaml

@@ -56,7 +56,6 @@ library:
     - polysemy
     - polysemy-plugin
     - proto3-suite
-    - proto3-wire
     - servant
     - string-conversions
     - text
@@ -78,6 +77,7 @@ library:
   - Nameservice.Modules.Nameservice
   - Nameservice.Modules.Nameservice.Messages
   - Nameservice.Modules.Nameservice.Types
+  - Nameservice.Modules.Nameservice.Store
   - Nameservice.Modules.Nameservice.Keeper
   - Nameservice.Modules.Nameservice.Query
   - Nameservice.Modules.Nameservice.Router

hs-abci-docs/nameservice/protogen/Protogen.hs

@@ -9,10 +9,9 @@ import           Data.Aeson.Casing                        (snakeCase)
 import qualified Data.ByteString.Lazy                     as BL
 import           GHC.Exts                                 (Proxy#, proxy#)
 import           Nameservice.Modules.Nameservice.Messages (BuyNameMessage (..),
-                                                           DeleteName (..),
-                                                           SetName (..))
-import           Nameservice.Modules.Nameservice.Types    (Name (..),
-                                                           WhoisMessage (..))
+                                                           DeleteNameMsg (..),
+                                                           SetNameMsg (..))
+import           Nameservice.Modules.Nameservice.Types    (WhoisMessage (..))
 import           Proto3.Suite                             (DotProtoDefinition,
                                                            Message,
                                                            fromByteString,
@@ -44,9 +43,9 @@ msgStripPrefixOptions = defRenderingOptions { roSelectorName = stripPrefixName }
 
 messagesProtoFile :: String
 messagesProtoFile = toProtoFile msgStripPrefixOptions $ packageFromDefs "nameservice"
-  ([ message (proxy# :: Proxy# SetName)
+  ([ message (proxy# :: Proxy# SetNameMsg)
    , message (proxy# :: Proxy# BuyNameMessage)
-   , message (proxy# :: Proxy# DeleteName)
+   , message (proxy# :: Proxy# DeleteNameMsg)
    ] :: [DotProtoDefinition])
 
 whoisProtoFile :: String

hs-abci-docs/nameservice/src/Nameservice/Modules/Nameservice.hs

@@ -6,6 +6,7 @@ module Nameservice.Modules.Nameservice
   , nameserviceModule
   , module           Nameservice.Modules.Nameservice.Keeper
   , module           Nameservice.Modules.Nameservice.Messages
+  , module           Nameservice.Modules.Nameservice.Store
   , module           Nameservice.Modules.Nameservice.Query
   , module           Nameservice.Modules.Nameservice.Router
   , module           Nameservice.Modules.Nameservice.Types
@@ -14,10 +15,11 @@ module Nameservice.Modules.Nameservice
   ) where
 
 import           Data.Proxy
-import           Nameservice.Modules.Nameservice.Keeper   hiding (storeKey)
+import           Nameservice.Modules.Nameservice.Keeper
 import           Nameservice.Modules.Nameservice.Messages
 import           Nameservice.Modules.Nameservice.Query
 import           Nameservice.Modules.Nameservice.Router
+import           Nameservice.Modules.Nameservice.Store    (Name (..))
 import           Nameservice.Modules.Nameservice.Types
 import           Polysemy                                 (Members)
 import           Tendermint.SDK.Application               (Module (..),

hs-abci-docs/nameservice/src/Nameservice/Modules/Nameservice/Keeper.hs

@@ -1,74 +1,78 @@
 {-# LANGUAGE TemplateHaskell #-}
 
 module Nameservice.Modules.Nameservice.Keeper
-  ( NameserviceKeeper
-  , NameserviceEffs
+  ( NameserviceEffs
+  , NameserviceKeeper(..)
   , nameserviceCoinId
   , setName
   , deleteName
   , buyName
-  , storeKey
   , faucetAccount
+  , getWhois
   , eval
   ) where
 
-import           Data.Proxy
-import           Data.String.Conversions                  (cs)
-import           GHC.TypeLits                             (symbolVal)
 import           Nameservice.Modules.Nameservice.Messages
+import           Nameservice.Modules.Nameservice.Store
 import           Nameservice.Modules.Nameservice.Types
-import           Polysemy                                 (Members, Sem,
+import           Polysemy                                 (Member, Members, Sem,
                                                            interpret, makeSem)
 import           Polysemy.Error                           (Error, mapError,
                                                            throw)
 import           Polysemy.Output                          (Output)
 import qualified Tendermint.SDK.BaseApp                   as BaseApp
+import qualified Tendermint.SDK.BaseApp.Store.Map         as M
 import           Tendermint.SDK.Modules.Auth              (Coin (..), CoinId)
 import           Tendermint.SDK.Modules.Bank              (BankEffs, burn, mint,
                                                            transfer)
 
 data NameserviceKeeper m a where
-  PutWhois :: Name -> Whois -> NameserviceKeeper m ()
+  FaucetAccount :: FaucetAccountMsg -> NameserviceKeeper m ()
+  BuyName :: BuyNameMsg -> NameserviceKeeper m ()
+  DeleteName :: DeleteNameMsg -> NameserviceKeeper m ()
+  SetName :: SetNameMsg -> NameserviceKeeper m ()
   GetWhois :: Name -> NameserviceKeeper m (Maybe Whois)
-  DeleteWhois :: Name -> NameserviceKeeper m ()
 
 makeSem ''NameserviceKeeper
 
 type NameserviceEffs = '[NameserviceKeeper, Error NameserviceError]
 
-storeKey :: BaseApp.StoreKey NameserviceNamespace
-storeKey = BaseApp.StoreKey . cs . symbolVal $ Proxy @NameserviceName
-
 nameserviceCoinId :: CoinId
 nameserviceCoinId = "nameservice"
 
 eval
   :: Members BaseApp.TxEffs r
+  => Members BankEffs r
+  => Members BaseApp.BaseEffs r
   => forall a. Sem (NameserviceKeeper ': Error NameserviceError ': r) a
   -> Sem r a
 eval = mapError BaseApp.makeAppError . evalNameservice
   where
     evalNameservice
       :: Members BaseApp.TxEffs r
+      => Members BaseApp.BaseEffs r
+      => Members BankEffs r
+      => Member (Error NameserviceError) r
       => Sem (NameserviceKeeper ': r) a -> Sem r a
     evalNameservice =
       interpret (\case
-          GetWhois name ->
-            BaseApp.get storeKey name
-          PutWhois name whois ->
-            BaseApp.put storeKey name whois
-          DeleteWhois name ->
-            BaseApp.delete storeKey name
+          FaucetAccount msg -> faucetAccountF msg
+          BuyName msg -> buyNameF msg
+          DeleteName msg -> deleteNameF msg
+          SetName msg -> setNameF msg
+          GetWhois name -> M.lookup name whoisMap
         )
 
 --------------------------------------------------------------------------------
 
-faucetAccount
+--------------------------------------------------------------------------------
+
+faucetAccountF
   :: Members [BaseApp.Logger, Output BaseApp.Event] r
   => Members BankEffs r
-  => FaucetAccount
+  => FaucetAccountMsg
   -> Sem r ()
-faucetAccount FaucetAccount{..} = do
+faucetAccountF FaucetAccountMsg{..} = do
   let coin = Coin faucetAccountCoinId faucetAccountAmount
   mint faucetAccountTo coin
   let event = Faucetted
@@ -79,20 +83,21 @@ faucetAccount FaucetAccount{..} = do
   BaseApp.emit event
   BaseApp.logEvent event
 
-setName
-  :: Members [BaseApp.Logger, Output BaseApp.Event] r
-  => Members NameserviceEffs r
-  => SetName
+setNameF
+  :: Members BaseApp.TxEffs r
+  => Members BaseApp.BaseEffs r
+  => Member (Error NameserviceError) r
+  => SetNameMsg
   -> Sem r ()
-setName SetName{..} = do
-  mwhois <- getWhois setNameName
+setNameF SetNameMsg{..} = do
+  mwhois <- M.lookup (Name setNameName) whoisMap
   case mwhois of
     Nothing -> throw $ UnauthorizedSet "Cannot claim name with SetMessage tx."
     Just currentWhois@Whois{..} ->
       if whoisOwner /= setNameOwner
         then throw $ UnauthorizedSet "Setter must be the owner of the Name."
         else do
-          putWhois setNameName currentWhois {whoisValue = setNameValue}
+          M.insert (Name setNameName) (currentWhois {whoisValue = setNameValue}) whoisMap
           let event = NameRemapped
                 { nameRemappedName = setNameName
                 , nameRemappedNewValue = setNameValue
@@ -101,38 +106,40 @@ setName SetName{..} = do
           BaseApp.emit event
           BaseApp.logEvent event
 
-deleteName
-  :: Members [BaseApp.Logger, Output BaseApp.Event] r
+deleteNameF
+  :: Members BaseApp.TxEffs r
+  => Members BaseApp.BaseEffs r
   => Members BankEffs r
-  => Members NameserviceEffs r
-  => DeleteName
+  => Member (Error NameserviceError) r
+  => DeleteNameMsg
   -> Sem r ()
-deleteName DeleteName{..} = do
-  mWhois <- getWhois deleteNameName
+deleteNameF DeleteNameMsg{..} = do
+  mWhois <- M.lookup (Name deleteNameName) whoisMap
   case mWhois of
     Nothing -> throw $ InvalidDelete "Can't remove unassigned name."
     Just Whois{..} ->
       if whoisOwner /= deleteNameOwner
         then throw $ InvalidDelete "Deleter must be the owner."
         else do
           mint deleteNameOwner (Coin nameserviceCoinId whoisPrice)
-          deleteWhois deleteNameName
+          M.delete (Name deleteNameName) whoisMap
           let event = NameDeleted
                 { nameDeletedName = deleteNameName
                 }
           BaseApp.emit event
           BaseApp.logEvent event
 
-buyName
-  :: Members [BaseApp.Logger, Output BaseApp.Event] r
+buyNameF
+  :: Members BaseApp.TxEffs r
   => Members BankEffs r
-  => Members NameserviceEffs r
-  => BuyName
+  => Members BaseApp.BaseEffs r
+  => Member (Error NameserviceError) r
+  => BuyNameMsg
   -> Sem r ()
 -- ^ did it succeed
-buyName msg = do
+buyNameF msg = do
   let name = buyNameName msg
-  mWhois <- getWhois name
+  mWhois <- M.lookup (Name name) whoisMap
   case mWhois of
     -- The name is unclaimed, go ahead and debit the account
     -- and create it.
@@ -142,19 +149,19 @@ buyName msg = do
     Just whois -> buyClaimedName msg whois
     where
       buyUnclaimedName
-        :: Members [BaseApp.Logger, Output BaseApp.Event] r
+        :: Members BaseApp.TxEffs r
+        => Members BaseApp.BaseEffs r
         => Members BankEffs r
-        => Members NameserviceEffs r
-        => BuyName
+        => BuyNameMsg
         -> Sem r ()
-      buyUnclaimedName BuyName{..} = do
+      buyUnclaimedName BuyNameMsg{..} = do
         burn buyNameBuyer (Coin nameserviceCoinId buyNameBid)
         let whois = Whois
               { whoisOwner = buyNameBuyer
               , whoisValue = buyNameValue
               , whoisPrice = buyNameBid
               }
-        putWhois buyNameName whois
+        M.insert (Name buyNameName) whois whoisMap
         let event = NameClaimed
               { nameClaimedOwner = buyNameBuyer
               , nameClaimedName = buyNameName
@@ -165,22 +172,25 @@ buyName msg = do
         BaseApp.logEvent event
 
       buyClaimedName
-        :: Members NameserviceEffs r
+        :: Members BaseApp.TxEffs r
+        => Member (Error NameserviceError) r
+        => Members BaseApp.BaseEffs r
         => Members BankEffs r
-        => Members [BaseApp.Logger, Output BaseApp.Event] r
-        => BuyName
+        => BuyNameMsg
         -> Whois
         -> Sem r ()
-      buyClaimedName BuyName{..} currentWhois =
+      buyClaimedName BuyNameMsg{..} currentWhois =
         let Whois{ whoisPrice = forsalePrice, whoisOwner = previousOwner } = currentWhois
         in if buyNameBid > forsalePrice
              then do
                transfer buyNameBuyer (Coin nameserviceCoinId buyNameBid) previousOwner
                -- update new owner, price and value based on BuyName
-               putWhois buyNameName currentWhois { whoisOwner = buyNameBuyer
-                                                 , whoisPrice = buyNameBid
-                                                 , whoisValue = buyNameValue
-                                                 }
+               let whois' = currentWhois
+                     { whoisOwner = buyNameBuyer
+                     , whoisPrice = buyNameBid
+                     , whoisValue = buyNameValue
+                     }
+               M.insert (Name buyNameName) whois' whoisMap
                let event = NameClaimed
                      { nameClaimedOwner = buyNameBuyer
                      , nameClaimedName = buyNameName