Add recover chain handle and connect it to the API

Signed-off-by: Sasha Bogicevic <[email protected]>

hydra-node/src/Hydra/API/HTTPServer.hs

@@ -15,7 +15,9 @@ import Hydra.API.ClientInput (ClientInput (..))
 import Hydra.API.ServerOutput (CommitInfo (..))
 import Hydra.Cardano.Api (
   LedgerEra,
+  SlotNo (..),
   Tx,
+  TxIn,
  )
 import Hydra.Chain (Chain (..), PostTxError (..), draftCommitTx)
 import Hydra.Chain.ChainState (
@@ -25,10 +27,12 @@ import Hydra.Chain.Direct.State ()
 import Hydra.Logging (Tracer, traceWith)
 import Hydra.Tx (
   CommitBlueprintTx (..),
+  HeadId,
   IsTx (..),
   UTxOType,
+  headIdToCurrencySymbol,
  )
-import Network.HTTP.Types (QueryItem, status200, status400, status404, status500)
+import Network.HTTP.Types (QueryItem, renderQuery, status200, status400, status404, status500)
 import Network.Wai (
   Application,
   Request (pathInfo, requestMethod),
@@ -38,6 +42,9 @@ import Network.Wai (
   rawPathInfo,
   responseLBS,
  )
+import Test.QuickCheck (oneof, suchThat)
+
+import PlutusLedgerApi.V2 (POSIXTime)
 
 newtype DraftCommitTxResponse tx = DraftCommitTxResponse
   { commitTx :: tx
@@ -71,8 +78,9 @@ data DraftCommitTxRequest tx
       , deadline :: UTCTime
       }
   | IncrementalCommitRecoverRequest
-      { utxo :: UTxOType tx
-      , deadline :: UTCTime
+      { recoverHeadId :: HeadId
+      , recoverUTxO :: UTxOType tx
+      , recoverDeadline :: POSIXTime
       , recoverStart :: Natural
       }
   deriving stock (Generic)
@@ -82,10 +90,11 @@ deriving stock instance (Show tx, Show (UTxOType tx)) => Show (DraftCommitTxRequ
 
 instance (ToJSON tx, ToJSON (UTxOType tx)) => ToJSON (DraftCommitTxRequest tx) where
   toJSON = \case
-    IncrementalCommitRecoverRequest{utxo, deadline, recoverStart} ->
+    IncrementalCommitRecoverRequest{recoverHeadId, recoverUTxO, recoverDeadline, recoverStart} ->
       object
-        [ "utxo" .= toJSON utxo
-        , "deadline" .= toJSON deadline
+        [ "recoverHeadId" .= toJSON recoverHeadId
+        , "recoverUTxO" .= toJSON recoverUTxO
+        , "recoverDeadline" .= toJSON recoverDeadline
         , "recoverStart" .= toJSON recoverStart
         ]
     IncrementalCommitDepositRequest{utxo, deadline} ->
@@ -102,7 +111,7 @@ instance (ToJSON tx, ToJSON (UTxOType tx)) => ToJSON (DraftCommitTxRequest tx) w
       toJSON utxoToCommit
 
 instance (FromJSON tx, FromJSON (UTxOType tx)) => FromJSON (DraftCommitTxRequest tx) where
-  parseJSON v = fullVariant v <|> simpleVariant v
+  parseJSON v = fullVariant v <|> simpleVariant v <|> depositVariant v <|> recoverVariant v
    where
     fullVariant = withObject "FullCommitRequest" $ \o -> do
       blueprintTx :: tx <- o .: "blueprintTx"
@@ -111,14 +120,34 @@ instance (FromJSON tx, FromJSON (UTxOType tx)) => FromJSON (DraftCommitTxRequest
 
     simpleVariant val = SimpleCommitRequest <$> parseJSON val
 
-instance (Arbitrary tx, Arbitrary (UTxOType tx)) => Arbitrary (DraftCommitTxRequest tx) where
-  arbitrary = genericArbitrary
+    depositVariant = withObject "IncrementalCommitDepositRequest" $ \o -> do
+      utxo <- o .: "utxo"
+      deadline <- o .: "deadline"
+      pure IncrementalCommitDepositRequest{utxo, deadline}
+
+    recoverVariant = withObject "IncrementalCommitRecoverRequest" $ \o -> do
+      recoverHeadId <- o .: "recoverHeadId"
+      recoverUTxO <- o .: "recoverUTxO"
+      recoverDeadline <- o .: "recoverDeadline"
+      recoverStart <- o .: "recoverStart"
+      pure IncrementalCommitRecoverRequest{recoverHeadId, recoverUTxO, recoverDeadline, recoverStart}
+
+instance (Arbitrary tx, Arbitrary (UTxOType tx), Eq (UTxOType tx), Monoid (UTxOType tx)) => Arbitrary (DraftCommitTxRequest tx) where
+  arbitrary =
+    oneof
+      [ FullCommitRequest <$> arbitrary <*> arbitrary
+      , SimpleCommitRequest <$> arbitrary
+      , do
+          utxo <- arbitrary `suchThat` (/= mempty)
+          IncrementalCommitDepositRequest utxo <$> arbitrary
+      , IncrementalCommitRecoverRequest <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
+      ]
 
   shrink = \case
     SimpleCommitRequest u -> SimpleCommitRequest <$> shrink u
     FullCommitRequest a b -> FullCommitRequest <$> shrink a <*> shrink b
     IncrementalCommitDepositRequest a b -> IncrementalCommitDepositRequest <$> shrink a <*> shrink b
-    IncrementalCommitRecoverRequest a b c -> IncrementalCommitRecoverRequest <$> shrink a <*> shrink b <*> shrink c
+    IncrementalCommitRecoverRequest a b c d -> IncrementalCommitRecoverRequest <$> shrink a <*> shrink b <*> shrink c <*> shrink d
 
 newtype SubmitTxRequest tx = SubmitTxRequest
   { txToSubmit :: tx
@@ -178,7 +207,7 @@ httpApp tracer directChain pparams getCommitInfo getConfirmedUTxO putClientInput
       consumeRequestBodyStrict request
         >>= handleDraftCommitUtxo directChain getCommitInfo putClientInput
         >>= respond
-    ("DELETE", ["commit"]) ->
+    ("DELETE", ["recover"]) ->
       consumeRequestBodyStrict request
         >>= handleRecoverCommitUtxo directChain getCommitInfo putClientInput (queryString request)
         >>= respond
@@ -229,8 +258,7 @@ handleDraftCommitUtxo directChain getCommitInfo putClientInput body = do
           putStrLn "Incremental commit"
           case someCommitRequest of
             IncrementalCommitDepositRequest{utxo, deadline} ->
-              getCurrentTime
-                >>= checkDeposit utxo deadline (deposit headId utxo deadline)
+              deposit headId utxo deadline
             _ -> pure $ responseLBS status400 [] (Aeson.encode $ Aeson.String "Invalid request: expected a IncrementalCommitDepositRequest")
         -- XXX: This is not really an internal server error
         -- FIXME: FailedToDraftTxNotInitializing is not a good name and it's not a PostTxError. Should create an error type somewhere in Hydra.API for this.
@@ -284,20 +312,25 @@ handleRecoverCommitUtxo directChain getCommitInfo putClientInput recoverQuery bo
       getCommitInfo >>= \case
         IncrementalCommit _ -> do
           case someCommitRequest of
-            IncrementalCommitRecoverRequest{utxo, deadline} -> do
-              recoverDeposit utxo deadline
+            IncrementalCommitRecoverRequest{recoverHeadId, recoverUTxO, recoverDeadline, recoverStart} -> do
+              checkRecover recoverQuery (recoverDeposit recoverHeadId recoverUTxO recoverDeadline recoverStart)
             _ -> pure $ responseLBS status400 [] (Aeson.encode $ Aeson.String "Invalid request: expected a IncrementalCommitRecoverRequest")
         -- TODO: Have a proper error type for this.
         -- XXX: This is not really an internal server error
         -- FIXME: FailedToDraftTxNotInitializing is not a good name and it's not a PostTxError. Should create an error type somewhere in Hydra.API for this.
         _ -> pure $ responseLBS status500 [] (Aeson.encode (FailedToDraftTxNotInitializing :: PostTxError tx))
  where
-  recoverDeposit utxo deadline = do
-    putClientInput Recover{utxo}
-    -- TODO: implement it!
-    error "Not done yet"
+  recoverDeposit recoverHeadId recoverUTxO recoverDeadline recoverStart txIn = do
+    draftRecoverTx (headIdToCurrencySymbol recoverHeadId) recoverUTxO recoverDeadline (SlotNo $ fromIntegral recoverStart) txIn <&> \case
+      Left e -> responseLBS status500 [] (Aeson.encode $ toJSON e)
+      Right depositTx -> okJSON $ DraftCommitTxResponse depositTx
+
+  checkRecover query cont =
+    case Aeson.eitherDecode (fromStrict $ renderQuery False query) :: Either String TxIn of
+      Left e -> pure $ responseLBS status400 [] (Aeson.encode $ Aeson.String $ "Cannot recover funds. Failed to parse TxIn: " <> pack e)
+      Right txIn -> cont txIn
 
-  Chain{draftCommitTx} = directChain
+  Chain{draftRecoverTx} = directChain
 
 -- | Handle request to submit a cardano transaction.
 handleSubmitUserTx ::

hydra-node/src/Hydra/Chain.hs

@@ -18,6 +18,8 @@ import Hydra.Cardano.Api (
   Address,
   ByronAddr,
   Coin (..),
+  SlotNo,
+  TxIn,
  )
 import Hydra.Chain.ChainState (ChainSlot, IsChainState (..))
 import Hydra.Tx (
@@ -34,6 +36,7 @@ import Hydra.Tx (
  )
 import Hydra.Tx.IsTx (ArbitraryIsTx)
 import Hydra.Tx.OnChainId (OnChainId)
+import PlutusLedgerApi.V2 (CurrencySymbol, POSIXTime)
 import Test.Cardano.Ledger.Core.Arbitrary ()
 import Test.QuickCheck.Instances.Semigroup ()
 import Test.QuickCheck.Instances.Time ()
@@ -170,6 +173,8 @@ data PostTxError tx
   | FailedToConstructCloseTx
   | FailedToConstructContestTx
   | FailedToConstructCollectTx
+  | FailedToConstructDepositTx
+  | FailedToConstructRecoverTx
   | FailedToConstructDecrementTx
   | FailedToConstructFanoutTx
   deriving stock (Generic)
@@ -246,6 +251,15 @@ data Chain tx m = Chain
   -- ^ Create a deposit transaction using user provided utxos (zero or many) and
   -- a deadline for their inclusion into L2.
   -- Errors are handled at the call site.
+  , draftRecoverTx ::
+      MonadThrow m =>
+      CurrencySymbol ->
+      UTxOType tx ->
+      POSIXTime ->
+      SlotNo ->
+      TxIn ->
+      m (Either (PostTxError tx) tx)
+  -- ^ Create a recover transaction which unlocks depositted funds.
   , submitTx :: MonadThrow m => tx -> m ()
   -- ^ Submit a cardano transaction.
   --

hydra-node/src/Hydra/Chain/Direct/Handlers.hs

@@ -75,6 +75,7 @@ import Hydra.Chain.Direct.Wallet (
   TinyWallet (..),
   TinyWalletLog,
  )
+import Hydra.Contract.Commit qualified as Commit
 import Hydra.Ledger.Cardano (adjustUTxO)
 import Hydra.Logging (Tracer, traceWith)
 import Hydra.Plutus.Extras (posixToUTCTime)
@@ -86,6 +87,7 @@ import Hydra.Tx (
 import Hydra.Tx.Contest (ClosedThreadOutput (..))
 import Hydra.Tx.ContestationPeriod (toNominalDiffTime)
 import Hydra.Tx.Deposit (depositTx)
+import Hydra.Tx.Recover (recoverTx)
 import System.IO.Error (userError)
 
 -- | Handle of a mutable local chain state that is kept in the direct chain layer.
@@ -170,13 +172,22 @@ mkChain tracer queryTimeHandle wallet ctx LocalChainState{getLatest} submitTx =
         let CommitBlueprintTx{lookupUTxO} = commitBlueprintTx
         traverse (finalizeTx wallet ctx spendableUTxO lookupUTxO) $
           commit' ctx headId spendableUTxO commitBlueprintTx
-    , -- Handle that creates a draft **incremental** commit tx using the user utxo and a _blueprint_ transaction.
+    , -- Handle that creates a draft **deposit** tx using the user utxo and a deadline.
       -- Possible errors are handled at the api server level.
       draftDepositTx = \headId utxo deadline -> do
         ChainStateAt{spendableUTxO} <- atomically getLatest
         traverse (finalizeTx wallet ctx spendableUTxO utxo) $
           -- TODO: Should we move deposit tx argument verification to `depositTx` function and have Either here?
           Right (depositTx (networkId ctx) headId utxo deadline)
+    , -- Handle that creates a draft **recover** tx using provided arguments.
+      -- Possible errors are handled at the api server level.
+      draftRecoverTx = \headCS utxo deadline lowerValidity txIn -> do
+        ChainStateAt{spendableUTxO} <- atomically getLatest
+        -- TODO: what's the user UTxO here for the finalizeTx? mempty?
+        traverse (finalizeTx wallet ctx spendableUTxO utxo) $
+          -- TODO: Should we move recover tx argument verification to `recoverTx` function and have Either here?
+          let commitsToRecover = mapMaybe Commit.serializeCommit (UTxO.pairs utxo)
+           in Right (recoverTx (networkId ctx) headCS txIn commitsToRecover deadline lowerValidity)
     , -- Submit a cardano transaction to the cardano-node using the
       -- LocalTxSubmission protocol.
       submitTx

hydra-node/src/Hydra/Chain/Offline.hs

@@ -84,7 +84,8 @@ withOfflineChain nodeId OfflineChainConfig{ledgerGenesisFile, initialUTxOFile} p
     Chain
       { submitTx = const $ pure ()
       , draftCommitTx = \_ _ -> pure $ Left FailedToDraftTxNotInitializing
-      , draftDepositTx = \_ _ _ -> pure $ Left FailedToDraftTxNotInitializing
+      , draftDepositTx = \_ _ _ -> pure $ Left FailedToConstructDepositTx
+      , draftRecoverTx = \_ _ _ _ _ -> pure $ Left FailedToConstructRecoverTx
       , postTx = const $ pure ()
       }
 

hydra-node/test/Hydra/API/HTTPServerSpec.hs

@@ -153,19 +153,13 @@ apiServerSpec = do
               { draftCommitTx = \_ _ -> do
                   tx <- generate $ arbitrary @Tx
                   pure $ Right tx
-              , draftDepositTx = \_ _ _ -> do
-                  tx <- generate $ arbitrary @Tx
-                  pure $ Right tx
               }
       prop "responds on valid requests" $ \(request :: DraftCommitTxRequest Tx) ->
         withApplication (httpApp nullTracer workingChainHandle defaultPParams getHeadId getNothing putClientInput) $ do
           post "/commit" (Aeson.encode request)
             `shouldRespondWith` case request of
-              IncrementalCommitDepositRequest{utxo, deadline} ->
-                if utxo == mempty
-                  then 400{matchBody = matchJSON $ Aeson.String "Empty UTxO"}
-                  else 200
-              IncrementalCommitRecoverRequest{} -> 400 -- TODO: after implementing recover revisit this
+              IncrementalCommitDepositRequest{} -> 400
+              IncrementalCommitRecoverRequest{} -> 400 -- NOTE: This request type is used in DELETE verb so we don't care about it here
               _ -> 200
 
       let failingChainHandle postTxError =

hydra-node/test/Hydra/API/ServerSpec.hs

@@ -30,6 +30,7 @@ import Hydra.Chain (
   Chain (Chain),
   draftCommitTx,
   draftDepositTx,
+  draftRecoverTx,
   postTx,
   submitTx,
  )
@@ -374,6 +375,7 @@ dummyChainHandle =
     { postTx = \_ -> error "unexpected call to postTx"
     , draftCommitTx = \_ -> error "unexpected call to draftCommitTx"
     , draftDepositTx = \_ -> error "unexpected call to draftDepositTx"
+    , draftRecoverTx = \_ -> error "unexpected call to draftRecoverTx"
     , submitTx = \_ -> error "unexpected call to submitTx"
     }
 

hydra-node/test/Hydra/BehaviorSpec.hs

@@ -750,6 +750,7 @@ simulatedChainAndNetwork initialChainState = do
                         createAndYieldEvent nodes history localChainState $ toOnChainTx now tx
                   , draftCommitTx = \_ -> error "unexpected call to draftCommitTx"
                   , draftDepositTx = \_ -> error "unexpected call to draftIncrementalCommitTx"
+                  , draftRecoverTx = \_ -> error "unexpected call to draftRecoverTx"
                   , submitTx = \_ -> error "unexpected call to submitTx"
                   }
               mockNetwork = createMockNetwork draftNode nodes

hydra-node/test/Hydra/NodeSpec.hs

@@ -335,6 +335,7 @@ mockChain =
     { postTx = \_ -> pure ()
     , draftCommitTx = \_ _ -> failure "mockChain: unexpected draftCommitTx"
     , draftDepositTx = \_ _ _ -> failure "mockChain: unexpected draftDepositTx"
+    , draftRecoverTx = \_ _ _ _ _ -> failure "mockChain: unexpected draftRecoverTx"
     , submitTx = \_ -> failure "mockChain: unexpected submitTx"
     }
 
@@ -457,6 +458,7 @@ throwExceptionOnPostTx exception node =
             { postTx = \_ -> throwIO exception
             , draftCommitTx = \_ -> error "draftCommitTx not implemented"
             , draftDepositTx = \_ -> error "draftDepositTx not implemented"
+            , draftRecoverTx = \_ -> error "draftRecoverTx not implemented"
             , submitTx = \_ -> error "submitTx not implemented"
             }
       }