{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Simplex.Messaging.ServiceScheme
  ( ServiceScheme (..),
    SrvLoc (..),
    simplexChat,
  ) where

import Control.Applicative ((<|>))
import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.ByteString.Char8 as B
import Data.Functor (($>))
import Network.Socket (HostName, ServiceName)
import Simplex.Messaging.Encoding.String (StrEncoding (..))

data ServiceScheme = SSSimplex | SSAppServer SrvLoc
  deriving (ServiceScheme -> ServiceScheme -> Bool
(ServiceScheme -> ServiceScheme -> Bool)
-> (ServiceScheme -> ServiceScheme -> Bool) -> Eq ServiceScheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServiceScheme -> ServiceScheme -> Bool
== :: ServiceScheme -> ServiceScheme -> Bool
$c/= :: ServiceScheme -> ServiceScheme -> Bool
/= :: ServiceScheme -> ServiceScheme -> Bool
Eq, Int -> ServiceScheme -> ShowS
[ServiceScheme] -> ShowS
ServiceScheme -> String
(Int -> ServiceScheme -> ShowS)
-> (ServiceScheme -> String)
-> ([ServiceScheme] -> ShowS)
-> Show ServiceScheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServiceScheme -> ShowS
showsPrec :: Int -> ServiceScheme -> ShowS
$cshow :: ServiceScheme -> String
show :: ServiceScheme -> String
$cshowList :: [ServiceScheme] -> ShowS
showList :: [ServiceScheme] -> ShowS
Show)

instance StrEncoding ServiceScheme where
  strEncode :: ServiceScheme -> ByteString
strEncode = \case
    ServiceScheme
SSSimplex -> ByteString
"simplex:"
    SSAppServer SrvLoc
srv -> ByteString
"https://" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> SrvLoc -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode SrvLoc
srv
  strP :: Parser ServiceScheme
strP =
    Parser ByteString ByteString
"simplex:" Parser ByteString ByteString
-> ServiceScheme -> Parser ServiceScheme
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ServiceScheme
SSSimplex
      Parser ServiceScheme
-> Parser ServiceScheme -> Parser ServiceScheme
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ByteString
"https://" Parser ByteString ByteString
-> Parser ServiceScheme -> Parser ServiceScheme
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (SrvLoc -> ServiceScheme
SSAppServer (SrvLoc -> ServiceScheme)
-> Parser ByteString SrvLoc -> Parser ServiceScheme
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString SrvLoc
forall a. StrEncoding a => Parser a
strP)

data SrvLoc = SrvLoc HostName ServiceName
  deriving (SrvLoc -> SrvLoc -> Bool
(SrvLoc -> SrvLoc -> Bool)
-> (SrvLoc -> SrvLoc -> Bool) -> Eq SrvLoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SrvLoc -> SrvLoc -> Bool
== :: SrvLoc -> SrvLoc -> Bool
$c/= :: SrvLoc -> SrvLoc -> Bool
/= :: SrvLoc -> SrvLoc -> Bool
Eq, Eq SrvLoc
Eq SrvLoc =>
(SrvLoc -> SrvLoc -> Ordering)
-> (SrvLoc -> SrvLoc -> Bool)
-> (SrvLoc -> SrvLoc -> Bool)
-> (SrvLoc -> SrvLoc -> Bool)
-> (SrvLoc -> SrvLoc -> Bool)
-> (SrvLoc -> SrvLoc -> SrvLoc)
-> (SrvLoc -> SrvLoc -> SrvLoc)
-> Ord SrvLoc
SrvLoc -> SrvLoc -> Bool
SrvLoc -> SrvLoc -> Ordering
SrvLoc -> SrvLoc -> SrvLoc
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SrvLoc -> SrvLoc -> Ordering
compare :: SrvLoc -> SrvLoc -> Ordering
$c< :: SrvLoc -> SrvLoc -> Bool
< :: SrvLoc -> SrvLoc -> Bool
$c<= :: SrvLoc -> SrvLoc -> Bool
<= :: SrvLoc -> SrvLoc -> Bool
$c> :: SrvLoc -> SrvLoc -> Bool
> :: SrvLoc -> SrvLoc -> Bool
$c>= :: SrvLoc -> SrvLoc -> Bool
>= :: SrvLoc -> SrvLoc -> Bool
$cmax :: SrvLoc -> SrvLoc -> SrvLoc
max :: SrvLoc -> SrvLoc -> SrvLoc
$cmin :: SrvLoc -> SrvLoc -> SrvLoc
min :: SrvLoc -> SrvLoc -> SrvLoc
Ord, Int -> SrvLoc -> ShowS
[SrvLoc] -> ShowS
SrvLoc -> String
(Int -> SrvLoc -> ShowS)
-> (SrvLoc -> String) -> ([SrvLoc] -> ShowS) -> Show SrvLoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SrvLoc -> ShowS
showsPrec :: Int -> SrvLoc -> ShowS
$cshow :: SrvLoc -> String
show :: SrvLoc -> String
$cshowList :: [SrvLoc] -> ShowS
showList :: [SrvLoc] -> ShowS
Show)

instance StrEncoding SrvLoc where
  strEncode :: SrvLoc -> ByteString
strEncode (SrvLoc String
host String
port) = String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
host String -> ShowS
forall a. Semigroup a => a -> a -> a
<> if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
port then String
"" else Char
':' Char -> ShowS
forall a. a -> [a] -> [a]
: String
port
  strP :: Parser ByteString SrvLoc
strP = String -> String -> SrvLoc
SrvLoc (String -> String -> SrvLoc)
-> Parser ByteString String -> Parser ByteString (String -> SrvLoc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString String
host Parser ByteString (String -> SrvLoc)
-> Parser ByteString String -> Parser ByteString SrvLoc
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString String
port Parser ByteString String
-> Parser ByteString String -> Parser ByteString String
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser ByteString String
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"")
    where
      host :: Parser ByteString String
host = ByteString -> String
B.unpack (ByteString -> String)
-> Parser ByteString ByteString -> Parser ByteString String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString ByteString
A.takeWhile1 (String -> Char -> Bool
A.notInClass String
":#,;/ ")
      port :: Parser ByteString String
port = Int -> String
forall a. Show a => a -> String
show (Int -> String)
-> Parser ByteString Int -> Parser ByteString String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
A.char Char
':' Parser Char -> Parser ByteString Int -> Parser ByteString Int
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser ByteString Int
forall a. Integral a => Parser a
A.decimal :: A.Parser Int))

simplexChat :: ServiceScheme
simplexChat :: ServiceScheme
simplexChat = SrvLoc -> ServiceScheme
SSAppServer (SrvLoc -> ServiceScheme) -> SrvLoc -> ServiceScheme
forall a b. (a -> b) -> a -> b
$ String -> String -> SrvLoc
SrvLoc String
"simplex.chat" String
""