captcha-capmonster (empty) → 0.1.0.0
raw patch · 20 files changed
+794/−0 lines, 20 filesdep +aesondep +aeson-qqdep +basesetup-changed
Dependencies added: aeson, aeson-qq, base, bytestring, captcha-capmonster, captcha-core, data-default, errors, extra, http-client, lens, lens-aeson, mtl, o-clock, string-conversions, string-interpolate, tasty, tasty-hunit, text, unliftio, wreq
Files
- CHANGELOG.md +3/−0
- LICENSE +21/−0
- README.md +10/−0
- Setup.hs +2/−0
- captcha-capmonster.cabal +106/−0
- src/Captcha/CapMonster.hs +19/−0
- src/Captcha/CapMonster/Internal.hs +115/−0
- src/Captcha/CapMonster/Internal/Error.hs +91/−0
- src/Captcha/CapMonster/Internal/Types/FunCaptcha.hs +52/−0
- src/Captcha/CapMonster/Internal/Types/HCaptcha.hs +54/−0
- src/Captcha/CapMonster/Internal/Types/Image.hs +42/−0
- src/Captcha/CapMonster/Internal/Types/ReCaptchaV2.hs +53/−0
- src/Captcha/CapMonster/Internal/Types/ReCaptchaV3.hs +45/−0
- test/Captcha/CapMonster.hs +46/−0
- test/Captcha/CapMonster/Test/FunCaptcha.hs +22/−0
- test/Captcha/CapMonster/Test/HCaptcha.hs +22/−0
- test/Captcha/CapMonster/Test/Image.hs +24/−0
- test/Captcha/CapMonster/Test/ReCaptchaV2.hs +22/−0
- test/Captcha/CapMonster/Test/ReCaptchaV3.hs +22/−0
- test/Main.hs +23/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+## 0.1.0.0++- Initial release.
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2021 Edward Yang++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,10 @@+# captcha-haskell++[](https://hackage.haskell.org/package/captcha-core)++This repository is split into multiple packages:+- [captcha-core](https://github.com/qwbarch/captcha-haskell/tree/main/core)+- [captcha-2captcha](https://github.com/qwbarch/captcha-haskell/tree/main/2captcha)+- [captcha-capmonster](https://github.com/qwbarch/captcha-haskell/tree/main/capmonster)++Visit the [microsite](https://qwbarch.github.io/captcha-haskell/) for more information.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ captcha-capmonster.cabal view
@@ -0,0 +1,106 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name: captcha-capmonster+version: 0.1.0.0+synopsis: A package for integrating a variety of captcha solving services.+description: A package for integrating a variety of captcha solving services.+ .+ Feature list:+ .+ * Makes use of the [lens](https://hackage.haskell.org/package/lens) package+ * Mtl-style typeclass, allowing you to use your own monad transformer stack+ * No exceptions are thrown. Errors are shown explicitly through its type signature+ * Minimal test suite provided for each captcha type+ * Captcha services are separated into different packages. Use what you need!+category: Network+homepage: https://github.com/qwbarch/captcha-haskell#readme+bug-reports: https://github.com/qwbarch/captcha-haskell/issues+author: Edward Yang+maintainer: qwbarch@gmail.com+copyright: 2021 Edward Yang+license: MIT+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/qwbarch/captcha-haskell++library+ exposed-modules:+ Captcha.CapMonster+ Captcha.CapMonster.Internal+ Captcha.CapMonster.Internal.Error+ Captcha.CapMonster.Internal.Types.FunCaptcha+ Captcha.CapMonster.Internal.Types.HCaptcha+ Captcha.CapMonster.Internal.Types.Image+ Captcha.CapMonster.Internal.Types.ReCaptchaV2+ Captcha.CapMonster.Internal.Types.ReCaptchaV3+ other-modules:+ Paths_captcha_capmonster+ hs-source-dirs:+ src+ ghc-options: -Wall -Wno-name-shadowing+ build-depends:+ aeson >=1.5.6 && <1.6+ , aeson-qq >=0.8.4 && <0.9+ , base >=4.7 && <5+ , bytestring >=0.10.12.0 && <0.11+ , captcha-core ==0.1.*+ , errors >=2.3.0 && <2.4+ , extra >=1.7.9 && <1.8+ , http-client >=0.6.4.1 && <0.8+ , lens >=4.19.2 && <5.1+ , lens-aeson >=1.1.3 && <1.2+ , mtl >=2.2.2 && <2.3+ , o-clock >=1.2.1 && <1.3+ , string-interpolate >=0.3.1.1 && <0.4+ , text >=1.2.4.1 && <1.3+ , unliftio >=0.2.20 && <0.3+ , wreq >=0.5.3.3 && <0.6+ default-language: Haskell2010++test-suite capmonster-test+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules:+ Captcha.CapMonster+ Captcha.CapMonster.Test.FunCaptcha+ Captcha.CapMonster.Test.HCaptcha+ Captcha.CapMonster.Test.Image+ Captcha.CapMonster.Test.ReCaptchaV2+ Captcha.CapMonster.Test.ReCaptchaV3+ Paths_captcha_capmonster+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wno-name-shadowing+ build-depends:+ aeson >=1.5.6 && <1.6+ , aeson-qq >=0.8.4 && <0.9+ , base >=4.7 && <5+ , bytestring >=0.10.12.0 && <0.11+ , captcha-capmonster+ , captcha-core ==0.1.*+ , data-default+ , errors >=2.3.0 && <2.4+ , extra >=1.7.9 && <1.8+ , http-client >=0.6.4.1 && <0.8+ , lens >=4.19.2 && <5.1+ , lens-aeson >=1.1.3 && <1.2+ , mtl >=2.2.2 && <2.3+ , o-clock >=1.2.1 && <1.3+ , string-conversions+ , string-interpolate >=0.3.1.1 && <0.4+ , tasty+ , tasty-hunit+ , text >=1.2.4.1 && <1.3+ , unliftio >=0.2.20 && <0.3+ , wreq >=0.5.3.3 && <0.6+ default-language: Haskell2010
+ src/Captcha/CapMonster.hs view
@@ -0,0 +1,19 @@+-- |+-- Module: Captcha.CapMonster+-- Copyright: (c) 2022 Edward Yang+-- License: MIT+--+-- This module exports functions that follow the pvp versioning policies.+module Captcha.CapMonster+ ( module Captcha.CapMonster.Internal.Error,+ module Captcha.CapMonster.Internal,+ )+where++import Captcha.CapMonster.Internal (CapMonster)+import Captcha.CapMonster.Internal.Error (CapMonsterError (..), CapMonsterErrorCode (..))+import Captcha.CapMonster.Internal.Types.FunCaptcha ()+import Captcha.CapMonster.Internal.Types.HCaptcha ()+import Captcha.CapMonster.Internal.Types.Image ()+import Captcha.CapMonster.Internal.Types.ReCaptchaV2 ()+import Captcha.CapMonster.Internal.Types.ReCaptchaV3 ()
+ src/Captcha/CapMonster/Internal.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module: Captcha.CapMonster.Internal+-- Copyright: (c) 2022 Edward Yang+-- License: MIT+--+-- This module is for internal-use and does not follow pvp versioning policies.+module Captcha.CapMonster.Internal where++import Captcha.CapMonster.Internal.Error (CapMonsterError (CapMonsterResponseError, NetworkError, TimeoutError, UnknownError, UnknownResponseError), CapMonsterErrorCode (CaptchaNotReady))+import qualified Captcha.CapMonster.Internal.Error as CapMonsterError+import Captcha.Internal.Monad (HasCaptchaEnv)+import Captcha.Internal.Monad.Class (CaptchaId (CaptchaId, unCaptchaId), CaptchaRequest (request), CaptchaResponse (parseResult), MonadCaptcha (CaptchaError, createTask, getTask, solve))+import Captcha.Internal.Request (post)+import Captcha.Internal.Types (HasApiKey (apiKey), HasPollingInterval (pollingInterval), HasTimeoutDuration (timeoutDuration))+import Control.Error (note)+import Control.Lens (preview, view, (^.), (^?))+import Control.Monad ((<=<))+import Control.Monad.Except (ExceptT (ExceptT), runExceptT)+import Control.Monad.Reader (MonadReader)+import Data.Aeson (Value)+import Data.Aeson.Lens (key, _Integer, _String, _Value)+import Data.Aeson.QQ (aesonQQ)+import Data.Bifunctor (Bifunctor (bimap))+import Data.ByteString.Lazy (ByteString)+import Data.Either.Extra (fromEither)+import Data.Maybe (fromMaybe)+import Data.String.Interpolate (i, iii)+import Data.Text (Text)+import Network.HTTP.Client (HttpException)+import Network.Wreq (Response, defaults, responseBody)+import Time (Microsecond, Millisecond, Time (Time), toNum)+import Time.Units (threadDelay)+import UnliftIO (MonadUnliftIO, timeout, try)++-- | Used for picking 'MonadCaptcha' instances for CapMonster.+data CapMonster++-- | Parse the http response into the captcha answer, handling any errors found.+parseResponse :: (Value -> Maybe Value) -> Either HttpException (Response ByteString) -> Either CapMonsterError Value+parseResponse f response =+ (flip maybe Right . Left . parseError . Just) <*> f =<< parseBody+ where+ missingResponse =+ [iii|+ The response body is missing.+ This is likely due to a change in CapMonster's API and will need to be fixed.+ |]+ readError responseBody = do+ body <- responseBody+ code <- body ^? key "errorCode" . _String+ description <- body ^? key "errorDescription" . _String+ return (code, description)+ parseError responseBody = fromEither $ do+ (code, description) <- note (CapMonsterResponseError CaptchaNotReady) (readError responseBody)+ note (UnknownResponseError code description) (CapMonsterResponseError <$> CapMonsterError.parseError code)+ parseBody = note (UnknownError missingResponse) =<< bimap NetworkError (preview $ responseBody . _Value) response++instance (HasCaptchaEnv r, MonadReader r m, MonadUnliftIO m) => MonadCaptcha CapMonster r m where+ type CaptchaError CapMonster r m = CapMonsterError++ createTask :: forall ctx. CaptchaRequest CapMonster ctx r m => ctx -> m (Either CapMonsterError (CaptchaId ctx))+ createTask captcha =+ (parseCaptchaId <=< parseResponse (preview $ key "taskId")) <$> try (request @CapMonster @ctx @r @m captcha url)+ where+ url = "https://api.capmonster.cloud/createTask"+ parseCaptchaId captchaId =+ CaptchaId <$> note (UnknownError [i|CaptchaId is not an Integer: #{captchaId}|]) (captchaId ^? _Integer)++ getTask :: forall ctx. CaptchaResponse CapMonster ctx => Text -> CaptchaId ctx -> m (Either CapMonsterError Text)+ getTask apiKey captchaId =+ fmap (view _String) . parseResponse (parseResult @CapMonster @ctx) <$> try (post defaults url payload)+ where+ url = "https://api.capmonster.cloud/getTaskResult"+ payload =+ [aesonQQ|+ {+ clientKey: #{apiKey},+ taskId: #{unCaptchaId captchaId}+ }+ |]++ solve ::+ forall ctx.+ ( CaptchaRequest CapMonster ctx r m,+ CaptchaResponse CapMonster ctx,+ HasApiKey ctx Text,+ HasPollingInterval ctx (Maybe (Time Millisecond)),+ HasTimeoutDuration ctx (Maybe (Time Millisecond))+ ) =>+ ctx ->+ m (Either CapMonsterError Text)+ solve captcha =+ handleTimeout (captcha ^. timeoutDuration) . runExceptT $+ ExceptT . pollResult =<< ExceptT (createTask @CapMonster @r @m captcha)+ where+ handleTimeout (Just duration) f = fromMaybe (Left TimeoutError) <$> timeout (toNum @Microsecond duration) f+ handleTimeout Nothing f = f+ pollResult captchaId =+ threadDelay (fromMaybe (Time @Millisecond 10_000) (captcha ^. pollingInterval))+ *> getTask @CapMonster @r @m @ctx (captcha ^. apiKey) captchaId+ >>= \case+ Left (CapMonsterResponseError CaptchaNotReady) -> pollResult captchaId+ x -> pure x
+ src/Captcha/CapMonster/Internal/Error.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StrictData #-}++-- |+-- Module: Captcha.CapMonster.Internal.Error+-- Copyright: (c) 2022 Edward Yang+-- License: MIT+--+-- This module is for internal-use and does not follow pvp versioning policies.+module Captcha.CapMonster.Internal.Error where++import Control.Exception (Exception)+import Data.Foldable (find)+import Data.Text (Text)+import Network.HTTP.Client (HttpException)++-- | All possible errors when solving a captcha using CapMonster.+data CapMonsterError+ = -- | An error returned by the CapMonster API.+ CapMonsterResponseError CapMonsterErrorCode+ | -- |+ -- An error returned by the CapMonster API that+ -- does not exist as a 'CapMonsterErrorCode' yet.+ --+ -- This error holds the error code, followed by its description.+ UnknownResponseError Text Text+ | -- |+ -- An unknown error occurred. Check the message for more details.+ --+ -- This should never occur. Please report this issue on github if this happens to you.+ UnknownError Text+ | -- | An error when sending the http request.+ NetworkError HttpException+ | -- | The captcha took to long to solve and was timed out.+ TimeoutError+ deriving (Show, Exception)++-- | An error code returned by the CapMonster API.+data CapMonsterErrorCode+ = -- | The provided API key does not exist.+ KeyDoesNotExist+ | -- | The size of the captcha must be 100 bytes or larger.+ ZeroCaptchaFileSize+ | -- | The size of the captcha must be less than 50,000 bytes.+ TooBigFileSize+ | -- | Your CapMonster balance is empty.+ ZeroBalance+ | -- | Requests from your current API key is not allowed from your ip.+ IpNotAllowed+ | -- | The captcha cannot be solved. Perhaps it's a corrupted image, or contains too much noise?+ CaptchaUnsolvable+ | -- | The captcha id does not exist. Is the captcha older than 5 minutes?+ InvalidCaptchaId+ | -- | The captcha has not been solved yet.+ CaptchaNotReady+ | -- | You have sent too many requests with an incorrect API key. Try again later.+ IpBanned+ | -- |+ -- The requested method does not exist. You should not ever have to see this error as a user.+ -- If this is ever seen, please open an issue: https://github.com/qwbarch/captcha-haskell/issues+ NoSuchMethod+ | -- | You are being rate limited. Try not to request the result of a captcha more than 1 time per 2 seconds.+ TooManyRequests+ | -- | The specified domain cannot be solved by CapMonster.+ DomainNotAllowed+ | -- | The captcha could not be solved due to no available captcha workers.+ NoSlotAvailable+ deriving (Show, Eq, Ord, Enum, Bounded)++-- | Textual representation of a 'CapMonsterErrorCode'.+errorCode :: CapMonsterErrorCode -> Text+errorCode = \case+ KeyDoesNotExist -> "ERROR_KEY_DOES_NOT_EXIST"+ ZeroCaptchaFileSize -> "ERROR_ZERO_CAPTCHA_FILESIZE"+ TooBigFileSize -> "ERROR_TOO_BIG_CAPTCHA_FILESIZE"+ ZeroBalance -> "ERROR_ZERO_BALANCE"+ IpNotAllowed -> "ERROR_IP_NOT_ALLOWED"+ CaptchaUnsolvable -> "ERROR_CAPTCHA_UNSOLVABLE"+ InvalidCaptchaId -> "ERROR_NO_SUCH_CAPCHA_ID"+ CaptchaNotReady -> "CAPTCHA_NOT_READY"+ IpBanned -> "ERROR_IP_BANNED"+ NoSuchMethod -> "ERROR_NO_SUCH_METHOD"+ TooManyRequests -> "ERROR_TOO_MUCH_REQUESTS"+ DomainNotAllowed -> "ERROR_DOMAIN_NOT_ALLOWED"+ NoSlotAvailable -> "ERROR_NO_SLOT_AVAILABLE"++-- | Parse an error code into its equivalent 'CapMonsterErrorCode'.+parseError :: Text -> Maybe CapMonsterErrorCode+parseError code = find ((== code) . errorCode) [minBound .. maxBound]
+ src/Captcha/CapMonster/Internal/Types/FunCaptcha.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- |+-- Module: Captcha.CapMonster.Internal.Types.FunCaptcha+-- Copyright: (c) 2022 Edward Yang+-- License: MIT+--+-- This module is for internal-use and does not follow pvp versioning policies.+module Captcha.CapMonster.Internal.Types.FunCaptcha where++import Captcha.CapMonster.Internal (CapMonster)+import Captcha.Internal (getProxyAddress, getProxyPassword, getProxyPort, getProxyType, getProxyUsername, renderCookies)+import Captcha.Internal.Monad (HasCaptchaEnv)+import Captcha.Internal.Monad.Class (CaptchaRequest (request), CaptchaResponse (parseResult))+import Captcha.Internal.Request (post)+import Captcha.Internal.Types (FunCaptcha, HasApiKey (apiKey), HasCaptchaKey (captchaKey), HasCaptchaUrl (captchaUrl), HasProxy (proxy), HasServiceUrl (serviceUrl), HasUserAgent (userAgent))+import Control.Lens (preview, (^.))+import Control.Monad.Cont (MonadIO)+import Control.Monad.Reader (MonadReader)+import Data.Aeson.Lens (key)+import Data.Aeson.QQ (aesonQQ)+import Data.Text (Text, toLower)+import Network.Wreq (defaults)++instance (HasCaptchaEnv r, MonadReader r m, MonadIO m) => CaptchaRequest CapMonster FunCaptcha r m where+ request captcha = flip (post defaults) payload+ where+ payload =+ [aesonQQ|+ { + clientKey: #{captcha ^. apiKey},+ task: {+ type: #{("FunCaptchaTask" :: Text) <> maybe "Proxyless" (const mempty) (captcha ^. proxy)},+ websiteURL: #{captcha ^. captchaUrl},+ websitePublicKey: #{captcha ^. captchaKey},+ funcaptchaApiJSSubdomain: #{captcha ^. serviceUrl},+ userAgent: #{captcha ^. userAgent},+ proxyType: #{toLower <$> getProxyType captcha},+ proxyAddress: #{getProxyAddress captcha},+ proxyPort: #{getProxyPort captcha},+ proxyLogin: #{getProxyUsername captcha},+ proxyPassword: #{getProxyPassword captcha},+ cookies: #{renderCookies captcha}+ }+ } |]++instance CaptchaResponse CapMonster FunCaptcha where+ parseResult = preview $ key "solution" . key "token"
+ src/Captcha/CapMonster/Internal/Types/HCaptcha.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- |+-- Module: Captcha.CapMonster.Internal.Types.HCaptcha+-- Copyright: (c) 2022 Edward Yang+-- License: MIT+--+-- This module is for internal-use and does not follow pvp versioning policies.+module Captcha.CapMonster.Internal.Types.HCaptcha where++import Captcha.CapMonster.Internal (CapMonster)+import Captcha.Internal (getProxyAddress, getProxyPassword, getProxyPort, getProxyType, getProxyUsername, renderCookies)+import Captcha.Internal.Monad (HasCaptchaEnv)+import Captcha.Internal.Monad.Class (CaptchaRequest (request), CaptchaResponse (parseResult))+import Captcha.Internal.Request (post)+import Captcha.Internal.Types (HCaptcha, HasApiKey (apiKey), HasCaptchaKey (captchaKey), HasCaptchaUrl (captchaUrl), HasInvisible (invisible), HasProxy (proxy), HasRqData (rqData), HasUserAgent (userAgent))+import Control.Lens (preview, (^.))+import Control.Monad.Cont (MonadIO)+import Control.Monad.Reader (MonadReader)+import Data.Aeson.Lens (key)+import Data.Aeson.QQ (aesonQQ)+import Data.Text (Text, toLower)+import Network.Wreq (defaults)++instance (HasCaptchaEnv r, MonadReader r m, MonadIO m) => CaptchaRequest CapMonster HCaptcha r m where+ request captcha = flip (post defaults) payload+ where+ payload =+ [aesonQQ|+ {+ clientKey: #{captcha ^. apiKey},+ task: {+ type: #{("HCaptchaTask" :: Text) <> maybe "Proxyless" (const mempty) (captcha ^. proxy)},+ websiteURL: #{captcha ^. captchaUrl},+ websiteKey: #{captcha ^. captchaKey},+ isInvisible: #{show $ captcha ^. invisible},+ data: #{captcha ^. rqData},+ proxyType: #{toLower <$> getProxyType captcha},+ proxyAddress: #{getProxyAddress captcha},+ proxyPort: #{getProxyPort captcha},+ proxyLogin: #{getProxyUsername captcha},+ proxyPassword: #{getProxyPassword captcha},+ cookies: #{renderCookies captcha},+ userAgent: #{captcha ^. userAgent}+ }+ }+ |]++instance CaptchaResponse CapMonster HCaptcha where+ parseResult = preview $ key "solution" . key "gRecaptchaResponse"
+ src/Captcha/CapMonster/Internal/Types/Image.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- |+-- Module: Captcha.CapMonster.Internal.Types.Image+-- Copyright: (c) 2022 Edward Yang+-- License: MIT+--+-- This module is for internal-use and does not follow pvp versioning policies.+module Captcha.CapMonster.Internal.Types.Image where++import Captcha.CapMonster.Internal (CapMonster)+import Captcha.Internal.Monad (HasCaptchaEnv)+import Captcha.Internal.Monad.Class (CaptchaRequest (request), CaptchaResponse (parseResult))+import Captcha.Internal.Request (post)+import Captcha.Internal.Types (HasApiKey (apiKey), HasBody (body), ImageCaptcha)+import Control.Lens (preview, (^.))+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Reader (MonadReader)+import Data.Aeson.Lens (key)+import Data.Aeson.QQ (aesonQQ)+import Network.Wreq (defaults)++instance (HasCaptchaEnv r, MonadReader r m, MonadIO m) => CaptchaRequest CapMonster ImageCaptcha r m where+ request captcha = flip (post defaults) payload+ where+ payload =+ [aesonQQ|+ {+ clientKey: #{captcha ^. apiKey},+ task: {+ type: "ImageToTextTask",+ body: #{captcha ^. body}+ }+ }+ |]++instance CaptchaResponse CapMonster ImageCaptcha where+ parseResult = preview $ key "solution" . key "text"
+ src/Captcha/CapMonster/Internal/Types/ReCaptchaV2.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- |+-- Module: Captcha.CapMonster.Internal.Types.ReCaptchaV2+-- Copyright: (c) 2022 Edward Yang+-- License: MIT+--+-- This module is for internal-use and does not follow pvp versioning policies.+module Captcha.CapMonster.Internal.Types.ReCaptchaV2 where++import Captcha.CapMonster.Internal (CapMonster)+import Captcha.Internal (getProxyAddress, getProxyPassword, getProxyPort, getProxyType, getProxyUsername, renderCookies)+import Captcha.Internal.Monad (HasCaptchaEnv)+import Captcha.Internal.Monad.Class (CaptchaRequest (request), CaptchaResponse (parseResult))+import Captcha.Internal.Request (post)+import Captcha.Internal.Types (HasApiKey (apiKey), HasCaptchaKey (captchaKey), HasCaptchaUrl (captchaUrl), HasDataS (dataS), HasProxy (proxy), HasUserAgent (userAgent), ReCaptchaV2)+import Control.Lens (preview, (^.))+import Control.Monad.Cont (MonadIO)+import Control.Monad.Reader (MonadReader)+import Data.Aeson.Lens (key)+import Data.Aeson.QQ (aesonQQ)+import Data.Text (Text, toLower)+import Network.Wreq (defaults)++instance (HasCaptchaEnv r, MonadReader r m, MonadIO m) => CaptchaRequest CapMonster ReCaptchaV2 r m where+ request captcha = flip (post defaults) payload+ where+ payload =+ [aesonQQ|+ { + clientKey: #{captcha ^. apiKey},+ task: {+ type: #{("NoCaptchaTask" :: Text) <> maybe "Proxyless" (const mempty) (captcha ^. proxy)},+ websiteURL: #{captcha ^. captchaUrl},+ websiteKey: #{captcha ^. captchaKey},+ recaptchaDataSValue: #{captcha ^. dataS},+ userAgent: #{captcha ^. userAgent},+ proxyType: #{toLower <$> getProxyType captcha},+ proxyAddress: #{getProxyAddress captcha},+ proxyPort: #{getProxyPort captcha},+ proxyLogin: #{getProxyUsername captcha},+ proxyPassword: #{getProxyPassword captcha},+ cookies: #{renderCookies captcha}+ }+ }+ |]++instance CaptchaResponse CapMonster ReCaptchaV2 where+ parseResult = preview $ key "solution" . key "gRecaptchaResponse"
+ src/Captcha/CapMonster/Internal/Types/ReCaptchaV3.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- |+-- Module: Captcha.CapMonster.Internal.Types.ReCaptchaV3+-- Copyright: (c) 2022 Edward Yang+-- License: MIT+--+-- This module is for internal-use and does not follow pvp versioning policies.+module Captcha.CapMonster.Internal.Types.ReCaptchaV3 where++import Captcha.CapMonster.Internal (CapMonster)+import Captcha.Internal.Monad (HasCaptchaEnv)+import Captcha.Internal.Monad.Class (CaptchaRequest (request), CaptchaResponse (parseResult))+import Captcha.Internal.Request (post)+import Captcha.Internal.Types (HasAction (action), HasApiKey (apiKey), HasCaptchaKey (captchaKey), HasCaptchaUrl (captchaUrl), HasMinScore (minScore), ReCaptchaV3)+import Control.Lens (preview, (^.))+import Control.Monad.Cont (MonadIO)+import Control.Monad.Reader (MonadReader)+import Data.Aeson.Lens (key)+import Data.Aeson.QQ (aesonQQ)+import Network.Wreq (defaults)++instance (HasCaptchaEnv r, MonadReader r m, MonadIO m) => CaptchaRequest CapMonster ReCaptchaV3 r m where+ request captcha = flip (post defaults) payload+ where+ payload =+ [aesonQQ|+ {+ clientKey: #{captcha ^. apiKey},+ task: {+ type: "RecaptchaV3TaskProxyless",+ websiteURL: #{captcha ^. captchaUrl},+ websiteKey: #{captcha ^. captchaKey},+ minScore: #{captcha ^. minScore},+ pageAction: #{captcha ^. action}+ }+ }+ |]++instance CaptchaResponse CapMonster ReCaptchaV3 where+ parseResult = preview $ key "solution" . key "gRecaptchaResponse"
+ test/Captcha/CapMonster.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TypeApplications #-}++module Captcha.CapMonster where++import Captcha.CapMonster.Internal (CapMonster)+import Captcha.CapMonster.Internal.Error (CapMonsterError (CapMonsterResponseError, TimeoutError), CapMonsterErrorCode (NoSlotAvailable))+import Captcha.CapMonster.Internal.Types.Image ()+import Captcha.Internal.Monad (Captcha (runCaptcha), CaptchaEnv, mkCaptchaEnv)+import Captcha.Internal.Monad.Class (CaptchaRequest, CaptchaResponse, MonadCaptcha (solve))+import Captcha.Internal.Types (HasApiKey, HasPollingInterval, HasTimeoutDuration (timeoutDuration), ImageCaptcha)+import Control.Lens ((?~))+import Data.Default (Default (def))+import Data.Function ((&))+import Data.Text (Text)+import Test.Tasty (TestTree)+import Test.Tasty.HUnit (assertFailure, testCase)+import Time (Millisecond, Time (Time))++type ApiKey = Text++assertCaptcha ::+ ( CaptchaRequest CapMonster ctx CaptchaEnv Captcha,+ CaptchaResponse CapMonster ctx,+ HasApiKey ctx Text,+ HasPollingInterval ctx (Maybe (Time Millisecond)),+ HasTimeoutDuration ctx (Maybe (Time Millisecond))+ ) =>+ ctx ->+ IO ()+assertCaptcha captcha =+ mkCaptchaEnv >>= runCaptcha (solve @CapMonster captcha) >>= \case+ Left (CapMonsterResponseError NoSlotAvailable) -> pure ()+ Right _ -> pure ()+ Left exception -> assertFailure $ show exception++testTimeout :: TestTree+testTimeout =+ testCase "Captcha Timeout" $ do+ let captcha = def @ImageCaptcha & timeoutDuration ?~ Time @Millisecond 0+ mkCaptchaEnv >>= runCaptcha (solve @CapMonster captcha) >>= \case+ Left TimeoutError -> pure ()+ Left exception -> assertFailure $ show exception+ Right _ -> assertFailure "Captcha did not timeout."
+ test/Captcha/CapMonster/Test/FunCaptcha.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Captcha.CapMonster.Test.FunCaptcha where++import Captcha.CapMonster (ApiKey, assertCaptcha)+import Captcha.CapMonster.Internal.Types.FunCaptcha ()+import Captcha.Internal.Types (FunCaptcha, HasApiKey (apiKey), HasCaptchaKey (captchaKey), HasCaptchaUrl (captchaUrl))+import Control.Lens ((&), (.~))+import Data.Default (Default (def))+import Test.Tasty (TestTree)+import Test.Tasty.HUnit (testCase)++test :: ApiKey -> TestTree+test key = do+ testCase "FunCaptcha" $+ let captcha =+ def @FunCaptcha+ & apiKey .~ key+ & captchaUrl .~ "https://api.funcaptcha.com/fc/api/nojs"+ & captchaKey .~ "69A21A01-CC7B-B9C6-0F9A-E7FA06677FFC"+ in assertCaptcha captcha
+ test/Captcha/CapMonster/Test/HCaptcha.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Captcha.CapMonster.Test.HCaptcha where++import Captcha.CapMonster (ApiKey, assertCaptcha)+import Captcha.CapMonster.Internal.Types.HCaptcha ()+import Captcha.Internal.Types (HCaptcha, HasApiKey (apiKey), HasCaptchaKey (captchaKey), HasCaptchaUrl (captchaUrl))+import Control.Lens ((&), (.~))+import Data.Default (Default (def))+import Test.Tasty (TestTree)+import Test.Tasty.HUnit (testCase)++test :: ApiKey -> TestTree+test key =+ testCase "HCaptcha" $+ let captcha =+ def @HCaptcha+ & apiKey .~ key+ & captchaUrl .~ "https://2captcha.com/demo/hcaptcha"+ & captchaKey .~ "3ceb8624-1970-4e6b-91d5-70317b70b651"+ in assertCaptcha captcha
+ test/Captcha/CapMonster/Test/Image.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Captcha.CapMonster.Test.Image where++import Captcha.CapMonster (ApiKey, assertCaptcha)+import Captcha.CapMonster.Internal.Types.Image ()+import Captcha.Internal.Types (HasApiKey (apiKey), HasBody (body), ImageCaptcha)+import Control.Lens ((&), (.~))+import Data.Default (Default (def))+import Data.String.Conversions (cs)+import Test.Tasty (TestTree)+import Test.Tasty.HUnit (testCase)++test :: ApiKey -> TestTree+test key =+ testCase "Image Captcha" $ do+ -- Captcha image: Td4eva+ captchaBody <- cs <$> readFile "../assets/image-captcha.txt"+ let captcha =+ def @ImageCaptcha+ & apiKey .~ key+ & body .~ captchaBody+ assertCaptcha captcha
+ test/Captcha/CapMonster/Test/ReCaptchaV2.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Captcha.CapMonster.Test.ReCaptchaV2 where++import Captcha.CapMonster (ApiKey, assertCaptcha)+import Captcha.CapMonster.Internal.Types.ReCaptchaV2 ()+import Captcha.Internal.Types (HasApiKey (apiKey), HasCaptchaKey (captchaKey), HasCaptchaUrl (captchaUrl), ReCaptchaV2)+import Control.Lens ((&), (.~))+import Data.Default (Default (def))+import Test.Tasty (TestTree)+import Test.Tasty.HUnit (testCase)++test :: ApiKey -> TestTree+test key =+ testCase "ReCaptchaV2" $+ let captcha =+ def @ReCaptchaV2+ & apiKey .~ key+ & captchaUrl .~ "https://2captcha.com/demo/recaptcha-v2"+ & captchaKey .~ "6LfD3PIbAAAAAJs_eEHvoOl75_83eXSqpPSRFJ_u"+ in assertCaptcha captcha
+ test/Captcha/CapMonster/Test/ReCaptchaV3.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Captcha.CapMonster.Test.ReCaptchaV3 where++import Captcha.CapMonster (ApiKey, assertCaptcha)+import Captcha.CapMonster.Internal.Types.ReCaptchaV3 ()+import Captcha.Internal.Types (HasApiKey (apiKey), HasCaptchaKey (captchaKey), HasCaptchaUrl (captchaUrl), ReCaptchaV3)+import Control.Lens ((&), (.~))+import Data.Default (Default (def))+import Test.Tasty (TestTree)+import Test.Tasty.HUnit (testCase)++test :: ApiKey -> TestTree+test key =+ testCase "ReCaptchaV3" $+ let captcha =+ def @ReCaptchaV3+ & apiKey .~ key+ & captchaUrl .~ "https://2captcha.com/demo/recaptcha-v3"+ & captchaKey .~ "6LfB5_IbAAAAAMCtsjEHEHKqcB9iQocwwxTiihJu"+ in assertCaptcha captcha
+ test/Main.hs view
@@ -0,0 +1,23 @@+import qualified Captcha.CapMonster as CapMonster+import qualified Captcha.CapMonster.Test.FunCaptcha as FunCaptcha+import qualified Captcha.CapMonster.Test.HCaptcha as HCaptcha+import qualified Captcha.CapMonster.Test.Image as ImageCaptcha+import qualified Captcha.CapMonster.Test.ReCaptchaV2 as ReCaptchaV2+import qualified Captcha.CapMonster.Test.ReCaptchaV3 as ReCaptchaV3+import Data.String.Conversions (cs)+import System.Environment (getEnv)+import Test.Tasty (defaultMain, testGroup)++main :: IO ()+main = defaultMain . tests . cs =<< getEnv "CAPMONSTER_API_KEY"+ where+ tests apiKey =+ testGroup+ "CapMonster"+ [ CapMonster.testTimeout,+ ImageCaptcha.test apiKey,+ ReCaptchaV2.test apiKey,+ ReCaptchaV3.test apiKey,+ FunCaptcha.test apiKey,+ HCaptcha.test apiKey+ ]