[cli] Move anti oracle token get to anti token

Author: paolino

cli/src/Cli.hs

@@ -4,20 +4,37 @@ module Cli
     ) where
 
 import Control.Monad.IO.Class (MonadIO (..))
-import Core.Context (withContext)
+import Control.Monad.Trans.Class (MonadTrans (..))
+import Core.Context (askConfig, askMpfs, askValidation, withContext)
 import Core.Types.Basic (RequestRefId, TokenId)
 import Core.Types.MPFS (MPFSClient (..))
 import Core.Types.Tx (TxHash, WithTxHash (..))
 import Core.Types.Wallet (Wallet)
+import Data.Functor.Identity (Identity (..))
 import Lib.GitHub (getOAUth)
+import Lib.JSON.Canonical.Extra
 import MPFS.API
-    ( getTokenFacts
+    ( MPFS (..)
+    , getTokenFacts
     , mpfsClient
     , retractChange
     )
 import Oracle.Cli (OracleCommand (..), oracleCmd)
+import Oracle.Types
+    ( RequestValidationFailure
+    , Token (..)
+    , TokenState (..)
+    , fmapMToken
+    )
+import Oracle.Validate.Request (validateRequest)
+import Oracle.Validate.Types
+    ( AValidationResult
+    , ValidationResult
+    , liftMaybe
+    , runValidate
+    )
 import Submitting (Submission (..))
-import Text.JSON.Canonical (JSValue)
+import Text.JSON.Canonical (FromJSON (..), JSValue, ToJSON (..))
 import User.Agent.Cli
     ( AgentCommand (..)
     , IsReady (NotReady)
@@ -38,6 +55,11 @@ data Command a where
         :: MPFSClient -> Wallet -> RequestRefId -> Command TxHash
     GetFacts :: MPFSClient -> TokenId -> Command JSValue
     Wallet :: WalletCommand a -> Command a
+    GetToken
+        :: MPFSClient
+        -> TokenId
+        -> Command
+            (AValidationResult TokenInfoFailure (Token WithValidation))
 
 data SetupError = TokenNotSpecified
     deriving (Show, Eq)
@@ -87,3 +109,46 @@ cmd = \case
     GetFacts MPFSClient{runMPFS} tokenId -> do
         runMPFS $ getTokenFacts tokenId
     Wallet walletCommand -> liftIO $ walletCmd walletCommand
+    GetToken
+        MPFSClient{runMPFS, submitTx}
+        tk -> do
+            auth <- getOAUth
+            runMPFS
+                $ withContext
+                    mpfsClient
+                    (mkValidation auth)
+                    submitTx
+                $ do
+                    validation <- askValidation $ Just tk
+                    mconfig <- askConfig tk
+                    mpfs <- askMpfs
+                    lift $ runValidate $ do
+                        mpendings <- lift $ fromJSON <$> mpfsGetToken mpfs tk
+                        token <- liftMaybe (TokenInfoTokenNotParsable tk) mpendings
+                        let oracle = tokenOwner $ tokenState token
+                            f (Identity req) = do
+                                r <-
+                                    runValidate
+                                        $ validateRequest oracle mconfig validation req
+                                pure $ WithValidation r req
+                        lift $ fmapMToken f token
+
+newtype TokenInfoFailure = TokenInfoTokenNotParsable TokenId
+    deriving (Show, Eq)
+
+instance Monad m => ToJSON m TokenInfoFailure where
+    toJSON (TokenInfoTokenNotParsable tk) =
+        object ["tokenNotParsable" .= tk]
+
+data WithValidation x = WithValidation
+    { validation :: ValidationResult RequestValidationFailure
+    , request :: x
+    }
+    deriving (Show, Eq)
+
+instance (Monad m, ToJSON m x) => ToJSON m (WithValidation x) where
+    toJSON (WithValidation mvalidation request) =
+        object
+            [ "validation" .= mvalidation
+            , "request" .= request
+            ]

cli/src/Options.hs

@@ -60,6 +60,8 @@ commandParser =
             retractRequestOptions
         , command "facts" "Get token facts"
             $ fmap Box . GetFacts <$> mpfsClientOption <*> tokenIdOption
+        , command "token" "Get the token content"
+            $ fmap Box . GetToken <$> mpfsClientOption <*> tokenIdOption
         ]
 
 optionsParser :: Parser (Box Options)

cli/src/Oracle/Token/Cli.hs

@@ -31,7 +31,6 @@ import Oracle.Types
     , RequestZoo
     , Token (..)
     , TokenState (..)
-    , fmapMToken
     , requestZooRefId
     )
 import Oracle.Validate.Request
@@ -40,7 +39,6 @@ import Oracle.Validate.Request
 import Oracle.Validate.Types
     ( AValidationResult (..)
     , Validate
-    , ValidationResult
     , liftMaybe
     , mapFailure
     , notValidated
@@ -103,18 +101,7 @@ instance Monad m => ToJSON m TokenUpdateFailure where
         TokenUpdateNotRequestedFromTokenOwner ->
             toJSON ("Token update not requested from token owner" :: String)
 
-newtype TokenInfoFailure = TokenInfoTokenNotParsable TokenId
-    deriving (Show, Eq)
-
-instance Monad m => ToJSON m TokenInfoFailure where
-    toJSON (TokenInfoTokenNotParsable tk) =
-        object ["tokenNotParsable" .= tk]
-
 data TokenCommand a where
-    GetToken
-        :: TokenId
-        -> TokenCommand
-            (AValidationResult TokenInfoFailure (Token WithValidation))
     BootToken :: Wallet -> TokenCommand (WithTxHash TokenId)
     UpdateToken
         :: TokenId
@@ -142,39 +129,13 @@ promoteFailure req =
             . TokenUpdateRequestValidationFailure
         )
 
-data WithValidation x = WithValidation
-    { validation :: ValidationResult RequestValidationFailure
-    , request :: x
-    }
-    deriving (Show, Eq)
-
-instance (Monad m, ToJSON m x) => ToJSON m (WithValidation x) where
-    toJSON (WithValidation mvalidation request) =
-        object
-            [ "validation" .= mvalidation
-            , "request" .= request
-            ]
-
 tokenCmdCore
     :: (MonadIO m, MonadMask m)
     => TokenCommand a
     -> WithContext m a
 tokenCmdCore command = do
     mpfs <- askMpfs
     case command of
-        GetToken tk -> do
-            validation <- askValidation $ Just tk
-            mconfig <- askConfig tk
-            lift $ runValidate $ do
-                mpendings <- lift $ fromJSON <$> mpfsGetToken mpfs tk
-                token <- liftMaybe (TokenInfoTokenNotParsable tk) mpendings
-                let oracle = tokenOwner $ tokenState token
-                    f (Identity req) = do
-                        r <-
-                            runValidate
-                                $ validateRequest oracle mconfig validation req
-                        pure $ WithValidation r req
-                lift $ fmapMToken f token
         -- validateRequest oracle mconfig validation
         UpdateToken tk wallet wanted -> do
             Submission submit <- ($ wallet) <$> askSubmit

cli/src/Oracle/Token/Options.hs

@@ -26,8 +26,7 @@ tokenCommandParser
     :: Parser (Box TokenCommand)
 tokenCommandParser =
     commands
-        [ command "get" "Get the token" $ Box . GetToken <$> tokenIdOption
-        , command "update" "Update the token"
+        [ command "update" "Update the token"
             $ fmap (fmap Box) . UpdateToken
                 <$> tokenIdOption
                 <*> walletOption