1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
{-# 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"
|
