Skip to content

Commit b3a77c2

Browse files
paolinopaolino
committed
[cli] feat: add anti-agent executable
1 parent 66b7623 commit b3a77c2

File tree

4 files changed

+264
-0
lines changed

4 files changed

+264
-0
lines changed

‎cli/anti.cabal‎

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -142,6 +142,7 @@ library
142142
User.Agent.Cli
143143
User.Agent.Lib
144144
User.Agent.Options
145+
User.Agent.Process
145146
User.Agent.PublishResults.Email
146147
User.Agent.PushTest
147148
User.Agent.Types
@@ -269,6 +270,29 @@ executable anti-oracle
269270
-- Base language which the package is written in.
270271
default-language: Haskell2010
271272

273+
executable anti-agent
274+
-- Import common warning flags.
275+
import: warnings
276+
277+
-- .hs or .lhs file containing the Main module.
278+
main-is: app/anti-agent.hs
279+
280+
-- Modules included in this executable, other than Main.
281+
-- other-modules:
282+
283+
-- LANGUAGE extensions used by modules in this package.
284+
-- other-extensions:
285+
286+
-- Other library packages from which modules are imported.
287+
build-depends:
288+
, anti
289+
, base
290+
291+
-- Directories containing source files.
292+
293+
-- Base language which the package is written in.
294+
default-language: Haskell2010
295+
272296
test-suite anti-E2E-test
273297
-- Import common warning flags.
274298
import: warnings

‎cli/app/anti-agent.hs‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
import System.IO (BufferMode (..), hSetBuffering, stdin, stdout)
2+
import User.Agent.Process (agentProcess, parseArgs)
3+
4+
main :: IO ()
5+
main = do
6+
hSetBuffering stdin LineBuffering
7+
hSetBuffering stdout LineBuffering
8+
args <- parseArgs
9+
agentProcess args

‎cli/nix/anti-project.nix‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -63,6 +63,7 @@ in {
6363
inherit project;
6464
packages.anti = project.hsPkgs.anti.components.exes.anti;
6565
packages.anti-oracle = project.hsPkgs.anti.components.exes.anti-oracle;
66+
packages.anti-agent = project.hsPkgs.anti.components.exes.anti-agent;
6667
packages.bech32 = project.hsPkgs.bech32.components.exes.bech32;
6768
packages.cardano-address =
6869
project.hsPkgs.cardano-addresses.components.exes.cardano-address;

‎cli/src/User/Agent/Process.hs‎

Lines changed: 230 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,230 @@
1+
{-
2+
This is a full automated agent process that can be used in the CLI.
3+
The process
4+
- monitors the antithesis recipients email inbox for new test results.
5+
- monitors the running test-run facts
6+
- publish a report-test transaction for each new result found.
7+
-}
8+
{-# LANGUAGE QuasiQuotes #-}
9+
10+
module User.Agent.Process
11+
( ProcessOptions (..)
12+
, agentProcess
13+
, parseArgs
14+
) where
15+
16+
import Cli (Command (..), cmd)
17+
import Control.Applicative (Alternative (..))
18+
import Control.Concurrent (threadDelay)
19+
import Control.Monad (forever)
20+
import Core.Options (tokenIdOption, walletOption)
21+
import Core.Types.Basic (Duration, TokenId)
22+
import Core.Types.Fact (Fact (..))
23+
import Core.Types.MPFS (MPFSClient (..), mpfsClientOption)
24+
import Core.Types.Tx (WithTxHash)
25+
import Core.Types.Wallet (Wallet)
26+
import Data.Foldable (find, for_)
27+
import Data.Maybe (mapMaybe)
28+
import Data.String.QQ (s)
29+
import Data.Text qualified as T
30+
import Facts (All (..), FactsSelection (..), TestRunSelection (..))
31+
import GitHub (Auth)
32+
import OptEnvConf
33+
( Parser
34+
, runParser
35+
, withYamlConfig
36+
)
37+
import Options (githubAuthOption, secretsFileOption)
38+
import Oracle.Process (pollIntervalOption)
39+
import Oracle.Validate.Types (AValidationResult (..))
40+
import Paths_anti (version)
41+
import Text.JSON.Canonical
42+
( FromJSON (..)
43+
)
44+
import User.Agent.Cli
45+
( AgentCommand (..)
46+
, ReportFailure
47+
)
48+
import User.Agent.Lib (testRunDuration)
49+
import User.Agent.Options
50+
( agentEmailOption
51+
, agentEmailPasswordOption
52+
, daysOption
53+
)
54+
import User.Agent.PublishResults.Email
55+
( EmailPassword
56+
, EmailUser
57+
, Result (..)
58+
)
59+
import User.Agent.Types (TestRunId (..), mkTestRunId)
60+
import User.Types (Phase (..), TestRun, TestRunState, URL (..))
61+
62+
intro :: String
63+
intro =
64+
[s|
65+
Cardano Antithesis Agent Process
66+
67+
This process will run indefinitely, polling the recipient email for results,
68+
and changing the relative test-run facts to published when results are found.
69+
70+
To stop the process, simply interrupt it (Ctrl+C).
71+
72+
To get help on the available options, use the --help flag.
73+
74+
To get bash cli completion use
75+
76+
> source <(anti-agent --bash-completion-script "$(which anti-agent)")
77+
78+
Fish and zsh completions are also available.
79+
|]
80+
81+
parseArgs :: IO ProcessOptions
82+
parseArgs =
83+
runParser
84+
version
85+
intro
86+
$ withYamlConfig
87+
secretsFileOption
88+
processOptionsParser
89+
90+
data ProcessOptions = ProcessOptions
91+
{ poAuth :: Auth
92+
, poPollIntervalSeconds :: Int
93+
, poWallet :: Wallet
94+
, poTokenId :: TokenId
95+
, poMPFSClient :: MPFSClient
96+
, poAntithesisEmail :: EmailUser
97+
, poAntithesisEmailPassword :: EmailPassword
98+
, poDays :: Int
99+
}
100+
101+
processOptionsParser :: Parser ProcessOptions
102+
processOptionsParser =
103+
ProcessOptions
104+
<$> githubAuthOption
105+
<*> pollIntervalOption
106+
<*> walletOption
107+
<*> tokenIdOption
108+
<*> mpfsClientOption
109+
<*> agentEmailOption
110+
<*> agentEmailPasswordOption
111+
<*> daysOption
112+
113+
agentProcess
114+
:: ProcessOptions
115+
-> IO ()
116+
agentProcess opts@ProcessOptions{poPollIntervalSeconds} = do
117+
putStrLn "Starting agent process service..."
118+
forever $ do
119+
results <- pollEmails opts
120+
putStrLn
121+
$ "Found " ++ show (length results) ++ " email results."
122+
(runningTests, doneTests) <- pollRunningTests opts
123+
putStrLn
124+
$ "Found "
125+
++ show (length runningTests)
126+
++ " running tests and "
127+
++ show (length doneTests)
128+
++ " done tests."
129+
for_ results $ \result@Result{description} -> do
130+
let sameKey :: [Fact TestRun v] -> Maybe (Fact TestRun v)
131+
sameKey = find $ (description ==) . factKey
132+
matchingTests =
133+
Left <$> sameKey runningTests
134+
<|> Right <$> sameKey doneTests
135+
TestRunId trId = mkTestRunId description
136+
for_ matchingTests $ \case
137+
Left (Fact testRun testState) -> do
138+
putStrLn
139+
$ "Publishing result for test-run: "
140+
++ show testRun
141+
eres <- submit opts (testRunDuration testState) result
142+
case eres of
143+
ValidationFailure err ->
144+
putStrLn
145+
$ "Failed to publish result for test-run "
146+
++ trId
147+
++ ": "
148+
++ show err
149+
ValidationSuccess txHash ->
150+
putStrLn
151+
$ "Published result for test-run "
152+
++ trId
153+
++ " in transaction "
154+
++ show txHash
155+
Right _ -> do
156+
putStrLn
157+
$ "Test-run "
158+
++ trId
159+
++ " is already in done state."
160+
putStrLn
161+
$ "Sleeping for "
162+
++ show poPollIntervalSeconds
163+
++ " seconds..."
164+
threadDelay (poPollIntervalSeconds * 1000000)
165+
166+
pollEmails :: ProcessOptions -> IO [Result]
167+
pollEmails
168+
ProcessOptions
169+
{ poMPFSClient
170+
, poAuth
171+
, poAntithesisEmail
172+
, poAntithesisEmailPassword
173+
, poDays
174+
} = do
175+
eresults <-
176+
cmd
177+
$ AgentCommand
178+
poAuth
179+
poMPFSClient
180+
$ CheckAllResults
181+
poAntithesisEmail
182+
poAntithesisEmailPassword
183+
poDays
184+
185+
case eresults of
186+
ValidationFailure err -> error $ "Failed to get email results: " ++ show err
187+
ValidationSuccess results -> pure results
188+
189+
pollRunningTests
190+
:: ProcessOptions
191+
-> IO
192+
( [Fact TestRun (TestRunState 'RunningT)]
193+
, [Fact TestRun (TestRunState 'DoneT)]
194+
)
195+
pollRunningTests
196+
ProcessOptions
197+
{ poMPFSClient
198+
, poTokenId
199+
} = do
200+
allTrs <-
201+
cmd
202+
$ GetFacts Nothing poMPFSClient poTokenId
203+
$ TestRunFacts (AnyTestRuns [] All)
204+
let typed :: FromJSON Maybe x => [Fact TestRun x]
205+
typed = mapMaybe (mapM fromJSON) allTrs
206+
pure (typed, typed)
207+
208+
submit
209+
:: ProcessOptions
210+
-> Duration
211+
-> Result
212+
-> IO
213+
( AValidationResult
214+
ReportFailure
215+
(WithTxHash (TestRunState DoneT))
216+
)
217+
submit
218+
ProcessOptions{poAuth, poMPFSClient, poWallet, poTokenId}
219+
duration
220+
Result{description, link} =
221+
cmd
222+
$ AgentCommand poAuth poMPFSClient
223+
$ Report
224+
poTokenId
225+
poWallet
226+
(mkTestRunId description)
227+
()
228+
duration
229+
$ URL
230+
$ T.unpack link

0 commit comments

Comments
 (0)