HaskerDeux

Check-in [76a89c1a9b]
Login
Home Timeline Branches Tags Tickets Wiki

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Handle automatic re-login on each separate curl call

I.e. rather than check the validity of the token each time by making a
curl call to get a list of todos (whatever action is being performed)
just assume the token is valid and wait for the actual action to fail.
Relogin at that point and re-call that action.

It's still messy, but I think this approach is right - it'll just be my
implementation of it that lets the side down.

Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | origin/issue1 | trunk | master
Files: files | file ages | folders
SHA3-256: 76a89c1a9bdfb7f3df1ac871310da3420d1603816a5cdeb14531a308dbf05300
User & Date: base@atomicules.co.uk 2017-10-29 17:10:37
Context
2019-02-08
12:52
Add comment for future list usage support check-in: 0fe877fd3b user: atomicules tags: master, origin/issue1, trunk
2017-10-29
17:10
Handle automatic re-login on each separate curl call

I.e. rather than check the validity of the token each time by making a
curl call to get a list of todos (whatever action is being performed)
just assume the token is valid and wait for the actual action to fail.
Relogin at that point and re-call that action.

It's still messy, but I think this approach is right - it'll just be my
implementation of it that lets the side down. check-in: 76a89c1a9b user: base@atomicules.co.uk tags: master, origin/issue1, trunk

2017-10-22
10:56
Sort out markup in README check-in: a393b4c91b user: base@atomicules.co.uk tags: master, origin/issue1, trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to haskerdeux.hs.

︙︙
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
113
114
115
116
117


118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144







145
146
147
148
149
150
151

	time <- getClockTime >>= toCalendarTime --https://wiki.haskell.org/Unix_tools/Date
	let todays_date = formatCalendarTime defaultTimeLocale "%Y-%m-%d" time
	let tomorrows_date = show (addDays 1 $ read todays_date::Data.Time.Day)
	let  todos_date | date == "today" = todays_date
	                | date == "tomorrow" = tomorrows_date
	                | otherwise = date
	when ((command `elem` ["todos"] && Data.List.null argList) || (command `elem` ["new", "crossoff", "putoff", "delete"] && length argList == 1) || (command == "moveto" && length argList == 2)) $ do
		username <- fmap fst readnetrc
		password <- fmap snd readnetrc
		token <- login [username, password]
		dispatch command (token, todos_date:argList)


readnetrc = do
	home <- getHomeDirectory
	netrc <- lines Control.Applicative.<$> readFile (home ++ "/.netrc")
	let netrc' = dropWhile (not . ("teuxdeux" `isInfixOf`)) netrc
	let (username, password) = if "login" `isInfixOf` head netrc'
		-- if entry is on one line	
		then (getcred "login", getcred "password") 
		-- if entry is on multiple lines
		else (last $ words $ netrc' !! 1, last $ words $ netrc' !! 2)
		where getcred c = dropWhile (not . (c `isInfixOf`)) (words $ head netrc') !! 1
	return (username, password)


curlget (token, date) = do
	let curlheader = "X-CSRF-Token: " ++ token
	body <- readProcess "curl" ["-s", "-L", "-c", "haskerdeux.cookies", "-b", "haskerdeux.cookies", "-H", curlheader, "https://teuxdeux.com/api/v1/todos/calendar?begin_date="++date++"&end_date="++date] []



	let tds = decodeJSON body :: [Teuxdeux]
	let tdsf = Data.List.filter (\td -> current_date td == date && not (done td)) tds
	return tdsf



	

curlpost (token, [date, key, value, apiurl, okresponse]) number = do
	let curlheader = "X-CSRF-Token: " ++ token
	--Can be much improved, but will do for now:
	json <- if isJust number
		then do
			tdsf <- curlget (token, date)
			let itemid = Main.id $ tdsf!!(read (fromJust number)::Int)
			let modjson = "{ \"ids\" : [\""++show itemid++"\"], \""++key++"\" : \""++value++"\"}"
			return modjson
		else do
			--Can't just straight return these strings, need to let them first
			let newjson = "{ \"current_date\" : \""++date++"\", \""++key++"\" : \""++value++"\"}"
			return newjson
	body <- readProcess "curl" ["-s", "-XPOST", apiurl, "-L", "-c", "haskerdeux.cookies", "-b", "haskerdeux.cookies", "-H", curlheader, "-H", "Content-Type: application/json", "-d", json] []



	if "done_updated_at" `isInfixOf` body
		then putStrLn okresponse
		else putStrLn "Uh Oh! Didn't work!"





curldelete (token, [date, apiurl, okresponse]) number = do
	tdsf <- curlget (token, date)
	let itemid = Main.id $ tdsf!!(read number::Int)
	let curlheader = "X-CSRF-Token: " ++ token
	body <- readProcess "curl" ["-s", "-XDELETE", apiurl++show itemid, "-c", "haskerdeux.cookies", "-b", "haskerdeux.cookies", "-H", curlheader] []



	if "done_updated_at" `isInfixOf` body
		then putStrLn okresponse
		else putStrLn "Uh Oh! Didn't work!"





curlput (token, [date, json, apiurl, okresponse]) number = do
	tdsf <- curlget (token, date)
	let itemid = Main.id $ tdsf!!(read number::Int)
	let curlheader = "X-CSRF-Token: " ++ token
	body <- readProcess "curl" ["-s", "-XPUT", apiurl++show itemid, "-L", "-c", "haskerdeux.cookies", "-b", "haskerdeux.cookies", "-H", curlheader, "-H", "Content-Type: application/json", "-d", json] []



	if "done_updated_at" `isInfixOf` body
		then putStrLn okresponse
		else putStrLn "Uh Oh! Didn't work!"





getauthtoken body = do
	let bodylines = lines body
	let authline = dropWhile (not . ("authenticity_token" `isInfixOf`)) bodylines
	let authwords = words $ head authline
	let authtokenword = stripPrefix "value=\"" $ last authwords
	let revauthtokenword = reverse $ fromJust authtokenword
	let authtoken = reverse $ fromJust $ stripPrefix ">\"" revauthtokenword
	return authtoken


login [username, password] = do


	home <- getHomeDirectory
	savedtoken <- doesFileExist (home ++ "/.haskerdeux-token")
	--Need to make a query here and check token is still valid
	--I am aware this is horribly unhaskelly and I plan on sorting that.
	if savedtoken
		then do
			token <- readFile (home ++ "/.haskerdeux-token")
			time <- getClockTime >>= toCalendarTime --https://wiki.haskell.org/Unix_tools/Date
			let date = formatCalendarTime defaultTimeLocale "%Y-%m-%d" time
			let curlheader = "X-CSRF-Token: " ++ token
			body <- readProcess "curl" ["-s", "-L", "-c", "haskerdeux.cookies", "-b", "haskerdeux.cookies", "-H", curlheader, "https://teuxdeux.com/api/v1/todos/calendar?begin_date="++date++"&end_date="++date] []
			let ok = not ("Invalid CSRF Token" `isInfixOf` body)
			if ok
				then
					return token
				else do
					removeFile (home ++ "/.haskerdeux-token")
					login [username, password]
		else do
			body <- readProcess "curl" ["-s", "-L", "-c", "haskerdeux.cookies", "https://teuxdeux.com/login"] []
			token <- getauthtoken body
			writeFile (home ++ "/.haskerdeux-token") token
			let curlheader = "X-CSRF-Token: " ++ token
			let curlpostfields = "username=" ++ username ++ "&password=" ++ password ++ "&authenticity_token=" ++ token
			body <- readProcess "curl" ["-s", "-L", "-c", "haskerdeux.cookies", "-b", "haskerdeux.cookies", "-H", curlheader, "-d", curlpostfields, "https://teuxdeux.com/login"] []
			return token









todos (token, [todos_date]) = do
	tdsf <- curlget (token, todos_date)
	putStr $ unlines $ zipWith (\n td -> show n ++ " - " ++ td) [0..] $ Data.List.map text tdsf --numbering from LYAH


new (token, [todos_date, todo]) = do 








<
<
|



















>
>
>
|
|
|
>
>
>
















>
>
>
|
|
|
>
>
>







>
>
>
|
|
|
>
>
>







>
>
>
|
|
|
>
>
>












|
>
>


<
<



<
<
<
<
<
<
<
|
<
<
<









>
>
>
>
>
>
>








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
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143


144
145
146







147



148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170

	time <- getClockTime >>= toCalendarTime --https://wiki.haskell.org/Unix_tools/Date
	let todays_date = formatCalendarTime defaultTimeLocale "%Y-%m-%d" time
	let tomorrows_date = show (addDays 1 $ read todays_date::Data.Time.Day)
	let  todos_date | date == "today" = todays_date
	                | date == "tomorrow" = tomorrows_date
	                | otherwise = date
	when ((command `elem` ["todos"] && Data.List.null argList) || (command `elem` ["new", "crossoff", "putoff", "delete"] && length argList == 1) || (command == "moveto" && length argList == 2)) $ do


		token <- login
		dispatch command (token, todos_date:argList)


readnetrc = do
	home <- getHomeDirectory
	netrc <- lines Control.Applicative.<$> readFile (home ++ "/.netrc")
	let netrc' = dropWhile (not . ("teuxdeux" `isInfixOf`)) netrc
	let (username, password) = if "login" `isInfixOf` head netrc'
		-- if entry is on one line	
		then (getcred "login", getcred "password") 
		-- if entry is on multiple lines
		else (last $ words $ netrc' !! 1, last $ words $ netrc' !! 2)
		where getcred c = dropWhile (not . (c `isInfixOf`)) (words $ head netrc') !! 1
	return (username, password)


curlget (token, date) = do
	let curlheader = "X-CSRF-Token: " ++ token
	body <- readProcess "curl" ["-s", "-L", "-c", "haskerdeux.cookies", "-b", "haskerdeux.cookies", "-H", curlheader, "https://teuxdeux.com/api/v1/todos/calendar?begin_date="++date++"&end_date="++date] []
	let ok = not ("Invalid CSRF Token" `isInfixOf` body)
	if ok
		then do
			let tds = decodeJSON body :: [Teuxdeux]
			let tdsf = Data.List.filter (\td -> current_date td == date && not (done td)) tds
			return tdsf
		else do
			token <- relogin 
			curlget (token, date)
	

curlpost (token, [date, key, value, apiurl, okresponse]) number = do
	let curlheader = "X-CSRF-Token: " ++ token
	--Can be much improved, but will do for now:
	json <- if isJust number
		then do
			tdsf <- curlget (token, date)
			let itemid = Main.id $ tdsf!!(read (fromJust number)::Int)
			let modjson = "{ \"ids\" : [\""++show itemid++"\"], \""++key++"\" : \""++value++"\"}"
			return modjson
		else do
			--Can't just straight return these strings, need to let them first
			let newjson = "{ \"current_date\" : \""++date++"\", \""++key++"\" : \""++value++"\"}"
			return newjson
	body <- readProcess "curl" ["-s", "-XPOST", apiurl, "-L", "-c", "haskerdeux.cookies", "-b", "haskerdeux.cookies", "-H", curlheader, "-H", "Content-Type: application/json", "-d", json] []
	let ok = not ("Invalid CSRF Token" `isInfixOf` body)
	if ok
		then
			if "done_updated_at" `isInfixOf` body
				then putStrLn okresponse
				else putStrLn "Uh Oh! Didn't work!"
		else do
			token <- relogin 
			curlpost (token, [date, key, value, apiurl, okresponse]) number


curldelete (token, [date, apiurl, okresponse]) number = do
	tdsf <- curlget (token, date)
	let itemid = Main.id $ tdsf!!(read number::Int)
	let curlheader = "X-CSRF-Token: " ++ token
	body <- readProcess "curl" ["-s", "-XDELETE", apiurl++show itemid, "-c", "haskerdeux.cookies", "-b", "haskerdeux.cookies", "-H", curlheader] []
	let ok = not ("Invalid CSRF Token" `isInfixOf` body)
	if ok
		then
			if "done_updated_at" `isInfixOf` body
				then putStrLn okresponse
				else putStrLn "Uh Oh! Didn't work!"
		else do
			token <- relogin 
			curldelete (token, [date, apiurl, okresponse]) number


curlput (token, [date, json, apiurl, okresponse]) number = do
	tdsf <- curlget (token, date)
	let itemid = Main.id $ tdsf!!(read number::Int)
	let curlheader = "X-CSRF-Token: " ++ token
	body <- readProcess "curl" ["-s", "-XPUT", apiurl++show itemid, "-L", "-c", "haskerdeux.cookies", "-b", "haskerdeux.cookies", "-H", curlheader, "-H", "Content-Type: application/json", "-d", json] []
	let ok = not ("Invalid CSRF Token" `isInfixOf` body)
	if ok
		then
			if "done_updated_at" `isInfixOf` body
				then putStrLn okresponse
				else putStrLn "Uh Oh! Didn't work!"
		else do
			token <- relogin 
			curlput (token, [date, json, apiurl, okresponse]) number


getauthtoken body = do
	let bodylines = lines body
	let authline = dropWhile (not . ("authenticity_token" `isInfixOf`)) bodylines
	let authwords = words $ head authline
	let authtokenword = stripPrefix "value=\"" $ last authwords
	let revauthtokenword = reverse $ fromJust authtokenword
	let authtoken = reverse $ fromJust $ stripPrefix ">\"" revauthtokenword
	return authtoken


login  = do
	username <- fmap fst readnetrc
	password <- fmap snd readnetrc
	home <- getHomeDirectory
	savedtoken <- doesFileExist (home ++ "/.haskerdeux-token")


	if savedtoken
		then do
			token <- readFile (home ++ "/.haskerdeux-token")







			return token



		else do
			body <- readProcess "curl" ["-s", "-L", "-c", "haskerdeux.cookies", "https://teuxdeux.com/login"] []
			token <- getauthtoken body
			writeFile (home ++ "/.haskerdeux-token") token
			let curlheader = "X-CSRF-Token: " ++ token
			let curlpostfields = "username=" ++ username ++ "&password=" ++ password ++ "&authenticity_token=" ++ token
			body <- readProcess "curl" ["-s", "-L", "-c", "haskerdeux.cookies", "-b", "haskerdeux.cookies", "-H", curlheader, "-d", curlpostfields, "https://teuxdeux.com/login"] []
			return token


relogin = do
	home <- getHomeDirectory
	removeFile (home ++ "/.haskerdeux-token")
	token <- login
	return token
	

todos (token, [todos_date]) = do
	tdsf <- curlget (token, todos_date)
	putStr $ unlines $ zipWith (\n td -> show n ++ " - " ++ td) [0..] $ Data.List.map text tdsf --numbering from LYAH


new (token, [todos_date, todo]) = do
︙︙

This page was generated in about 0.009s by Fossil 2.23 [47362306a7] 2023-11-01 18:56:47