{-# LANGUAGE DataKinds #-} {-# LANGUAGE GHC2021 #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wall #-} module Main where import Control.Monad (replicateM) import Data.ByteString qualified as ByteString import Data.List qualified as List import MyPrelude import Network.HTTP.Conduit qualified as Client import Network.HTTP.Simple qualified as Client import Pretty import System.Exit qualified as Exit import System.Random qualified as Random import System.Random.Stateful qualified as Random import Prelude hiding (log) import Data.Aeson (Value) import Label import qualified System.Process as Proc import qualified Data.ByteString.Char8 as Char8 secret :: IO (T2 "email" ByteString "password" ByteString) secret = do T2 (label @"email" "mail@profpatsch.de") <$> (label @"password" <$> fromPass "email/mailbox.org" ) where fromPass name = Proc.readProcess "pass" [name] "" <&> stringToText <&> textToBytesUtf8 <&> Char8.strip main :: IO () main = run =<< secret run :: (HasField "email" dat ByteString, HasField "password" dat ByteString) => dat -> IO () run dat = do session <- login dat req <- Client.parseRequest "https://office.mailbox.org/appsuite/api/mailfilter/v2?action=list&columns=1" <&> Client.setRequestMethod "PUT" <&> addSession session Client.httpJSON @_ @Value req >>= okOrDie <&> Client.responseBody >>= printPretty newtype Session = Session Client.CookieJar addSession :: Session -> Client.Request -> Client.Request addSession (Session jar) req = do let sessionId = jar & Client.destroyCookieJar & List.find (\c -> "open-xchange-session-" `ByteString.isPrefixOf` c.cookie_name) & annotate "The cookie jar did not contain an open-exchange-session-*" & unwrapError & (.cookie_value) (req & Client.addToRequestQueryString [("session", Just sessionId)]) { Client.cookieJar = Just jar } -- | Log into the mailbox.org service, and return the session secret cookies. login :: (HasField "email" dat ByteString, HasField "password" dat ByteString) => dat -> IO Session login dat = do rnd <- randomString req <- Client.parseRequest "https://office.mailbox.org/ajax/login" <&> Client.setQueryString [ ("action", Just "formlogin"), ("authId", Just $ ("mbo-" <> rnd) & stringToText & textToBytesUtf8) ] <&> Client.urlEncodedBody [ ("version", "Form+Login"), ("autologin", "true"), ("client", "open-xchange-appsuite"), ("uiWebPath", "/appsuite/"), ("login", dat.email), ("password", dat.password) ] Client.httpNoBody req >>= okOrDie <&> Client.responseCookieJar <&> Session where -- For some reason they want the client to pass a random string -- which is used for the session?‽!? randomString = do gen <- Random.newIOGenM =<< Random.newStdGen let chars = ['a' .. 'z'] <> ['A' .. 'Z'] <> ['0' .. '9'] let len = 11 Random.uniformRM (0, List.length chars - 1) gen & replicateM len <&> map (\index -> chars !! index) okOrDie :: Show a => Client.Response a -> IO (Client.Response a) okOrDie resp = case resp & Client.getResponseStatusCode of 200 -> pure resp _ -> do printPretty resp Exit.die "non-200 result"