Doing the OAuth Dance for Spotify in Haskell with Scotty, Wreq and Aeson

README.md

This is still a work in progress, currently successfully authorises a user and exchanges that authorisation token for an access token.

dance.hs

{-# LANGUAGE OverloadedStrings #-}

module Lib
    ( recify,
      getAccessTokenFromPayload
    ) where

import Web.Scotty
import Network.HTTP.Types (status302)
import Control.Monad.IO.Class
import qualified Network.Wreq as W
import Control.Lens
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy as L
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy.Encoding as TLE
import qualified Data.Text.Lazy as LT
import qualified Data.Text as T
import Data.Aeson.Lens (_String, key)

newtype AuthorizationCode = AuthorizationCode {
  getAuthorizationCode :: String
}

clientId = "REDACTED"
authorizationScope = "user-read-recently-played, user-top-read"
authorizationResponseType = "code"

bearer = "REDACTED"
callbackUri = "http://localhost:3000/callback"
grantType = "authorization_code"
accessTokenRequestUri = "https://accounts.spotify.com/api/token"
recentlyPlayerUri = "https://api.spotify.com/v1/me/player/recently-played"

port = 3000

requestAccessTokenFromAuthorizationCode :: AuthorizationCode -> IO L.ByteString
requestAccessTokenFromAuthorizationCode authorizationCode = do 
  let options = W.defaults & W.header "Authorization" .~ [bearer]
  let payload = [("code" :: B.ByteString, B.pack $ getAuthorizationCode authorizationCode :: B.ByteString)
                  , ("grant_type" :: B.ByteString, B.pack $ grantType :: B.ByteString)
                  , ("redirect_uri" :: B.ByteString, B.pack $ callbackUri :: B.ByteString)
                ]
  text <- liftIO $ (W.postWith options accessTokenRequestUri payload)
  return $ text ^. W.responseBody

getCurrentUsersRecentlyPlayedTracks :: B.ByteString -> IO L.ByteString
getCurrentUsersRecentlyPlayedTracks accessToken = do
  let options = W.defaults & W.header "Authorization" .~ [accessToken] -- THIS NEEDS  TO  BE A BEARER SYNTAX
  text <- liftIO $ (W.getWith options recentlyPlayerUri)
  return $ text ^. W.responseBody

getAccessTokenFromPayload :: L.ByteString -> T.Text
getAccessTokenFromPayload json = json ^. key "access_token" . _String

logIO x = print x

recify :: IO ()
recify = scotty port $ do
    get "/" $ do
      status status302
      setHeader "Location" (LT.pack ("https://accounts.spotify.com/authorize?client_id=" ++ clientId ++ "&response_type=" ++ authorizationResponseType ++ "&redirect_uri=" ++ callbackUri ++ "&scope=" ++ authorizationScope))

    get "/callback" $ do
      authorizationCode <- fmap AuthorizationCode (param "code")
      accessTokenPayload <- liftIO $ requestAccessTokenFromAuthorizationCode authorizationCode
      playedTracks <- liftIO $ getCurrentUsersRecentlyPlayedTracks (L.toStrict accessTokenPayload)
      _ <- liftIO $ logIO playedTracks
      html $ mconcat ["<pre>", (LT.fromStrict $ getAccessTokenFromPayload accessTokenPayload), "</pre>"]