simplexmq/src/Simplex/Messaging/Server/Information.hs

{-# 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
  { config :: ServerPublicConfig,
    information :: Maybe ServerPublicInfo
  }
  deriving (Show)

-- based on server configuration
data ServerPublicConfig = ServerPublicConfig
  { persistence :: ServerPersistenceMode,
    messageExpiration :: Maybe Int64,
    statsEnabled :: Bool,
    newQueuesAllowed :: Bool,
    basicAuthEnabled :: Bool -- server is private if enabled
  }
  deriving (Show)

-- based on INFORMATION section of INI file
data ServerPublicInfo = ServerPublicInfo
  { sourceCode :: Text, -- note that this property is not optional, in line with AGPLv3 license
    usageConditions :: Maybe ServerConditions,
    operator :: Maybe Entity,
    website :: Maybe Text,
    adminContacts :: Maybe ServerContactAddress,
    complaintsContacts :: Maybe ServerContactAddress,
    hosting :: Maybe Entity,
    hostingType :: Maybe HostingType,
    serverCountry :: Maybe Text
  }
  deriving (Show)

emptyServerInfo :: Text -> ServerPublicInfo
emptyServerInfo sourceCode =
  ServerPublicInfo
    { sourceCode,
      usageConditions = Nothing,
      operator = Nothing,
      website = Nothing,
      adminContacts = Nothing,
      complaintsContacts = Nothing,
      hosting = Nothing,
      hostingType = Nothing,
      serverCountry = Nothing
    }

hasServerInfo :: ServerPublicInfo -> Bool
hasServerInfo ServerPublicInfo {usageConditions, operator, website, adminContacts, complaintsContacts, hosting, hostingType, serverCountry} =
  isJust usageConditions || isJust operator || isJust website || isJust adminContacts || isJust complaintsContacts || isJust hosting || isJust hostingType || isJust serverCountry

data ServerPersistenceMode = SPMMemoryOnly | SPMQueues | SPMMessages
  deriving (Show)

data ServerConditions = ServerConditions {conditions :: Text, amendments :: Maybe Text}
  deriving (Show)

data HostingType = HTVirtual | HTDedicated | HTColocation | HTOwned
  deriving (Show)

instance StrEncoding HostingType where
  strEncode = \case
    HTVirtual -> "virtual"
    HTDedicated -> "dedicated"
    HTColocation -> "colocation"
    HTOwned -> "owned"
  strP =
    A.takeTill (== ' ') >>= \case
      "virtual" -> pure HTVirtual
      "dedicated" -> pure HTDedicated
      "colocation" -> pure HTColocation
      "owned" -> pure HTOwned
      _ -> fail "bad HostingType"

instance FromJSON HostingType where
  parseJSON = strParseJSON "HostingType"

instance ToJSON HostingType where
  toJSON = strToJSON
  toEncoding = strToJEncoding

data Entity = Entity {name :: Text, country :: Maybe Text}
  deriving (Show)

data ServerContactAddress = ServerContactAddress
  { simplex :: Maybe (ConnectionLink 'CMContact),
    email :: Maybe Text, -- it is recommended that it matches DNS email address, if either is present
    pgp :: Maybe PGPKey
  }
  deriving (Show)

data PGPKey = PGPKey {pkURI :: Text, pkFingerprint :: Text}
  deriving (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)