-- SPDX-FileCopyrightText: 2022 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module ServantApi.ExternalApis.Type where

import Import.Servant.NoFoundation hiding ((.=), keys)

import Data.Aeson
  
import qualified Data.HashSet as HashSet
import qualified Data.HashMap.Strict.InsOrd as HashMap.InsOrd

import Jose.Jwk (JwkSet(..))

{-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-}


type ExternalApisListR = ApiVersion 1 0 0
                      :> Get '[PrettyJSON] ExternalApisList
type ExternalApisCreateR = ApiVersion 1 0 0
                        :> CaptureBearerRestriction' '[Optional] ExternalApiCreationRestrictions
                        :> CaptureBearerToken
                        :> ReqBody '[JSON] ExternalApiCreationRequest
                        :> PostCreated '[PrettyJSON] (Headers '[Header "Location" URI] ExternalApiCreationResponse)
type ExternalApisPongR = ApiVersion 1 0 0
                      :> CaptureCryptoUUID "external-api" ExternalApiId
                      :> "pong"
                      :> Post '[PrettyJSON] ExternalApiPongResponse
type ExternalApisInfoR = ApiVersion 1 0 0
                      :> CaptureCryptoUUID "external-api" ExternalApiId
                      :> Get '[PrettyJSON] ExternalApiInfo
type ExternalApisDeleteR = ApiVersion 1 0 0
                        :> CaptureCryptoUUID "external-api" ExternalApiId
                        :> DeleteNoContent

data ExternalApis mode = ExternalApis
  { externalApisListR   :: mode :- ExternalApisListR
  , externalApisCreateR :: mode :- ExternalApisCreateR
  , externalApisInfoR   :: mode :- ExternalApisInfoR
  , externalApisPongR   :: mode :- ExternalApisPongR
  , externalApisDeleteR :: mode :- ExternalApisDeleteR
  } deriving (Generic)

type ServantApiExternalApis = ServantApi ExternalApis
type instance ServantApiUnproxy ExternalApis = ToServantApi ExternalApis


instance ToCapture (Capture "external-api" UUID) where
  toCapture _ = DocCapture "external-api" "Internal id of the registered external api"


data ExternalApiCreationRequest = ExternalApiCreationRequest
  { eacrPublicKeys :: JwkSet
  , eacrBaseUrl :: BaseUrl
  , eacrConfig :: ExternalApiConfig
  } deriving (Eq, Show, Generic)

instance ToJSON ExternalApiCreationRequest where
  toJSON = genericToJSON externalApiCreationRequestAesonOptions
instance FromJSON ExternalApiCreationRequest where
  parseJSON = genericParseJSON externalApiCreationRequestAesonOptions
instance ToSchema ExternalApiCreationRequest where
  declareNamedSchema = genericDeclareNamedSchema $ fromAesonOptions externalApiCreationRequestAesonOptions
instance ToSample ExternalApiCreationRequest

data ExternalApiCreationResponse = ExternalApiCreationResponse
  { eacrId :: CryptoUUIDExternalApi
  , eacrInfo :: ExternalApiInfo
  } deriving (Eq, Show, Generic)

instance ToJSON ExternalApiCreationResponse where
  toJSON = genericToJSON externalApiCreationResponseAesonOptions
instance FromJSON ExternalApiCreationResponse where
  parseJSON = genericParseJSON externalApiCreationResponseAesonOptions
instance ToSchema ExternalApiCreationResponse where
  declareNamedSchema = genericDeclareNamedSchema $ fromAesonOptions externalApiCreationResponseAesonOptions
instance ToSample ExternalApiCreationResponse where
  toSamples _ = samples $ ExternalApiCreationResponse
    <$> fmap (unTagged . snd) (toSamples $ Proxy @(Tagged ExternalApiId CryptoUUIDExternalApi))
    <*> fmap snd (toSamples $ Proxy @ExternalApiInfo)

data ExternalApiCreationRestrictions = ExternalApiCreationRestrictions
  { eacrIdent :: Maybe UUID
  , eacrApiKinds :: NonNull (HashSet ExternalApiKind)
  } deriving (Eq, Show, Generic)
instance ToJSON ExternalApiCreationRestrictions where
  toJSON = genericToJSON externalApiCreationRestrictionsAesonOptions
instance FromJSON ExternalApiCreationRestrictions where
  parseJSON = genericParseJSON externalApiCreationRestrictionsAesonOptions
instance ToSchema ExternalApiCreationRestrictions where
  declareNamedSchema = genericDeclareNamedSchema $ fromAesonOptions externalApiCreationRestrictionsAesonOptions
instance ToSample ExternalApiCreationRestrictions


data ExternalApiPongResponse = ExternalApiPongResponse
  { eaprLastAlive :: UTCTime
  } deriving (Eq, Show, Generic)
instance ToJSON ExternalApiPongResponse where
  toJSON = genericToJSON externalApiPongResponseAesonOptions
instance FromJSON ExternalApiPongResponse where
  parseJSON = genericParseJSON externalApiPongResponseAesonOptions
instance ToSchema ExternalApiPongResponse where
  declareNamedSchema = genericDeclareNamedSchema $ fromAesonOptions externalApiPongResponseAesonOptions
instance ToSample ExternalApiPongResponse


newtype ExternalApisList = ExternalApisList (HashMap CryptoUUIDExternalApi ExternalApiInfo)
  deriving (Eq, Show, Generic)
  deriving newtype (ToJSON, FromJSON, ToSchema)

instance ToSample ExternalApisList where
  toSamples _ = samples $ map (\n -> ExternalApisList . fold $ take n singletons) [0..]
    where
      singletons = zipWith (\(_, Tagged s) (_, s') -> singletonMap s s') (toSamples $ Proxy @(Tagged ExternalApiId CryptoUUIDExternalApi)) (toSamples $ Proxy @ExternalApiInfo)


data ExternalApiInfo = ExternalApiInfo
  { eaiIdent :: Maybe UUID
  , eaiTokenAuthority :: HashSet (Either Value CryptoUUIDUser)
  , eaiTokenIssued :: UTCTime
  , eaiTokenExpiresAt, eaiTokenStartsAt :: Maybe UTCTime
  , eaiPublicKeys :: JwkSet
  , eaiBaseUrl :: BaseUrl
  , eaiLastAlive :: UTCTime
  , eaiConfig :: ExternalApiConfig
  } deriving (Eq, Show, Generic)

instance ToJSON ExternalApiInfo where
  toJSON ExternalApiInfo{..} = object $ maybe id ((:) . ("ident" .=)) eaiIdent
    [ "token-authority" .= case HashSet.toList eaiTokenAuthority of
        [x] -> either id toJSON x
        _   -> toJSON $ foldMap (HashSet.singleton . either id toJSON) eaiTokenAuthority
    , "token-issued" .= eaiTokenIssued
    , "token-expires-at" .= eaiTokenExpiresAt
    , "token-starts-at" .= eaiTokenStartsAt
    , "public-keys" .= keys eaiPublicKeys
    , "base-url" .= eaiBaseUrl
    , "last-alive" .= eaiLastAlive
    , "config" .= eaiConfig
    ]

instance FromJSON ExternalApiInfo where
  parseJSON = withObject "ExternalApiInfo" $ \o -> do
    eaiIdent <- o .:? "ident"
    eaiTokenAuthority <- asum
      [ HashSet.singleton . Right <$> o .: "token-authority"
      , (o .: "token-authority" :: _ (HashSet Value)) >>= foldMapM (\v' -> fmap HashSet.singleton $ (Right <$> parseJSON v') <|> return (Left v'))
      , HashSet.singleton . Left  <$> o .: "token-authority"
      ]
    eaiTokenIssued <- o .: "token-issued"
    eaiTokenExpiresAt <- o .: "token-expires-at"
    eaiTokenStartsAt <- o .: "token-starts-at"
    eaiPublicKeys <- JwkSet <$> o .: "public-keys"
    eaiBaseUrl <- o .: "base-url"
    eaiLastAlive <- o .: "last-alive"
    eaiConfig <- o .: "config"
    return ExternalApiInfo{..}

instance ToSchema ExternalApiInfo where
  declareNamedSchema _ = do
    utcTimeSchema <- declareSchemaRef $ Proxy @UTCTime
    jwkSetSchema <- declareSchemaRef $ Proxy @[Jwk]
    baseUrlSchema <- declareSchemaRef $ Proxy @BaseUrl
    externalApiConfigSchema <- declareSchemaRef $ Proxy @ExternalApiConfig
    uuidSchema <- declareSchemaRef $ Proxy @UUID
    
    pure . named "ExternalApiInfo" $ mempty
      & type_ ?~ SwaggerObject
      & properties .~ mconcat
          [ HashMap.InsOrd.singleton "ident" uuidSchema
          , HashMap.InsOrd.singleton "token-authority" $ Inline mempty
          , HashMap.InsOrd.singleton "token-issued" utcTimeSchema
          , HashMap.InsOrd.singleton "token-expires-at" utcTimeSchema
          , HashMap.InsOrd.singleton "token-starts-at" utcTimeSchema
          , HashMap.InsOrd.singleton "public-keys" jwkSetSchema
          , HashMap.InsOrd.singleton "base-url" baseUrlSchema
          , HashMap.InsOrd.singleton "last-alive" utcTimeSchema
          , HashMap.InsOrd.singleton "config" externalApiConfigSchema
          ]
      & required .~ ["token-authority", "token-issued", "token-expires-at", "token-starts-at", "public-keys", "base-url", "last-alive", "config"]

instance ToSample ExternalApiInfo where
  toSamples _ = samples $ do
    (_, eaiIdent) <- toSamples Proxy
    
    let eaiTokenAuthority' = do
          specificUser <- [False, True]
          if | specificUser -> Right <$> map (unTagged . snd) (toSamples $ Proxy @(Tagged UserId CryptoUUIDUser))
             | otherwise    -> Left <$> map (toJSON . snd) (toSamples $ Proxy @UserGroupName)
    eaiTokenAuthority <- fmap HashSet.fromList $ flip replicateM eaiTokenAuthority' =<< [0..]

    (_, eaiTokenIssued) <- toSamples Proxy
    (_, eaiTokenExpiresAt) <- toSamples Proxy
    (_, eaiTokenStartsAt) <- toSamples Proxy
    (_, eaiLastAlive) <- toSamples Proxy

    -- If times didn't match up this instance could not have registered
    guard $ NTop (Just eaiTokenIssued) <= NTop eaiTokenExpiresAt
    guard $ NTop (Just <$> eaiTokenExpiresAt) >= NTop (Just eaiTokenStartsAt)
    guard $ eaiLastAlive >= eaiTokenIssued
         && Just eaiLastAlive >= eaiTokenStartsAt
         && NTop (Just eaiLastAlive) <= NTop eaiTokenExpiresAt
    
    (_, eaiBaseUrl) <- toSamples Proxy
    (_, eaiConfig) <- toSamples Proxy

    (_, eaiPublicKeys) <- toSamples Proxy
      & traverse . _2 . _keys %~ filter isPublicJwk

    return ExternalApiInfo{..}


isPublicJwk, isPrivateJwk :: Jwk -> Bool
isPublicJwk RsaPublicJwk{} = True
isPublicJwk EcPublicJwk{}  = True
isPublicJwk _              = False
isPrivateJwk RsaPrivateJwk{} = True
isPrivateJwk EcPrivateJwk{}  = True
isPrivateJwk _               = False


makeLenses_ ''ExternalApiInfo
