module Spotify.Servant.Core where

import Orphans.Servant.Lucid ()
import Spotify.Types.Auth
import Spotify.Types.Internal.CustomJSON
import Spotify.Types.Misc

import Data.Aeson (FromJSON)
import Data.HashMap.Strict qualified as HM
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Generics (Generic)
import Servant.API (
    Delete,
    DeleteNoContent,
    FormUrlEncoded,
    Get,
    Header',
    JSON,
    Post,
    PostCreated,
    PostNoContent,
    Put,
    PutAccepted,
    PutNoContent,
    QueryParam,
    QueryParam',
    ReqBody,
    Required,
    Strict,
    ToHttpApiData (toUrlPiece),
    type (:>),
 )
import Servant.HTML.Lucid (HTML)
import Web.FormUrlEncoded (Form (Form), ToForm (toForm))

type Authorize =
    "authorize"
        :> QueryParam' '[Strict, Required] "client_id" ClientId
        :> QueryParam' '[Strict, Required] "response_type" Text
        :> QueryParam' '[Strict, Required] "redirect_uri" URL
        :> QueryParam "state" Text
        :> QueryParam "scope" ScopeSet
        :> QueryParam "show_dialog" Bool
        :> Get '[HTML] Text

type RequestAccessToken =
    "token"
        :> ReqBody '[FormUrlEncoded] RequestAccessTokenForm
        :> Header' '[Strict, Required] "Authorization" IdAndSecret
        :> Post '[JSON] TokenResponse'
data RequestAccessTokenForm = RequestAccessTokenForm AuthCode URL
instance ToForm RequestAccessTokenForm where
    toForm :: RequestAccessTokenForm -> Form
toForm (RequestAccessTokenForm (AuthCode Text
t) URL
r) =
        HashMap Text [Text] -> Form
Form forall a b. (a -> b) -> a -> b
$
            forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList
                [ (Text
"grant_type", [Text
"authorization_code"])
                , (Text
"code", [Text
t])
                , (Text
"redirect_uri", [URL
r.unwrap])
                ]
data TokenResponse' = TokenResponse'
    { TokenResponse' -> AccessToken
accessToken :: AccessToken
    , TokenResponse' -> TokenType
tokenType :: TokenType
    , TokenResponse' -> Int
expiresIn :: Int
    , TokenResponse' -> Text
scope :: Text
    , TokenResponse' -> RefreshToken
refreshToken :: RefreshToken
    }
    deriving (TokenResponse' -> TokenResponse' -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenResponse' -> TokenResponse' -> Bool
$c/= :: TokenResponse' -> TokenResponse' -> Bool
== :: TokenResponse' -> TokenResponse' -> Bool
$c== :: TokenResponse' -> TokenResponse' -> Bool
Eq, Eq TokenResponse'
TokenResponse' -> TokenResponse' -> Bool
TokenResponse' -> TokenResponse' -> Ordering
TokenResponse' -> TokenResponse' -> TokenResponse'
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TokenResponse' -> TokenResponse' -> TokenResponse'
$cmin :: TokenResponse' -> TokenResponse' -> TokenResponse'
max :: TokenResponse' -> TokenResponse' -> TokenResponse'
$cmax :: TokenResponse' -> TokenResponse' -> TokenResponse'
>= :: TokenResponse' -> TokenResponse' -> Bool
$c>= :: TokenResponse' -> TokenResponse' -> Bool
> :: TokenResponse' -> TokenResponse' -> Bool
$c> :: TokenResponse' -> TokenResponse' -> Bool
<= :: TokenResponse' -> TokenResponse' -> Bool
$c<= :: TokenResponse' -> TokenResponse' -> Bool
< :: TokenResponse' -> TokenResponse' -> Bool
$c< :: TokenResponse' -> TokenResponse' -> Bool
compare :: TokenResponse' -> TokenResponse' -> Ordering
$ccompare :: TokenResponse' -> TokenResponse' -> Ordering
Ord, Int -> TokenResponse' -> ShowS
[TokenResponse'] -> ShowS
TokenResponse' -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenResponse'] -> ShowS
$cshowList :: [TokenResponse'] -> ShowS
show :: TokenResponse' -> String
$cshow :: TokenResponse' -> String
showsPrec :: Int -> TokenResponse' -> ShowS
$cshowsPrec :: Int -> TokenResponse' -> ShowS
Show, forall x. Rep TokenResponse' x -> TokenResponse'
forall x. TokenResponse' -> Rep TokenResponse' x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenResponse' x -> TokenResponse'
$cfrom :: forall x. TokenResponse' -> Rep TokenResponse' x
Generic)
    deriving (Value -> Parser [TokenResponse']
Value -> Parser TokenResponse'
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TokenResponse']
$cparseJSONList :: Value -> Parser [TokenResponse']
parseJSON :: Value -> Parser TokenResponse'
$cparseJSON :: Value -> Parser TokenResponse'
FromJSON) via CustomJSON TokenResponse'

type RefreshAccessToken =
    "token"
        :> ReqBody '[FormUrlEncoded] RefreshAccessTokenForm
        :> Header' '[Strict, Required] "Authorization" IdAndSecret
        :> Post '[JSON] TokenResponse
newtype RefreshAccessTokenForm = RefreshAccessTokenForm RefreshToken
instance ToForm RefreshAccessTokenForm where
    toForm :: RefreshAccessTokenForm -> Form
toForm (RefreshAccessTokenForm (RefreshToken Text
t)) =
        HashMap Text [Text] -> Form
Form forall a b. (a -> b) -> a -> b
$
            forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList
                [ (Text
"grant_type", [Text
"refresh_token"])
                , (Text
"refresh_token", [Text
t])
                ]

type AuthHeader = Header' '[Strict, Required] "Authorization" AccessToken

-- various patterns which appear throughout the API
type SpotGet a = AuthHeader :> Get '[JSON] a
type SpotPut a = AuthHeader :> Put '[JSON] a
type SpotPutAccepted a = AuthHeader :> PutAccepted '[JSON] a
type SpotPutNoContent = AuthHeader :> PutNoContent
type SpotPost a = AuthHeader :> Post '[JSON] a
type SpotPostCreated a = AuthHeader :> PostCreated '[JSON] a
type SpotPostNoContent = AuthHeader :> PostNoContent
type SpotDelete a = AuthHeader :> Delete '[JSON] a
type SpotDeleteNoContent = AuthHeader :> DeleteNoContent
type SpotBody = ReqBody '[JSON]
type SpotPaging a =
    QueryParam "limit" Int
        :> QueryParam "offset" Int
        :> SpotGet (Paging a)

-- types that only exist for the instances
newtype ScopeSet = ScopeSet {ScopeSet -> Set Scope
unwrap :: Set Scope}
instance ToHttpApiData ScopeSet where
    toUrlPiece :: ScopeSet -> Text
toUrlPiece = forall a. ToHttpApiData a => a -> Text
toUrlPiece forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Scope -> Text
showScope forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.unwrap)