{-# LANGUAGE DataKinds                                                     #-}
{-# LANGUAGE StandaloneDeriving                                            #-}
{-# LANGUAGE DeriveGeneric                                                 #-}
{-# LANGUAGE OverloadedStrings                                             #-}
{-# LANGUAGE RecordWildCards                                               #-}
{-# LANGUAGE TypeFamilies                                                  #-}
{-# LANGUAGE TypeOperators                                                 #-}

module MediumAPI where

import           Control.Applicative
import           Control.Monad.Trans.Either
import           Data.Aeson
import           Data.ByteString                           (intercalate)
import           Data.Default.Class
import           Data.Monoid
import           Data.Proxy
import           Data.String
import           Data.Text                                 (Text)
import           Data.Text.Encoding                        (encodeUtf8)
import           Data.Time.Clock
import           Data.Time.Clock.POSIX
import           GHC.Generics

import           Network.HTTP.Client                       hiding (Proxy)

import           Servant
import           Servant.Client


type API = "v1" :> "me" :> Header "Authorization" Token :> Get '[JSON] User
         :<|> "v1" :> "users" :> Capture "authorId" Text :> "posts" :> Header "Authorization" Token :> ReqBody '[JSON] NewPost :> Post '[JSON] CreatedPost
         :<|> "v1" :> "tokens" :> ReqBody '[FormUrlEncoded] TokenRequest :> Post '[JSON] TokenResp
         :<|> "v1" :> "tokens" :> Header "Authorization" Token :> ReqBody '[FormUrlEncoded] RefreshRequest :> Post '[JSON] TokenResp

data TokenRequest = TokenRequest { authCode :: Text
                                 , clientId      :: Text
                                 , clientSecret  :: Text
                                 , redirectUri   :: Text
                                 }

instance ToFormUrlEncoded TokenRequest where
    toFormUrlEncoded TokenRequest{..} = [ ("code", authCode)
                                        , ("client_id", clientId)
                                        , ("client_secret", clientSecret)
                                        , ("grant_type", "authorization_code")
                                        , ("redirect_uri", redirectUri)
                                        ]

newtype Token = Token { token :: Text } deriving (Show, Read, Eq)

instance ToText Token where
    toText Token{..} = "Bearer " <> token

data ContentFormat = Html | Markdown
                   deriving (Show, Read, Eq, Generic)

instance ToJSON ContentFormat where
    toJSON Html     = "html"
    toJSON Markdown = "markdown"

instance FromJSON ContentFormat where
    parseJSON (String "html")     = return Html
    parseJSON (String "markdown") = return Markdown
    parseJSON _                   =
      error "Expected valid string value for content format"

data PublishStatus = Public | Draft | Unlisted
                   deriving (Show, Read, Eq, Generic)

instance ToJSON PublishStatus where
    toJSON Public   = "public"
    toJSON Draft    = "draft"
    toJSON Unlisted = "unlisted"

instance FromJSON PublishStatus where
    parseJSON (String "public")   = return Public
    parseJSON (String "draft")    = return Draft
    parseJSON (String "unlisted") = return Unlisted
    parseJSON _                   =
      error "Expected valid string value for publish status"

data License = AllRightsReserved | Cc40By | Cc40BySa | Cc40ByNd | Cc40ByNc | Cc40ByNcNd | Cc40ByNcSa | Cc40Zero | PublicDomain
             deriving (Show, Read, Eq, Generic)

instance ToJSON License where
    toJSON AllRightsReserved = "all-rights-reserved"
    toJSON Cc40By            = "cc-40-by"
    toJSON Cc40BySa          = "cc-40-by-sa"
    toJSON Cc40ByNd          = "cc-40-by-nd"
    toJSON Cc40ByNc          = "cc-40-by-nc"
    toJSON Cc40ByNcNd        = "cc-40-by-nc-nd"
    toJSON Cc40ByNcSa        = "cc-40-by-nc-sa"
    toJSON Cc40Zero          = "cc-40-zero"
    toJSON PublicDomain      = "public-domain"

instance FromJSON License where
    parseJSON (String "all-rights-reserved") = return AllRightsReserved
    parseJSON (String "cc-40-by")            = return Cc40By
    parseJSON (String "cc-40-by-sa")         = return Cc40BySa
    parseJSON (String "cc-40-by-nd")         = return Cc40ByNd
    parseJSON (String "cc-40-by-nc")         = return Cc40ByNc
    parseJSON (String "cc-40-by-nc-nd")      = return Cc40ByNcNd
    parseJSON (String "cc-40-by-nc-sa")      = return Cc40ByNcSa
    parseJSON (String "cc-40-zero")          = return Cc40Zero
    parseJSON (String "public-domain")       = return PublicDomain
    parseJSON _                              =
      error "Expected valid string value for license"

data User = User { id       :: Text
                 , username :: Text
                 , name     :: Text
                 , url      :: Text
                 , imageUrl :: Text
                 }
                 deriving (Show, Read, Eq, Generic)

instance FromJSON User where
    parseJSON (Object o) = do
      Object o' <- o .: "data"
      User <$> o' .: "id"
           <*> o' .: "username"
           <*> o' .: "name"
           <*> o' .: "url"
           <*> o' .: "imageUrl"
    parseJSON _          = error "Expected an object"

data NewPost = NewPost { title         :: Text
                       , contentFormat :: ContentFormat
                       , content       :: Text
                       , tags          :: [Text]
                       , canonicalUrl  :: Maybe Text
                       , publishStatus :: PublishStatus
                       , license       :: License
                       }
                       deriving (Show, Read, Eq, Generic)

instance ToJSON NewPost


data CreatedPost = CreatedPost { postId            :: Text
                               , postTitle         :: Text
                               , authorId          :: Text
                               , postTags          :: [Text]
                               , mediumUrl         :: Text
                               , postCanonicalUrl  :: Maybe Text
                               , postPublishStatus :: PublishStatus
                               , publishedAt       :: Maybe Integer
                               , postLicense       :: License
                               , licenseUrl        :: Text
                               }
                               deriving (Show, Read, Eq, Generic)

instance FromJSON CreatedPost where
    parseJSON (Object o) = do
      Object o' <- o .: "data"
      CreatedPost <$> o' .:  "id"
               <*> o' .:  "title"
               <*> o' .:  "authorId"
               <*> o' .:  "tags"
               <*> o' .:  "url"
               <*> o' .:? "canonicalUrl"
               <*> o' .:  "publishStatus"
               <*> o' .:? "publishedAt"
               <*> o' .:  "license"
               <*> o' .:  "licenseUrl"
    parseJSON _          = error "Expected an object"

data Scope = BasicProfile | PublishPost | UploadImage deriving (Show, Read, Eq)

scopeString :: IsString a => Scope -> a
scopeString BasicProfile = "basicProfile"
scopeString PublishPost  = "publishPost"
scopeString UploadImage  = "uploadImage"

instance ToJSON Scope where
    toJSON = scopeString

instance FromJSON Scope where
    parseJSON "basicProfile" = return BasicProfile
    parseJSON "publishPost"  = return PublishPost
    parseJSON "uploadImage"  = return UploadImage
    parseJSON _              = error "Invalid scope value"

data TokenResp = TokenResp { tokenType    :: Text
                           , accessToken  :: Text
                           , refreshToken :: Text
                           , scope        :: [Scope]
                           , expiresAt    :: UTCTime
                           }
                           deriving (Show, Eq)

instance FromJSON TokenResp where
    parseJSON (Object o) = TokenResp "Bearer"
                                     <$> o .: "access_token"
                                     <*> o .: "refresh_token"
                                     <*> o .: "scope"
                                     <*> (milliToUtc <$> o .: "expires_at")
    parseJSON _          = error "Expected an object"

data RefreshRequest = RefreshRequest { refreshToken' :: Text
                                     , clientId'     :: Text
                                     , clientSecret' :: Text
                                     }
                                     deriving (Show, Read, Eq)

instance ToFormUrlEncoded RefreshRequest where
    toFormUrlEncoded RefreshRequest{..} = [ ("refresh_token", refreshToken')
                                          , ("client_id",     clientId')
                                          , ("client_secret", clientSecret')
                                          , ("grant_type",    "refresh_token")
                                          ]


milliToUtc :: POSIXTime -> UTCTime
milliToUtc = posixSecondsToUTCTime . (/ 1000)

defaultPost :: NewPost
defaultPost = NewPost "" Html "" [] Nothing Public AllRightsReserved

baseUrl :: BaseUrl
baseUrl = BaseUrl Https "api.medium.com" 443

-- TODO: scope list should be non-empty
authCodeUrl :: Text -> [Scope] -> Text -> Text -> String
authCodeUrl clientId requestedScope stateText redirectUrl =
    show . getUri $
      setQueryString [ ("client_id",    Just $ encodeUtf8 clientId)
                     , ("state",        Just $ encodeUtf8 stateText)
                     , ("redirect_uri", Just $ encodeUtf8 redirectUrl)
                     , ("scope",        Just scopeList)
                     , ("responseType", Just "code")
                     ]
                     def { host = "medium.com"
                         , port = 443
                         , secure = True
                         , path = "/m/oauth/authorize"
                         }
  where scopeList = intercalate "," $ map scopeString requestedScope

type EitherIO x = EitherT x IO

me ::  Maybe Token -> EitherIO ServantError User
posts :: Text -> Maybe Token -> NewPost -> EitherIO ServantError CreatedPost
tokenFromAuthCode :: TokenRequest -> EitherIO ServantError TokenResp
refreshAuthToken :: Maybe Token -> RefreshRequest -> EitherIO ServantError TokenResp

api :: Proxy API
api = Proxy

me :<|> posts :<|> tokenFromAuthCode :<|> refreshAuthToken = client api baseUrl