feat: use new Duration

Author: paolino

justfile

@@ -46,10 +46,6 @@ integration match="":
         echo "Please set MOOG_GITHUB_PAT environment variable, this is a valid GitHub personal access token with access to the public github API"
         exit 1
     fi
-    if [ -z "${MOOG_SSH_PASSWORD:-}" ]; then
-        echo "Please set MOOG_SSH_PASSWORD environment variable, this is the passphrase for the cfhal encrypted SSH private key"
-        exit 1
-    fi
     if ! test -f  tmp/test.json; then
         echo "E2E tests expect wallet definition in tmp/test.json file"
         exit 1
@@ -119,10 +115,6 @@ E2E match="":
         echo "Please set MOOG_GITHUB_PAT environment variable, this is a valid GitHub personal access token with access to the public github API"
         exit 1
     fi
-    if [ -z "${MOOG_SSH_PASSWORD:-}" ]; then
-        echo "Please set MOOG_SSH_PASSWORD environment variable, this is the passphrase for the cfhal encrypted SSH private key"
-        exit 1
-    fi
     if ! test -f  tmp/test.json; then
         echo "E2E tests expect wallet definition in tmp/test.json file"
         exit 1

src/Core/Options.hs

@@ -23,7 +23,6 @@ import Control.Arrow (left)
 import Core.Types.Basic
     ( Commit (..)
     , Directory (..)
-    , Duration (..)
     , FaultsEnabled (FaultsEnabled)
     , GithubRepository (..)
     , GithubUsername (..)
@@ -32,6 +31,7 @@ import Core.Types.Basic
     , TokenId (..)
     , Try (..)
     )
+import Core.Types.Duration (Duration (..))
 import Core.Types.Mnemonics.Options (mnemonicsParser)
 import Core.Types.Wallet
     ( Wallet
@@ -57,6 +57,7 @@ import OptEnvConf
     , strOption
     , switch
     , value
+    , (<|>)
     )
 import OptEnvConf.Reader (Reader (..))
 import Submitting (readWallet)
@@ -192,15 +193,24 @@ parseOutputReference = Reader $ \s -> do
 
 durationOption :: Parser Duration
 durationOption =
-    Duration
+    Hours
         <$> setting
-            [ long "duration"
-            , short 't'
-            , metavar "DURATION"
+            [ long "hours-duration"
+            , short 'h'
+            , metavar "HOURS"
             , help "The duration in hours for the test-run"
             , reader auto
             , option
             ]
+        <|> Minutes
+            <$> setting
+                [ long "minutes-duration"
+                , short 'm'
+                , metavar "MINUTES"
+                , help "The duration in minutes for the test-run"
+                , reader auto
+                , option
+                ]
 
 faultsEnabledOption :: Parser FaultsEnabled
 faultsEnabledOption =

src/Core/Types/Basic.hs

@@ -7,7 +7,6 @@ module Core.Types.Basic
     , Commit (..)
     , Directory (..)
     , FileName (..)
-    , Duration (..)
     , Host (..)
     , Owner (..)
     , Platform (..)
@@ -197,9 +196,6 @@ instance FromHttpApiData Address where
 instance ToHttpApiData Address where
     toUrlPiece (Address addr) = addr
 
-newtype Duration = Duration Int
-    deriving (Eq, Show)
-
 newtype FaultsEnabled = FaultsEnabled {getFaultsEnabled :: Bool}
     deriving (Eq, Show)
     deriving newtype (Aeson.FromJSON)

src/Oracle/Config/Options.hs

@@ -9,6 +9,7 @@ where
 
 import Core.Options (tokenIdOption, walletOption)
 import Core.Types.Basic (Owner (..))
+import Core.Types.Duration (Duration (..))
 import Lib.Box (Box (..))
 import OptEnvConf
     ( Parser
@@ -32,22 +33,24 @@ import Oracle.Validate.Requests.TestRun.Config
 configOption :: Parser Config
 configOption = do
     minDuration <-
-        setting
-            [ long "min-test-duration"
-            , metavar "MIN_TEST_HOURS"
-            , help "Minimum duration of the tests in hours"
-            , option
-            , reader auto
-            ]
+        Minutes
+            <$> setting
+                [ long "min-test-duration"
+                , metavar "MINUTES"
+                , help "Minimum duration of the tests in minutes"
+                , option
+                , reader auto
+                ]
 
     maxDuration <-
-        setting
-            [ long "max-test-duration"
-            , metavar "MAX_TEST_HOURS"
-            , help "Maximum duration of the tests in hours"
-            , option
-            , reader auto
-            ]
+        Minutes
+            <$> setting
+                [ long "max-test-duration"
+                , metavar "MINUTES"
+                , help "Maximum duration of the tests in minutes"
+                , option
+                , reader auto
+                ]
     agent <-
         Owner
             <$> strOption

src/Oracle/Config/Types.hs

@@ -6,14 +6,22 @@ module Oracle.Config.Types
     )
 where
 
+import Control.Applicative (Alternative)
 import Core.Types.Basic (Owner)
 import Core.Types.Change (Change)
-import Core.Types.Operation
-import Lib.JSON.Canonical.Extra
+import Core.Types.Operation (Op (OpI, OpU))
+import Lib.JSON.Canonical.Extra (object, withObject, (.:), (.=))
 import Oracle.Validate.Requests.TestRun.Config
     ( TestRunValidationConfig
     )
 import Text.JSON.Canonical
+    ( FromJSON (..)
+    , JSValue (JSString)
+    , ReportSchemaErrors
+    , ToJSON (..)
+    , expectedButGotValue
+    , toJSString
+    )
 
 data Config = Config
     { configAgent :: Owner
@@ -46,7 +54,7 @@ instance Monad m => ToJSON m Config where
             , "testRun" .= testRun
             ]
 
-instance ReportSchemaErrors m => FromJSON m Config where
+instance (Alternative m, ReportSchemaErrors m) => FromJSON m Config where
     fromJSON = withObject "Config" $ \o -> do
         Config
             <$> o .: "agent"

src/Oracle/Validate/Requests/Config.hs

@@ -8,6 +8,7 @@ where
 import Control.Monad (when)
 import Core.Types.Basic (Owner)
 import Core.Types.Change (Change (..))
+import Core.Types.Duration (Duration)
 import Core.Types.Operation (Op (..), Operation (..))
 import Effects
     ( Effects
@@ -29,28 +30,28 @@ import Oracle.Validate.Types
     , mapFailure
     , notValidated
     )
-import Text.JSON.Canonical (Int54, ToJSON (..))
+import Text.JSON.Canonical (ToJSON (..))
 
 data ConfigFailure
     = ConfigureKeyValidationFailure KeyFailure
     | ConfigureNotFromOracle Owner
-    | ConfigureMinLessThanOne Int
-    | ConfigureMaxLessThanMin Int Int
+    | ConfigureMinLessThanZero Duration
+    | ConfigureMaxLessThanMin Duration Duration
     deriving (Show, Eq)
 
 instance Monad m => ToJSON m ConfigFailure where
     toJSON (ConfigureKeyValidationFailure keyFailure) =
         object ["configureKeyValidationFailure" .= keyFailure]
     toJSON (ConfigureNotFromOracle owner) =
         object ["configureNotFromOracle" .= show owner]
-    toJSON (ConfigureMinLessThanOne minD) =
-        object ["configureMinLessThanOne" .= fromIntegral @_ @Int54 minD]
+    toJSON (ConfigureMinLessThanZero minD) =
+        object ["configureMinLessThanZero" .= minD]
     toJSON (ConfigureMaxLessThanMin maxD minD) =
         object
             [ (,) "configureMaxLessThanMin"
                 $ object
-                    [ "max" .= fromIntegral @_ @Int54 maxD
-                    , "min" .= fromIntegral @_ @Int54 minD
+                    [ "max" .= maxD
+                    , "min" .= minD
                     ]
             ]
 
@@ -66,9 +67,9 @@ commonValidation oracleOwner submitterOwner configTestRun = do
         $ ConfigureNotFromOracle submitterOwner
     let minD = minDuration configTestRun
         maxD = maxDuration configTestRun
-    when (minD < 1)
+    when (minD <= mempty)
         $ notValidated
-        $ ConfigureMinLessThanOne minD
+        $ ConfigureMinLessThanZero minD
     when (maxD < minD)
         $ notValidated
         $ ConfigureMaxLessThanMin maxD minD

src/Oracle/Validate/Requests/TestRun/Config.hs

@@ -4,30 +4,34 @@ module Oracle.Validate.Requests.TestRun.Config
     ( TestRunValidationConfig (..)
     ) where
 
+import Control.Applicative (Alternative)
+import Core.Types.Duration (Duration)
 import GHC.Generics (Generic)
 import Lib.JSON.Canonical.Extra
 import Text.JSON.Canonical
     ( FromJSON (..)
-    , Int54
     , ReportSchemaErrors
     , ToJSON (..)
     )
 
 data TestRunValidationConfig = TestRunValidationConfig
-    { maxDuration :: Int
-    , minDuration :: Int
+    { maxDuration :: Duration
+    , minDuration :: Duration
     }
     deriving (Show, Eq, Generic)
 
 instance Monad m => ToJSON m TestRunValidationConfig where
     toJSON (TestRunValidationConfig maxDur minDur) =
         object
-            [ "maxDuration" .= fromIntegral @_ @Int54 maxDur
-            , "minDuration" .= fromIntegral @_ @Int54 minDur
+            [ "maxDuration" .= maxDur
+            , "minDuration" .= minDur
             ]
 
-instance ReportSchemaErrors m => FromJSON m TestRunValidationConfig where
+instance
+    (Alternative m, ReportSchemaErrors m)
+    => FromJSON m TestRunValidationConfig
+    where
     fromJSON = withObject "TestRunValidationConfig" $ \o ->
         TestRunValidationConfig
-            <$> (o .: "maxDuration" >>= pure . fromIntegral @Int54)
-            <*> (o .: "minDuration" >>= pure . fromIntegral @Int54)
+            <$> (o .: "maxDuration" >>= fromJSON)
+            <*> (o .: "minDuration" >>= fromJSON)

src/Oracle/Validate/Requests/TestRun/Create.hs

@@ -12,12 +12,12 @@ import Control.Monad.Trans.Class (lift)
 import Core.Types.Basic
     ( Commit (..)
     , Directory (..)
-    , Duration (..)
     , GithubRepository (..)
     , GithubUsername (..)
     , Try (..)
     )
 import Core.Types.Change (Change (..), Key (..))
+import Core.Types.Duration (Duration)
 import Core.Types.Fact (Fact (..))
 import Core.Types.Operation (Op (..), Operation (..))
 import Core.Types.VKey (decodeVKey)
@@ -120,7 +120,7 @@ validateCreateTestRun
                 testRunState
 
 data TestRunRejection
-    = UnacceptableDuration Int Int
+    = UnacceptableDuration Duration Duration
     | UnacceptableCommit GithubRepository Commit
     | UnacceptableTryIndex Try
     | UnacceptableRole RegisterRoleKey
@@ -179,7 +179,7 @@ instance Monad m => ToJSON m TestRunRejection where
 
 checkDuration
     :: TestRunValidationConfig -> Duration -> Maybe TestRunRejection
-checkDuration TestRunValidationConfig{maxDuration, minDuration} (Duration n)
+checkDuration TestRunValidationConfig{maxDuration, minDuration} n
     | n < minDuration || n > maxDuration =
         Just $ UnacceptableDuration minDuration maxDuration
     | otherwise = Nothing

src/User/Agent/Cli.hs

@@ -28,7 +28,6 @@ import Core.Context
     )
 import Core.Types.Basic
     ( Directory
-    , Duration
     , GithubRepository
     , GithubUsername (..)
     , Owner
@@ -37,6 +36,7 @@ import Core.Types.Basic
     , TokenId
     )
 import Core.Types.Change (Change (..), Key (..))
+import Core.Types.Duration (Duration)
 import Core.Types.Fact
     ( Fact (..)
     , keyHash
@@ -100,7 +100,6 @@ import User.Agent.PublishResults.Email
     ( EmailException
     , EmailPassword
     , EmailUser
-    , Minutes
     , Result (..)
     , readEmails
     )
@@ -368,12 +367,12 @@ data AgentCommand (phase :: IsReady) result where
         -> EmailUser
         -> EmailPassword
         -> TestRunId
-        -> Minutes
+        -> Duration
         -> AgentCommand phase (AValidationResult CheckResultsFailure Result)
     CheckAllResults
         :: EmailUser
         -> EmailPassword
-        -> Minutes
+        -> Duration
         -- ^ limit to last N minutes
         -> AgentCommand phase (AValidationResult CheckResultsFailure [Result])
     PushTest

src/User/Agent/Lib.hs

@@ -7,7 +7,8 @@ module User.Agent.Lib
 
 import Control.Applicative (Alternative (..))
 import Core.Context (WithContext, withMPFS)
-import Core.Types.Basic (Duration, FaultsEnabled, TokenId)
+import Core.Types.Basic (FaultsEnabled, TokenId)
+import Core.Types.Duration (Duration)
 import Core.Types.Fact (Fact (..), keyHash, parseFacts)
 import Data.Foldable (find)
 import MPFS.API (MPFS (..))