{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeAbstractions #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}

{- swiped from an incomplete personal project to use for testing. -}
module Api (
  -- * Api structure
  Api(..),
  ProtectedApi(..),
  UnprotectedApi(..),

  -- * Api data
  ProposalId(..),
  AvailabilityInterval(..),
  NewProposalReq(..),
  Name(..),
  Invite(..),
  Interval(..),
  Token(..),
  Email(..),
  Availability(..),
  DiscordAccessToken(..),
  DiscordUser(..),
  Guild(..),
  GuildId(..),
  AvailableCredits(..),
  DashboardData(..),
  Proposal(..),
  Cookie(..),
  SetMetadataReq(..),
  KV(..),
  FEConfig(..),
) where


import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
import Data.Binary (Binary)
import Data.ByteString (ByteString)
import Data.JsonSpec
  ( Field(Field), HasJsonDecodingSpec(DecodingSpec, fromJSONStructure)
  , HasJsonEncodingSpec(EncodingSpec, toJSONStructure), SpecJSON(SpecJSON)
  , Specification
    ( JsonArray, JsonDateTime, JsonEither, JsonInt, JsonLet, JsonObject, JsonRef
    , JsonString, JsonTag
    )
  )
import Data.Map (Map)
import Data.Set (Set)
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Data.Time (UTCTime)
import Data.UUID (UUID)
import GHC.Generics (Generic)
import Prelude
  ( Applicative(pure), Either(Right), (.), Eq, Int, Maybe, Ord, undefined
  )
import Servant.API
  ( FromHttpApiData(parseHeader, parseQueryParam), GenericMode((:-))
  , StdMethod(GET), (:>), Capture, DeleteNoContent, Get, Header, Header'
  , Headers, JSON, NamedRoutes, NoContent, Optional, Post, PostNoContent
  , QueryParam', ReqBody, ReqBody', Required, Strict, Summary, ToHttpApiData
  , Verb
  )
import Web.Cookie (SetCookie)
import qualified Data.JsonSpec as Spec


data Api mode = Api
  { protectedApi :: mode
      :- "api"
      :> Header' '[Optional, Strict] "Authorization" Token
      :> Header' '[Optional, Strict] "Cookie" Cookie
      :> NamedRoutes ProtectedApi
  , unprotectedApi :: mode
      :- "api"
      :> NamedRoutes UnprotectedApi
  }
  deriving stock (Generic)


newtype Cookie = Cookie ByteString
instance FromHttpApiData Cookie where
  parseHeader = Right . Cookie
  parseQueryParam = Right . Cookie . encodeUtf8


data ProtectedApi mode = ProtectedApi
  { makeProposal :: mode
      :- "proposal"
      :> Summary "a summary"
      :> ReqBody' '[Required, Strict] '[JSON] NewProposalReq
      :> Post '[JSON] (KV ProposalId Proposal)

  , deleteProposal :: mode
      :- "proposal"
      :> Capture "proposalId" ProposalId
      :> DeleteNoContent

  , setAvailability :: mode
      :- "proposal"
      :> Capture "proposalId" ProposalId
      :> "availability"
      :> ReqBody' '[Required, Strict] '[JSON] Availability
      :> PostNoContent

  , setMetadata :: mode
      :- "proposal"
      :> Capture "proposalId" ProposalId
      :> "metadata"
      :> ReqBody' '[Required, Strict] '[JSON] SetMetadataReq
      :> PostNoContent

  , dashboard :: mode
      :- "dashboard"
      :> QueryParam' '[Required, Strict] "foo" Text
      :> QueryParam' '[Optional, Strict] "bar" Text
      :> Get '[JSON] DashboardData

  , addInvite :: mode
      :- "proposal"
      :> Capture "proposalId" ProposalId
      :> "invites"
      :> "add-invite"
      :> ReqBody' '[Required, Strict] '[JSON] Invite
      :> PostNoContent

  , deleteInvite :: mode
      :- "proposal"
      :> Capture "proposalId" ProposalId
      :> "invites"
      :> "delete"
      :> ReqBody' '[Required, Strict] '[JSON] Invite
      :> PostNoContent

  , getGuilds :: mode
      :- "guilds"
      :> Get '[JSON] (Set Guild)

  }
  deriving stock (Generic)


data SetMetadataReq = SetMetadataReq
  {        name :: Name
  , description :: Text
  ,       venue :: Text
  }
  deriving FromJSON via (SpecJSON SetMetadataReq)
instance HasJsonDecodingSpec SetMetadataReq where
  type DecodingSpec SetMetadataReq =
    JsonObject
      '[        "name" ::: (DecodingSpec Name)
       , "description" ::: JsonString
       ,       "venue" ::: JsonString
       ]
  fromJSONStructure
      (Field @"name" name_,
      (Field @"description" description,
      (Field @"venue" venue,
      ())))
    = do
      name <- fromJSONStructure name_
      pure
        SetMetadataReq
          { name
          , description
          , venue
          }


data DashboardData = DashboardData
  { proposals :: Map ProposalId Proposal
  ,   credits :: AvailableCredits
  ,      user :: DiscordUser
  }
  deriving ToJSON via (SpecJSON DashboardData)
instance HasJsonEncodingSpec DashboardData where
  type EncodingSpec DashboardData =
    JsonLet
      '[ '("DashboardData"
          , JsonObject
              '[ "proposals" :::
                    JsonArray
                      (
                        JsonObject
                          '[   "key" ::: EncodingSpec ProposalId
                           , "value" ::: EncodingSpec Proposal
                           ]
                      )
               , "credits" ::: EncodingSpec AvailableCredits
               , "user" ::: EncodingSpec DiscordUser
               ]
          )
       ]
       (JsonRef "DashboardData")
  toJSONStructure = undefined


data Proposal = Proposal
  {         name :: Name
  ,        owner :: DiscordUser
  ,  description :: Text
  ,        venue :: Text
  , availability :: [AvailabilityInterval]
  ,      invites :: Set Invite
  ,    createdAt :: UTCTime
  }
  deriving stock (Generic)
  deriving (ToJSON, FromJSON) via (SpecJSON Proposal)
instance HasJsonEncodingSpec Proposal where
  type EncodingSpec Proposal =
    JsonObject
      '[         "name" ::: EncodingSpec Name
       ,        "owner" ::: EncodingSpec DiscordUser
       , "availability" ::: JsonArray (EncodingSpec AvailabilityInterval)
       ,  "description" ::: JsonString
       ,        "venue" ::: JsonString
       ,      "invites" ::: JsonArray (EncodingSpec Invite)
       ,   "created-at" ::: JsonDateTime
       ]
  toJSONStructure = undefined
instance HasJsonDecodingSpec Proposal where
  type DecodingSpec Proposal = EncodingSpec Proposal
  fromJSONStructure = undefined


data Invite
  = InviteUser DiscordUser
  | InviteGuild Guild
  deriving stock (Eq, Ord)
  deriving (ToJSON, FromJSON) via (SpecJSON Invite)
instance HasJsonEncodingSpec Invite where
  type EncodingSpec Invite =
    JsonLet
      '[ '( "Invite"
          , JsonEither
              ( JsonObject
                  '[     "type" ::: JsonTag "discord-user"
                   , "username" ::: EncodingSpec DiscordUser
                   ]
              )
              ( JsonObject
                  '[  "type" ::: JsonTag "discord-server"
                   , "guild" ::: EncodingSpec Guild
                   ]
              )
          )
       ]
       (JsonRef "Invite")
  toJSONStructure = undefined
instance HasJsonDecodingSpec Invite where
  type DecodingSpec Invite = EncodingSpec Invite
  fromJSONStructure = undefined


data Guild = Guild
  { guildId :: GuildId
  ,    name :: Text
  }
  deriving stock (Eq, Ord)
  deriving (ToJSON, FromJSON) via (SpecJSON Guild)
instance HasJsonEncodingSpec Guild where
  type EncodingSpec Guild =
    JsonObject
      '[   "id" ::: EncodingSpec GuildId
       , "name" ::: JsonString
       ]
  toJSONStructure = undefined
instance HasJsonDecodingSpec Guild where
  type DecodingSpec Guild = EncodingSpec Guild
  fromJSONStructure = undefined


newtype GuildId = GuildId
  { unGuildId :: Text
  }
  deriving newtype (ToHttpApiData, Eq, Ord)
  deriving FromJSON via (SpecJSON GuildId)
instance HasJsonEncodingSpec GuildId where
  type EncodingSpec GuildId = JsonString
  toJSONStructure = unGuildId
instance HasJsonDecodingSpec GuildId where
  type DecodingSpec GuildId = EncodingSpec GuildId
  fromJSONStructure = pure . GuildId


data AvailabilityInterval = AvailabilityInterval
  { interval :: Interval
  ,    users :: Set DiscordUser
  }
  deriving ToJSON via (SpecJSON AvailabilityInterval)
instance HasJsonDecodingSpec AvailabilityInterval where
  type DecodingSpec AvailabilityInterval = EncodingSpec AvailabilityInterval
  fromJSONStructure = undefined
instance HasJsonEncodingSpec AvailabilityInterval where
  type EncodingSpec AvailabilityInterval =
    JsonObject
      '[ "interval" ::: EncodingSpec Interval
       ,    "users" ::: JsonArray (EncodingSpec DiscordUser)
       ]
  toJSONStructure = undefined


newtype AvailableCredits = AvailableCredits
  { unAvailableCredits :: Int
  }
  deriving ToJSON via (SpecJSON AvailableCredits)
instance HasJsonEncodingSpec AvailableCredits where
  type EncodingSpec AvailableCredits = JsonInt
  toJSONStructure = undefined


data UnprotectedApi mode = UnprotectedApi
  { login :: mode
      :- "login"
      :> ReqBody '[JSON] DiscordAccessToken
      :> Post
          '[JSON]
          (
            Headers
              '[ Header "Set-Cookie" SetCookie
               , Header "Set-Cookie" SetCookie
               ]
              DiscordUser
          )
  , logout :: mode
      :- "logout"
      :> Verb 'GET 204 '[JSON]
          (
            Headers
              '[ Header "Set-Cookie" SetCookie
               , Header "Set-Cookie" SetCookie
               ]
              NoContent
          )
  , config :: mode
      :- "config"
      :> Get '[JSON] FEConfig
  }
  deriving stock (Generic)


newtype FEConfig = FEConfig
  { discordRedirect :: Text
  }
  deriving (ToJSON) via (SpecJSON FEConfig)
instance HasJsonEncodingSpec FEConfig where
  type EncodingSpec FEConfig =
    JsonObject
      '[ "redirectUrl" ::: JsonString ]
  toJSONStructure = undefined

newtype Email = Email
  { unEmail :: Text
  }
  deriving newtype (FromJSON)


newtype DiscordAccessToken = DiscordAccessToken
  { unDiscordAccessToken :: Text
  }
  deriving newtype (Binary)
  deriving (FromJSON) via (SpecJSON DiscordAccessToken)
instance HasJsonDecodingSpec DiscordAccessToken where
  type DecodingSpec DiscordAccessToken = JsonString
  fromJSONStructure = undefined


newtype Token = Token
  { unToken :: Text
  }
  deriving newtype
    ( Eq
    , FromHttpApiData
    , Ord
    )


newtype ProposalId = ProposalId
  { unProposalId :: UUID
  }
  deriving newtype
    ( Eq
    , FromHttpApiData
    , Ord
    , ToJSONKey
    , FromJSONKey
    )
  deriving ToJSON via (SpecJSON ProposalId)
instance HasJsonEncodingSpec ProposalId where
  type EncodingSpec ProposalId = JsonString
  toJSONStructure = undefined


data NewProposalReq = NewProposalReq
  {         name :: Name
  , availability :: Availability
  ,  description :: Text
  ,        venue :: Maybe Text
  }
  deriving (FromJSON) via (SpecJSON NewProposalReq)
instance HasJsonDecodingSpec NewProposalReq where
  type DecodingSpec NewProposalReq =
    JsonObject
      '[         "name" ::: DecodingSpec Name
       , "availability" ::: DecodingSpec Availability
       ,  "description" ::: JsonString
       ,        "venue" ::? JsonString
       ]
  fromJSONStructure = undefined


newtype Availability = Availability
  { unAvailability :: Set Interval
  }
  deriving FromJSON via (SpecJSON Availability)
instance HasJsonDecodingSpec Availability where
  type DecodingSpec Availability = JsonArray (DecodingSpec Interval)
  fromJSONStructure = undefined


newtype Name = Name
  { unName :: Text
  }
  deriving (ToJSON, FromJSON) via (SpecJSON Name)
instance HasJsonEncodingSpec Name where
  type EncodingSpec Name = JsonString
  toJSONStructure = undefined
instance HasJsonDecodingSpec Name where
  type DecodingSpec Name = EncodingSpec Name
  fromJSONStructure = undefined


data Interval = Interval
  { startInclusive :: UTCTime
  ,   endExclusive :: UTCTime
  }
  deriving stock (Eq, Ord)
  deriving (ToJSON, FromJSON) via (SpecJSON Interval)
instance HasJsonEncodingSpec Interval where
  type EncodingSpec Interval =
    JsonObject
      '[ "startInclusive" ::: JsonDateTime
       ,   "endExclusive" ::: JsonDateTime
       ]
  toJSONStructure = undefined
instance HasJsonDecodingSpec Interval where
  type DecodingSpec Interval = EncodingSpec Interval
  fromJSONStructure = undefined


newtype DiscordUser = DiscordUser
  { unDiscordUser :: Text
  }
  deriving newtype ( Eq , FromJSON , Ord, Binary)
  deriving ToJSON via (SpecJSON DiscordUser)
instance HasJsonEncodingSpec DiscordUser where
  type EncodingSpec DiscordUser = JsonString
  toJSONStructure = undefined
instance HasJsonDecodingSpec DiscordUser where
  type DecodingSpec DiscordUser = EncodingSpec DiscordUser
  fromJSONStructure = undefined


data KV k v = KV
  {   key :: k
  , value :: v
  }
deriving via (SpecJSON (KV ProposalId Proposal)) instance
  ToJSON (KV ProposalId Proposal)
instance HasJsonEncodingSpec (KV k v) where
    type EncodingSpec (KV k v) =
      JsonObject
        '[   "key" ::: EncodingSpec k
         , "value" ::: EncodingSpec v
         ]

    toJSONStructure = undefined


type (:::) = Spec.Required
type (::?) = Spec.Optional