Merge pull request #53 from PrivateStorageio/51.counter-in-redemption

Accept a counter value in redemption request

This is a step towards being able to scale up the number of tokens issued.

src/PaymentServer/Redemption.hs

@@ -29,6 +29,8 @@ import Data.Aeson
   , FromJSON(parseJSON)
   , withObject
   , (.:)
+  , (.:?)
+  , (.!=)
   , genericToEncoding
   , defaultOptions
   , encode
@@ -71,6 +73,8 @@ data Result
   = Unpaid -- ^ A voucher has not been paid for.
   | DoubleSpend -- ^ A voucher has already been redeemed.
   | OtherFailure Text -- ^ Some other unrecognized failure mode.
+  -- | Given counter was not in the expected range
+  | CounterOutOfBounds Integer Integer Integer
   | Succeeded PublicKey [Signature] Proof
   deriving (Show, Eq)
 
@@ -80,9 +84,15 @@ data Redeem
   = Redeem
   { redeemVoucher :: Voucher        -- ^ The voucher being redeemed.
   , redeemTokens :: [BlindedToken]  -- ^ Tokens to be signed as part of this redemption.
+  , redeemCounter :: Integer        -- ^ Counter tag on this redemption.
   } deriving (Show, Eq, Generic)
 
-instance FromJSON Redeem
+instance FromJSON Redeem where
+  parseJSON = withObject "redeem" $ \o -> do
+    voucher <- o .: "redeemVoucher"
+    tokens <- o .: "redeemTokens"
+    counter <- o .:? "redeemCounter" .!= 0
+    return $ Redeem voucher tokens counter
 
 instance ToJSON Redeem where
   toEncoding = genericToEncoding defaultOptions
@@ -96,6 +106,13 @@ instance ToJSON Result where
     [ "success" .= False
     , "reason" .= ("double-spend" :: Text)
     ]
+  toJSON (CounterOutOfBounds min max received) = object
+    [ "success" .= False
+    , "reason" .= ("counter-out-of-bounds" :: Text)
+    , "min" .= min
+    , "max" .= max
+    , "received" .= received
+    ]
   toJSON (OtherFailure description) = object
     [ "success" .= False
     , "reason" .= description
@@ -123,6 +140,11 @@ instance FromJSON Result where
         then return DoubleSpend
         else return $ OtherFailure reason
 
+-- | Limit the value for the counter value supplied during a voucher
+-- redemption attempt.  A counter in the range [0..maxCounter) is allowed.
+maxCounter :: Integer
+maxCounter = 16
+
 type RedemptionAPI = ReqBody '[JSON] Redeem :> Post '[JSON] Result
 
 jsonErr400 reason = err400
@@ -137,7 +159,10 @@ redemptionServer = redeem
 -- voucher and return signatures.  Return a failure if this is not possible
 -- (eg because the voucher was already redeemed).
 redeem :: VoucherDatabase d => Issuer -> d -> Redeem -> Handler Result
-redeem issue database (Redeem voucher tokens) = do
+redeem issue database (Redeem voucher tokens counter) =
+  if counter < 0 || counter >= maxCounter then
+    throwError $ jsonErr400 (CounterOutOfBounds 0 maxCounter counter)
+  else do
     let fingerprint = fingerprintFromTokens tokens
     result <- liftIO $ PaymentServer.Persistence.redeemVoucher database voucher fingerprint
     case result of