{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}

module Simplex.Messaging.Server.Information
  ( ServerInformation (..),
    ServerPublicConfig (..),
    ServerPublicInfo (..),
    ServerPersistenceMode (..),
    ServerConditions (..),
    HostingType (..),
    Entity (..),
    ServerContactAddress (..),
    PGPKey (..),
    emptyServerInfo,
    hasServerInfo,
  ) where

import Data.Aeson (FromJSON (..), ToJSON (..))
import qualified Data.Aeson.TH as J
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Int (Int64)
import Data.Maybe (isJust)
import Data.Text (Text)
import Simplex.Messaging.Agent.Protocol (ConnectionLink, ConnectionMode (..))
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON)

data ServerInformation = ServerInformation
  { ServerInformation -> ServerPublicConfig
config :: ServerPublicConfig,
    ServerInformation -> Maybe ServerPublicInfo
information :: Maybe ServerPublicInfo
  }
  deriving (Int -> ServerInformation -> ShowS
[ServerInformation] -> ShowS
ServerInformation -> String
(Int -> ServerInformation -> ShowS)
-> (ServerInformation -> String)
-> ([ServerInformation] -> ShowS)
-> Show ServerInformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerInformation -> ShowS
showsPrec :: Int -> ServerInformation -> ShowS
$cshow :: ServerInformation -> String
show :: ServerInformation -> String
$cshowList :: [ServerInformation] -> ShowS
showList :: [ServerInformation] -> ShowS
Show)

-- based on server configuration
data ServerPublicConfig = ServerPublicConfig
  { ServerPublicConfig -> ServerPersistenceMode
persistence :: ServerPersistenceMode,
    ServerPublicConfig -> Maybe Int64
messageExpiration :: Maybe Int64,
    ServerPublicConfig -> Bool
statsEnabled :: Bool,
    ServerPublicConfig -> Bool
newQueuesAllowed :: Bool,
    ServerPublicConfig -> Bool
basicAuthEnabled :: Bool -- server is private if enabled
  }
  deriving (Int -> ServerPublicConfig -> ShowS
[ServerPublicConfig] -> ShowS
ServerPublicConfig -> String
(Int -> ServerPublicConfig -> ShowS)
-> (ServerPublicConfig -> String)
-> ([ServerPublicConfig] -> ShowS)
-> Show ServerPublicConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerPublicConfig -> ShowS
showsPrec :: Int -> ServerPublicConfig -> ShowS
$cshow :: ServerPublicConfig -> String
show :: ServerPublicConfig -> String
$cshowList :: [ServerPublicConfig] -> ShowS
showList :: [ServerPublicConfig] -> ShowS
Show)

-- based on INFORMATION section of INI file
data ServerPublicInfo = ServerPublicInfo
  { ServerPublicInfo -> Text
sourceCode :: Text, -- note that this property is not optional, in line with AGPLv3 license
    ServerPublicInfo -> Maybe ServerConditions
usageConditions :: Maybe ServerConditions,
    ServerPublicInfo -> Maybe Entity
operator :: Maybe Entity,
    ServerPublicInfo -> Maybe Text
website :: Maybe Text,
    ServerPublicInfo -> Maybe ServerContactAddress
adminContacts :: Maybe ServerContactAddress,
    ServerPublicInfo -> Maybe ServerContactAddress
complaintsContacts :: Maybe ServerContactAddress,
    ServerPublicInfo -> Maybe Entity
hosting :: Maybe Entity,
    ServerPublicInfo -> Maybe HostingType
hostingType :: Maybe HostingType,
    ServerPublicInfo -> Maybe Text
serverCountry :: Maybe Text
  }
  deriving (Int -> ServerPublicInfo -> ShowS
[ServerPublicInfo] -> ShowS
ServerPublicInfo -> String
(Int -> ServerPublicInfo -> ShowS)
-> (ServerPublicInfo -> String)
-> ([ServerPublicInfo] -> ShowS)
-> Show ServerPublicInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerPublicInfo -> ShowS
showsPrec :: Int -> ServerPublicInfo -> ShowS
$cshow :: ServerPublicInfo -> String
show :: ServerPublicInfo -> String
$cshowList :: [ServerPublicInfo] -> ShowS
showList :: [ServerPublicInfo] -> ShowS
Show)

emptyServerInfo :: Text -> ServerPublicInfo
emptyServerInfo :: Text -> ServerPublicInfo
emptyServerInfo Text
sourceCode =
  ServerPublicInfo
    { Text
$sel:sourceCode:ServerPublicInfo :: Text
sourceCode :: Text
sourceCode,
      $sel:usageConditions:ServerPublicInfo :: Maybe ServerConditions
usageConditions = Maybe ServerConditions
forall a. Maybe a
Nothing,
      $sel:operator:ServerPublicInfo :: Maybe Entity
operator = Maybe Entity
forall a. Maybe a
Nothing,
      $sel:website:ServerPublicInfo :: Maybe Text
website = Maybe Text
forall a. Maybe a
Nothing,
      $sel:adminContacts:ServerPublicInfo :: Maybe ServerContactAddress
adminContacts = Maybe ServerContactAddress
forall a. Maybe a
Nothing,
      $sel:complaintsContacts:ServerPublicInfo :: Maybe ServerContactAddress
complaintsContacts = Maybe ServerContactAddress
forall a. Maybe a
Nothing,
      $sel:hosting:ServerPublicInfo :: Maybe Entity
hosting = Maybe Entity
forall a. Maybe a
Nothing,
      $sel:hostingType:ServerPublicInfo :: Maybe HostingType
hostingType = Maybe HostingType
forall a. Maybe a
Nothing,
      $sel:serverCountry:ServerPublicInfo :: Maybe Text
serverCountry = Maybe Text
forall a. Maybe a
Nothing
    }

hasServerInfo :: ServerPublicInfo -> Bool
hasServerInfo :: ServerPublicInfo -> Bool
hasServerInfo ServerPublicInfo {Maybe ServerConditions
$sel:usageConditions:ServerPublicInfo :: ServerPublicInfo -> Maybe ServerConditions
usageConditions :: Maybe ServerConditions
usageConditions, Maybe Entity
$sel:operator:ServerPublicInfo :: ServerPublicInfo -> Maybe Entity
operator :: Maybe Entity
operator, Maybe Text
$sel:website:ServerPublicInfo :: ServerPublicInfo -> Maybe Text
website :: Maybe Text
website, Maybe ServerContactAddress
$sel:adminContacts:ServerPublicInfo :: ServerPublicInfo -> Maybe ServerContactAddress
adminContacts :: Maybe ServerContactAddress
adminContacts, Maybe ServerContactAddress
$sel:complaintsContacts:ServerPublicInfo :: ServerPublicInfo -> Maybe ServerContactAddress
complaintsContacts :: Maybe ServerContactAddress
complaintsContacts, Maybe Entity
$sel:hosting:ServerPublicInfo :: ServerPublicInfo -> Maybe Entity
hosting :: Maybe Entity
hosting, Maybe HostingType
$sel:hostingType:ServerPublicInfo :: ServerPublicInfo -> Maybe HostingType
hostingType :: Maybe HostingType
hostingType, Maybe Text
$sel:serverCountry:ServerPublicInfo :: ServerPublicInfo -> Maybe Text
serverCountry :: Maybe Text
serverCountry} =
  Maybe ServerConditions -> Bool
forall a. Maybe a -> Bool
isJust Maybe ServerConditions
usageConditions Bool -> Bool -> Bool
|| Maybe Entity -> Bool
forall a. Maybe a -> Bool
isJust Maybe Entity
operator Bool -> Bool -> Bool
|| Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
website Bool -> Bool -> Bool
|| Maybe ServerContactAddress -> Bool
forall a. Maybe a -> Bool
isJust Maybe ServerContactAddress
adminContacts Bool -> Bool -> Bool
|| Maybe ServerContactAddress -> Bool
forall a. Maybe a -> Bool
isJust Maybe ServerContactAddress
complaintsContacts Bool -> Bool -> Bool
|| Maybe Entity -> Bool
forall a. Maybe a -> Bool
isJust Maybe Entity
hosting Bool -> Bool -> Bool
|| Maybe HostingType -> Bool
forall a. Maybe a -> Bool
isJust Maybe HostingType
hostingType Bool -> Bool -> Bool
|| Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
serverCountry

data ServerPersistenceMode = SPMMemoryOnly | SPMQueues | SPMMessages
  deriving (Int -> ServerPersistenceMode -> ShowS
[ServerPersistenceMode] -> ShowS
ServerPersistenceMode -> String
(Int -> ServerPersistenceMode -> ShowS)
-> (ServerPersistenceMode -> String)
-> ([ServerPersistenceMode] -> ShowS)
-> Show ServerPersistenceMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerPersistenceMode -> ShowS
showsPrec :: Int -> ServerPersistenceMode -> ShowS
$cshow :: ServerPersistenceMode -> String
show :: ServerPersistenceMode -> String
$cshowList :: [ServerPersistenceMode] -> ShowS
showList :: [ServerPersistenceMode] -> ShowS
Show)

data ServerConditions = ServerConditions {ServerConditions -> Text
conditions :: Text, ServerConditions -> Maybe Text
amendments :: Maybe Text}
  deriving (Int -> ServerConditions -> ShowS
[ServerConditions] -> ShowS
ServerConditions -> String
(Int -> ServerConditions -> ShowS)
-> (ServerConditions -> String)
-> ([ServerConditions] -> ShowS)
-> Show ServerConditions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerConditions -> ShowS
showsPrec :: Int -> ServerConditions -> ShowS
$cshow :: ServerConditions -> String
show :: ServerConditions -> String
$cshowList :: [ServerConditions] -> ShowS
showList :: [ServerConditions] -> ShowS
Show)

data HostingType = HTVirtual | HTDedicated | HTColocation | HTOwned
  deriving (Int -> HostingType -> ShowS
[HostingType] -> ShowS
HostingType -> String
(Int -> HostingType -> ShowS)
-> (HostingType -> String)
-> ([HostingType] -> ShowS)
-> Show HostingType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HostingType -> ShowS
showsPrec :: Int -> HostingType -> ShowS
$cshow :: HostingType -> String
show :: HostingType -> String
$cshowList :: [HostingType] -> ShowS
showList :: [HostingType] -> ShowS
Show)

instance StrEncoding HostingType where
  strEncode :: HostingType -> ByteString
strEncode = \case
    HostingType
HTVirtual -> ByteString
"virtual"
    HostingType
HTDedicated -> ByteString
"dedicated"
    HostingType
HTColocation -> ByteString
"colocation"
    HostingType
HTOwned -> ByteString
"owned"
  strP :: Parser HostingType
strP =
    (Char -> Bool) -> Parser ByteString
A.takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser ByteString
-> (ByteString -> Parser HostingType) -> Parser HostingType
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      ByteString
"virtual" -> HostingType -> Parser HostingType
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HostingType
HTVirtual
      ByteString
"dedicated" -> HostingType -> Parser HostingType
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HostingType
HTDedicated
      ByteString
"colocation" -> HostingType -> Parser HostingType
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HostingType
HTColocation
      ByteString
"owned" -> HostingType -> Parser HostingType
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HostingType
HTOwned
      ByteString
_ -> String -> Parser HostingType
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"bad HostingType"

instance FromJSON HostingType where
  parseJSON :: Value -> Parser HostingType
parseJSON = String -> Value -> Parser HostingType
forall a. StrEncoding a => String -> Value -> Parser a
strParseJSON String
"HostingType"

instance ToJSON HostingType where
  toJSON :: HostingType -> Value
toJSON = HostingType -> Value
forall a. StrEncoding a => a -> Value
strToJSON
  toEncoding :: HostingType -> Encoding
toEncoding = HostingType -> Encoding
forall a. StrEncoding a => a -> Encoding
strToJEncoding

data Entity = Entity {Entity -> Text
name :: Text, Entity -> Maybe Text
country :: Maybe Text}
  deriving (Int -> Entity -> ShowS
[Entity] -> ShowS
Entity -> String
(Int -> Entity -> ShowS)
-> (Entity -> String) -> ([Entity] -> ShowS) -> Show Entity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Entity -> ShowS
showsPrec :: Int -> Entity -> ShowS
$cshow :: Entity -> String
show :: Entity -> String
$cshowList :: [Entity] -> ShowS
showList :: [Entity] -> ShowS
Show)

data ServerContactAddress = ServerContactAddress
  { ServerContactAddress -> Maybe (ConnectionLink 'CMContact)
simplex :: Maybe (ConnectionLink 'CMContact),
    ServerContactAddress -> Maybe Text
email :: Maybe Text, -- it is recommended that it matches DNS email address, if either is present
    ServerContactAddress -> Maybe PGPKey
pgp :: Maybe PGPKey
  }
  deriving (Int -> ServerContactAddress -> ShowS
[ServerContactAddress] -> ShowS
ServerContactAddress -> String
(Int -> ServerContactAddress -> ShowS)
-> (ServerContactAddress -> String)
-> ([ServerContactAddress] -> ShowS)
-> Show ServerContactAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerContactAddress -> ShowS
showsPrec :: Int -> ServerContactAddress -> ShowS
$cshow :: ServerContactAddress -> String
show :: ServerContactAddress -> String
$cshowList :: [ServerContactAddress] -> ShowS
showList :: [ServerContactAddress] -> ShowS
Show)

data PGPKey = PGPKey {PGPKey -> Text
pkURI :: Text, PGPKey -> Text
pkFingerprint :: Text}
  deriving (Int -> PGPKey -> ShowS
[PGPKey] -> ShowS
PGPKey -> String
(Int -> PGPKey -> ShowS)
-> (PGPKey -> String) -> ([PGPKey] -> ShowS) -> Show PGPKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PGPKey -> ShowS
showsPrec :: Int -> PGPKey -> ShowS
$cshow :: PGPKey -> String
show :: PGPKey -> String
$cshowList :: [PGPKey] -> ShowS
showList :: [PGPKey] -> ShowS
Show)

$(J.deriveJSON (enumJSON $ dropPrefix "SPM") ''ServerPersistenceMode)

$(J.deriveJSON defaultJSON ''ServerConditions)

$(J.deriveJSON defaultJSON ''Entity)

$(J.deriveJSON defaultJSON ''PGPKey)

$(J.deriveJSON defaultJSON ''ServerContactAddress)

$(J.deriveJSON defaultJSON ''ServerPublicConfig)

$(J.deriveJSON defaultJSON ''ServerPublicInfo)

$(J.deriveJSON defaultJSON ''ServerInformation)