Use openssl

This commit is contained in:
Akshay Mankar 2023-11-08 09:55:48 +01:00
parent cb8ad94ad0
commit 6c41b4ba4f
Signed by: axeman
GPG key ID: CA08F3AB62369B89
3 changed files with 29 additions and 21 deletions

View file

@ -7,7 +7,7 @@
module Main where module Main where
import Control.Lens (view) import Control.Lens (view, (&), (.~))
import Control.Monad (when) import Control.Monad (when)
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Data.Aeson hiding (Options) import Data.Aeson hiding (Options)
@ -19,20 +19,25 @@ import Data.Text.Encoding qualified as Text
import Data.Text.IO qualified as Text import Data.Text.IO qualified as Text
import Database.SQLite.Simple import Database.SQLite.Simple
import GHC.Generics import GHC.Generics
import Network.HTTP.Client.OpenSSL
import Network.Wreq hiding (Options) import Network.Wreq hiding (Options)
import Options.Generic import Options.Generic
import Servant.Client (mkClientEnv)
import System.Exit (exitFailure) import System.Exit (exitFailure)
import Telegram.Bot.API import Telegram.Bot.API
import Telegram.Bot.Simple import Telegram.Bot.Simple
import Telegram.Bot.Simple.Debug import Telegram.Bot.Simple.Debug
import Text.HTML.Scalpel import Text.HTML.Scalpel
import qualified Network.Wreq as Wreq
main :: IO () main :: IO ()
main = do main = withOpenSSL $ do
opts <- unwrapRecord "Berlin Scrapper" opts <- unwrapRecord "Berlin Scrapper"
token <- getEnvToken "TELEGRAM_BOT_TOKEN" token <- getEnvToken "TELEGRAM_BOT_TOKEN"
clientEnv <- defaultTelegramClientEnv token httpMgr <- newOpenSSLManager
startBot (traceBotDefault $ botApp opts) clientEnv >>= \case let clientEnv = mkClientEnv httpMgr (botBaseUrl token)
wreqOpts = Wreq.defaults & Wreq.manager .~ Right httpMgr
startBot (traceBotDefault $ botApp opts wreqOpts) clientEnv >>= \case
Left err -> do Left err -> do
putStrLn $ "Bot failed with: " <> show err putStrLn $ "Bot failed with: " <> show err
exitFailure exitFailure
@ -70,8 +75,8 @@ instance FromJSON IBWResponse
-- * Parsing -- * Parsing
queryIBW :: IO IBWResponse queryIBW :: Wreq.Options -> IO IBWResponse
queryIBW = do queryIBW wreqOpts = do
let reqBody = let reqBody =
[ partText "q" "wf-save-srch", [ partText "q" "wf-save-srch",
partText "save" "false", partText "save" "false",
@ -107,7 +112,7 @@ queryIBW = do
partText "bez[]" "11_00" partText "bez[]" "11_00"
] ]
let link = "https://inberlinwohnen.de/wp-content/themes/ibw/skript/wohnungsfinder.php" let link = "https://inberlinwohnen.de/wp-content/themes/ibw/skript/wohnungsfinder.php"
resBS <- view responseBody <$> post link reqBody resBS <- view responseBody <$> postWith wreqOpts link reqBody
pure $ fromJust $ decode @IBWResponse resBS pure $ fromJust $ decode @IBWResponse resBS
scrapeOffers :: Scraper Text [Offer] scrapeOffers :: Scraper Text [Offer]
@ -169,13 +174,13 @@ type Model = ()
newtype Action = StartChat Chat newtype Action = StartChat Chat
deriving (Show) deriving (Show)
botApp :: Options Unwrapped -> BotApp Model Action botApp :: Options Unwrapped -> Wreq.Options -> BotApp Model Action
botApp opts = botApp opts wreqOpts =
BotApp BotApp
{ botInitialModel = (), { botInitialModel = (),
botAction = action, botAction = action,
botHandler = handler, botHandler = handler,
botJobs = [scrapeJob opts] botJobs = [scrapeJob opts wreqOpts]
} }
action :: Update -> Model -> Maybe Action action :: Update -> Model -> Maybe Action
@ -191,18 +196,18 @@ handler (StartChat chat) model =
model <# do model <# do
liftIO $ putStrLn $ "Chat started! " <> ppAsJSON chat liftIO $ putStrLn $ "Chat started! " <> ppAsJSON chat
scrapeJob :: Options Unwrapped -> BotJob Model Action scrapeJob :: Options Unwrapped -> Wreq.Options -> BotJob Model Action
scrapeJob opts = scrapeJob opts wreqOpts =
BotJob BotJob
{ botJobSchedule = "* * * * *", { botJobSchedule = "* * * * *",
botJobTask = scrapeJobTask opts botJobTask = scrapeJobTask opts wreqOpts
} }
scrapeJobTask :: Options Unwrapped -> Model -> Eff Action Model scrapeJobTask :: Options Unwrapped -> Wreq.Options -> Model -> Eff Action Model
scrapeJobTask opts m = scrapeJobTask opts wreqOpts m =
m <# do m <# do
liftIO $ putStrLn "Starting scrape job" liftIO $ putStrLn "Starting scrape job"
res <- liftIO queryIBW res <- liftIO $ queryIBW wreqOpts
let offers = fromJust $ scrapeStringLike res.searchresults scrapeOffers let offers = fromJust $ scrapeStringLike res.searchresults scrapeOffers
liftIO $ putStrLn "Fetched offers" liftIO $ putStrLn "Fetched offers"
conn <- liftIO $ open (dbFile opts) conn <- liftIO $ open (dbFile opts)

View file

@ -25,6 +25,8 @@ executable berlin-scraper
, optparse-generic , optparse-generic
, telegram-bot-simple , telegram-bot-simple
, telegram-bot-api , telegram-bot-api
, servant-client
, http-client-openssl
, bytestring , bytestring
hs-source-dirs: app hs-source-dirs: app
default-language: GHC2021 default-language: GHC2021

View file

@ -1,6 +1,6 @@
{ mkDerivation, aeson, base, bytestring, lens, lib { mkDerivation, aeson, base, bytestring, http-client-openssl, lens
, optparse-generic, scalpel, sqlite-simple, telegram-bot-api , lib, optparse-generic, scalpel, servant-client, sqlite-simple
, telegram-bot-simple, text, wreq , telegram-bot-api, telegram-bot-simple, text, wreq
}: }:
mkDerivation { mkDerivation {
pname = "berlin-scraper"; pname = "berlin-scraper";
@ -9,8 +9,9 @@ mkDerivation {
isLibrary = false; isLibrary = false;
isExecutable = true; isExecutable = true;
executableHaskellDepends = [ executableHaskellDepends = [
aeson base bytestring lens optparse-generic scalpel sqlite-simple aeson base bytestring http-client-openssl lens optparse-generic
telegram-bot-api telegram-bot-simple text wreq scalpel servant-client sqlite-simple telegram-bot-api
telegram-bot-simple text wreq
]; ];
license = lib.licenses.agpl3Plus; license = lib.licenses.agpl3Plus;
mainProgram = "berlin-scraper"; mainProgram = "berlin-scraper";