Merge pull request #3 from kadena-community/colin/fix-decimal-issue

Enforce proper rounding

ChangeLog.md

@@ -1,5 +1,9 @@
 # Changelog for bag-of-holding
 
+## 1.1.1 (2019-12-10)
+
+Fixed a bug involving decimal places entered into the Transfer Wizard.
+
 ## 1.1.0 (2019-12-03)
 
 The former `t` command for writing Pact Transactions has been moved to `p`. In

bag-of-holding.cabal

@@ -1,6 +1,6 @@
 cabal-version:      2.2
 name:               bag-of-holding
-version:            1.1.0
+version:            1.1.1
 synopsis:           A terminal-based wallet for Chainweb.
 description:        A terminal-based wallet for Chainweb.
 homepage:           https://github.com/kadena-community/bag-of-holding
@@ -43,6 +43,7 @@ library
     Holding.Chainweb
 
   build-depends:
+    , Decimal        ^>=0.5
     , prettyprinter  ^>=1.2
     , servant        ^>=0.16
     , time           ^>=1.8

exec/BOH/UI.hs

@@ -69,7 +69,7 @@ data Wallet = Wallet
   , focOf   :: !(FocusRing Name)
   , replOf  :: !(Form REPL SignReq Name)
   , transOf :: !(Form Trans SignReq Name)
-  , balsOf  :: [(ChainId, Maybe Double)]
+  , balsOf  :: [(ChainId, Maybe KDA)]
   , reqOf   :: Maybe SignReq }
   deriving stock (Generic)
 
@@ -83,7 +83,7 @@ data REPL = REPL { rcid :: !ChainId, re :: !Endpoint, dat :: !TxData, rpc :: !Pa
 data Trans = Trans
   { tcid     :: !ChainId
   , receiver :: !Receiver
-  , amount   :: !Double
+  , amount   :: !KDA
   , confirm  :: Bool }
   deriving stock (Generic)
 
@@ -160,7 +160,7 @@ draw e w = dispatch <> [ui]
         total :: Widget w
         total = txt "Total   => " <+> str (show . sum . mapMaybe snd $ balsOf w)
 
-        f :: (ChainId, Maybe Double) -> Widget Name
+        f :: (ChainId, Maybe KDA) -> Widget Name
         f (cid, md) = hBox
           [ txt "Chain ", txt (chainIdToText cid), txt " => "
           , str $ maybe "Balance check failed." show md ]
@@ -272,11 +272,9 @@ goodAccount (a:_)
   where
     len = T.length a
 
-goodAmount :: [Text] -> Maybe Double
+goodAmount :: [Text] -> Maybe KDA
 goodAmount []     = Nothing
-goodAmount (dt:_) = do
-  d <- readMaybe $ T.unpack dt
-  bool Nothing (Just d) $ d >= 0.000_000_000_001
+goodAmount (dt:_) = readMaybe (T.unpack dt) >>= kda
 
 --------------------------------------------------------------------------------
 -- Event Handling
@@ -395,7 +393,7 @@ mainEvent e w (VtyEvent ve) = case ve of
       cs = L.sort . toList . chainIds $ verOf e
       cd = balance $ accOf e
       rs = map (\cid -> (cid, REPL cid Local (TxData Null) <$> cd)) cs
-      ds = preview (_Just . position @2 . _Right . _Ctor @"T" . pactDouble)
+      ds = preview (_Just . position @2 . _Right . _Ctor @"T" . pactDouble . to kda . _Just)
 
   -- Help Window --
   V.EvKey (V.KChar 'h') [] -> continue (w & field @"focOf" %~ focusSetCurrent Help)

lib/Holding.hs

@@ -20,6 +20,8 @@ module Holding
   , command
   , TxData(..)
   , gasCap, transferCap
+  , KDA
+  , kda
     -- ** Pact Communication
   , Account(..)
   , meta
@@ -53,6 +55,7 @@ module Holding
 import           Control.Error.Util (hush)
 import           Data.Aeson
 import           Data.Aeson.Types (prependFailure, typeMismatch)
+import           Data.Decimal (Decimal, decimalPlaces)
 import           Data.Generics.Sum.Constructors (_Ctor)
 import           Data.Generics.Wrapped (_Unwrapped)
 import           Data.Text.Prettyprint.Doc (defaultLayoutOptions, layoutPretty)
@@ -194,13 +197,20 @@ newtype TxData = TxData Value deriving newtype (ToJSON, FromJSON)
 gasCap :: P.SigCapability
 gasCap = P.SigCapability (P.QualifiedName "coin" "GAS" (P.mkInfo "coin.GAS")) []
 
--- TODO Newtype the decimal value.
-transferCap :: Sender -> Receiver -> Double -> P.SigCapability
-transferCap (Sender (Account s)) (Receiver (Account r)) m =
+transferCap :: Sender -> Receiver -> KDA -> P.SigCapability
+transferCap (Sender (Account s)) (Receiver (Account r)) (KDA m) =
   P.SigCapability (P.QualifiedName "coin" "TRANSFER" (P.mkInfo "coin.TRANSFER"))
   [ P.PLiteral $ P.LString s
   , P.PLiteral $ P.LString r
-  , P.PLiteral $ P.LDecimal $ realToFrac m ]
+  , P.PLiteral $ P.LDecimal m ]
+
+-- | Enforces Pact's rounding and truncation rules.
+newtype KDA = KDA Decimal deriving newtype (Show, Read, Num)
+
+-- | Smart constructor for the `KDA` type. This requires there to be no more
+-- than 12 digits after the decimal point.
+kda :: Decimal -> Maybe KDA
+kda d = bool Nothing (Just $ KDA d) $ decimalPlaces d <= 12
 
 --------------------------------------------------------------------------------
 -- Pact Communication
@@ -209,7 +219,6 @@ transferCap (Sender (Account s)) (Receiver (Account r)) m =
 newtype Account = Account Text deriving (Generic)
 
 -- TODO Make the `GasLimit` an argument for the signing API.
--- TODO Come up with a sane default `GasPrice`.
 -- | To feed to the `transaction` function.
 meta :: Account -> ChainId -> IO P.PublicMeta
 meta (Account t) c = P.PublicMeta c' t gl gp (P.TTLSeconds 3600) <$> txTime
@@ -239,8 +248,8 @@ newtype TXResult = TXResult { txr :: P.CommandResult P.Hash }
 pactValue :: Traversal' TXResult P.PactValue
 pactValue = _Unwrapped . P.crResult . _Unwrapped . _Right
 
-pactDouble :: SimpleFold TXResult Double
-pactDouble = pactValue . _Ctor @"PLiteral" . _Ctor @"LDecimal" . to realToFrac
+pactDouble :: SimpleFold TXResult Decimal
+pactDouble = pactValue . _Ctor @"PLiteral" . _Ctor @"LDecimal"
 
 --------------------------------------------------------------------------------
 -- Endpoint Calls
@@ -348,9 +357,9 @@ balance :: Account -> Maybe PactCode
 balance (Account a) = code . T.pack $ printf "(coin.get-balance \"%s\")" a
 
 -- | The @coin.transfer@ function.
-transfer :: Sender -> Receiver -> Double -> Maybe PactCode
-transfer (Sender (Account s)) (Receiver (Account r)) d =
-  code . T.pack $ printf "(coin.transfer \"%s\" \"%s\" %f)" s r d
+transfer :: Sender -> Receiver -> KDA -> Maybe PactCode
+transfer (Sender (Account s)) (Receiver (Account r)) (KDA d) =
+  code . T.pack $ printf "(coin.transfer \"%s\" \"%s\" %s)" s r (show d)
 
 --------------------------------------------------------------------------------
 -- Misc.