-
Notifications
You must be signed in to change notification settings - Fork 1
/
Recify.hs
126 lines (104 loc) · 5.37 KB
/
Recify.hs
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
113
114
115
116
117
118
119
120
121
122
123
124
125
126
{-# LANGUAGE OverloadedStrings #-}
module Recify where
import Web.Scotty
import Data.Default.Class (def)
import Network.Wai.Handler.Warp (setPort)
import Network.HTTP.Types (status302)
import Control.Monad.IO.Class
import qualified Data.Text.Lazy as LT
import qualified Data.Text.IO as DTIO
import qualified Data.Text as DT
import Data.Either
import System.Environment
import Utils.String
import Writers.CSV
import Writers.HTML
import Services.Spotify.Authorization
import Services.Spotify.Artist
import Services.Cookies
import Clients.Spotify.Authorization
import Clients.Spotify.RecentlyPlayed
import Types.SpotifyAuthorization
import Types.RecentlyPlayed
import Types.Artist
import qualified Types.RecentlyPlayedWithArtist as RPWA
authorizationScope = "user-read-recently-played, user-top-read"
authorizationResponseType = "code"
recify :: IO ()
recify = do
port <- fmap read $ getEnv "PORT"
fqdn <- liftIO $ getEnv "fqdn"
let scottyOptions = def { settings = setPort port $ settings def }
scottyOpts scottyOptions $ do
get "/" $ do
homeHtml <- liftIO . DTIO.readFile $ "./static/home.html"
html $ mconcat [(LT.fromStrict homeHtml)]
get "/grant" $ do
clientId <- liftIO . getEnv $ "clientID"
status status302
let location
= "https://accounts.spotify.com/authorize?client_id=" ++ clientId
++ "&response_type=" ++ authorizationResponseType
++ "&redirect_uri=" ++ fqdn
++ "/callback&scope=" ++ authorizationScope
setHeader "Location" $ LT.pack location
get "/callback" $ do
authorizationCode <- fmap AuthorizationCode $ param "code"
accessToken <- liftIO $ exchangeAccessTokenForAuthorizationCode authorizationCode fqdn
writeAccessTokenCookies accessToken
status status302
setHeader "X-Forwarded-From" "/callback"
setHeader "Location" $ LT.pack "/dashboard"
get "/csv" $ do
file <- liftIO $ readFile "./recentlyPlayed.csv"
html $ mconcat ["<pre>", LT.pack file, "</pre>"]
get "/dashboard" $ do
liftIO $ putStrLn "Accepting request for /dashboard..."
accessTokenData <- getAccessTokenFromCookies
liftIO $ putStrLn ("Got access token " ++ (show accessTokenData))
let cookie = DT.pack . LT.unpack . snd $ accessTokenData !! 0 -- need to check if anything exists in the array and die if not
liftIO $ putStrLn ("Parsed access token " ++ (show cookie))
let accessToken = textToByteString . getAccessToken . AccessToken $ cookie -- if this is empty we need to stop as authorization hasn't occoured
liftIO $ putStrLn ("Marshalled access token " ++ (show accessToken))
recentlyPlayedTrackData <- liftIO . fetchRecentlyPlayedTracks $ accessToken
liftIO $ putStrLn ("Fetched recently played tracks" ++ (show recentlyPlayedTrackData))
let maybeMarshalledRecentlyPlayed = marshallRecentlyPlayedData recentlyPlayedTrackData
liftIO $ putStrLn ("Marshalled recently played tracks" ++ (show maybeMarshalledRecentlyPlayed))
case maybeMarshalledRecentlyPlayed of
Right marshalledRecentlyPlayed -> do
maybeMarshalledArtistsData <- liftIO . getArtistData accessToken $ marshalledRecentlyPlayed
liftIO $ putStrLn "Fetched artist data"
artists <- case maybeMarshalledArtistsData of
Right marshalledArtistsData -> do
liftIO $ putStrLn "Right marshalled artist data"
return marshalledArtistsData
Left error -> do
liftIO $ putStrLn error
return [] -- TODO this needs to error, no point continuing
liftIO $ putStrLn ("Marshalled artist data" ++ (show artists))
let recentlyPlayedWithArtist = RPWA.RecentlyPlayedWithArtist {
RPWA.recentlyPlayed = RPWA.Tracks {
RPWA.tracks = fmap (\track -> RPWA.Track {
RPWA.name = name track,
RPWA.externalUrls = externalUrls track,
RPWA.explicit = explicit track,
RPWA.artists = fmap (\artist -> RPWA.Artist {
RPWA.id = Types.RecentlyPlayed.id artist,
RPWA.href = href artist,
RPWA.artistName = artistName artist,
RPWA.genres = concat . fmap Types.Artist.genres . filter (\artistToCompound -> Types.Artist.id artistToCompound == Types.RecentlyPlayed.id artist) $ artists
}) $ Types.RecentlyPlayed.artists track,
RPWA.playedAt = playedAt track
}) . Types.RecentlyPlayed.tracks . recentlyPlayed $ marshalledRecentlyPlayed
},
RPWA.next = Types.RecentlyPlayed.next $ marshalledRecentlyPlayed
}
liftIO $ putStrLn ("Marshalled recentlyPlayedWithArtist data " ++ (show recentlyPlayedWithArtist))
recentlyPlayedHTMLResponse <- liftIO . getRecentlyPlayedHTMLResponse $ recentlyPlayedWithArtist
let nextRecentlyPlayedTracksHref = getNextRecentlyPlayedTracksHref recentlyPlayedWithArtist
liftIO $ putStrLn ("Created HTML response" ++ (show nextRecentlyPlayedTracksHref))
response <- buildResponse recentlyPlayedHTMLResponse nextRecentlyPlayedTracksHref
liftIO $ putStrLn ("Built HTML response" ++ (show response))
html $ mconcat [response]
Left error ->
html $ mconcat ["Something went wrong getting data from Spotify, refresh to try again."]