fix: add delays

This commit is contained in:
orion 2023-12-12 19:10:19 -06:00
parent 687a9c76b8
commit 425d797d8c
Signed by: orion
GPG Key ID: 6D4165AE4C928719

View File

@ -15,13 +15,15 @@ import Data.Email (Email)
import Data.Email as Email import Data.Email as Email
import Data.Eq.Generic (genericEq) import Data.Eq.Generic (genericEq)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Int as Int
import Data.Maybe (maybe) import Data.Maybe (maybe)
import Data.Newtype (wrap)
import Data.Nullable (Nullable) import Data.Nullable (Nullable)
import Data.Nullable as Nullable import Data.Nullable as Nullable
import Data.Show.Generic (genericShow) import Data.Show.Generic (genericShow)
import Data.Traversable (for_) import Data.Traversable (for_)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff, delay)
import Type.Function (type ($)) import Type.Function (type ($))
foreign import checkEmailImpl :: String -> Effect $ Promise $ QEDResult foreign import checkEmailImpl :: String -> Effect $ Promise $ QEDResult
@ -96,6 +98,7 @@ deliverable email' =
attempt n attempt n
| n < 10 = | n < 10 =
do do
delay $ wrap $ 10.0 * Int.toNumber n
res <- runExceptT $ deliverableOnce email' res <- runExceptT $ deliverableOnce email'
case res of case res of
Left (EmailUnreachable _) -> pure $ Loop $ n + 1 Left (EmailUnreachable _) -> pure $ Loop $ n + 1
@ -104,8 +107,17 @@ deliverable email' =
| otherwise = pure $ Done $ Left $ EmailUnreachable email' | otherwise = pure $ Done $ Left $ EmailUnreachable email'
in in
do do
wildcard <- liftEither $ lmap (const $ EmailSyntaxInvalid email') $ Email.parse $ "*@" <> Email.domain email' wildcard <- liftEither
$ lmap
( const
$ EmailSyntaxInvalid email'
)
$ Email.parse
$ "b13f0cb1dd2d4404a91bf874e9fa8f5b@" <> Email.domain email'
res <- lift $ runExceptT $ deliverableOnce wildcard res <- lift $ runExceptT $ deliverableOnce wildcard
case res of case res of
Right _ -> throwError $ EmailWildcardExists email' Right _ -> throwError $ EmailWildcardExists email'
_ -> ExceptT $ tailRecM attempt 0 _ -> do
lift $ delay $ wrap $ 100.0
ExceptT $ tailRecM attempt 0