module SocketActivation.Concepts
    (
        Recipient (..),
        ProcessID,
        Count (..),
        Name (..),
        Names (..),
        VarName (..),
        Fd (..),
        Socket,
        Error (..),
    )
    where

import Essentials

import Control.Exception (Exception (..), SomeException (..))
import Data.String (IsString, String)
import Data.Text (Text)
import Data.Typeable (cast)
import Network.Socket (Socket)
import Numeric.Natural (Natural)
import Prelude (show)
import System.Posix.Types (Fd (..), ProcessID)

import qualified Data.Text as Text

{-| The ID of the process to whom systemd has given the sockets

A process should not use sockets that are intended for someone else, so we
should always check that this matches our own PID before proceeding doing
anything with the sockets. -}
newtype Recipient = RecipientPID { Recipient -> ProcessID
recipientPID :: ProcessID }
    deriving stock (Recipient -> Recipient -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Recipient -> Recipient -> Bool
$c/= :: Recipient -> Recipient -> Bool
== :: Recipient -> Recipient -> Bool
$c== :: Recipient -> Recipient -> Bool
Eq, Int -> Recipient -> ShowS
[Recipient] -> ShowS
Recipient -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Recipient] -> ShowS
$cshowList :: [Recipient] -> ShowS
show :: Recipient -> String
$cshow :: Recipient -> String
showsPrec :: Int -> Recipient -> ShowS
$cshowsPrec :: Int -> Recipient -> ShowS
Show)

{-| The number of sockets that systemd has given the process -}
newtype Count = CountNat { Count -> Natural
countNat :: Natural }
    deriving stock (Count -> Count -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Count -> Count -> Bool
$c/= :: Count -> Count -> Bool
== :: Count -> Count -> Bool
$c== :: Count -> Count -> Bool
Eq, Int -> Count -> ShowS
[Count] -> ShowS
Count -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Count] -> ShowS
$cshowList :: [Count] -> ShowS
show :: Count -> String
$cshow :: Count -> String
showsPrec :: Int -> Count -> ShowS
$cshowsPrec :: Int -> Count -> ShowS
Show)

{-| The name of a socket, corresponding to the socket's FileDescriptorName in
    the systemd config -}
newtype Name = NameText { Name -> Text
nameText :: Text }
    deriving stock (Name -> Name -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq, Eq Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
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
min :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmax :: Name -> Name -> Name
>= :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c< :: Name -> Name -> Bool
compare :: Name -> Name -> Ordering
$ccompare :: Name -> Name -> Ordering
Ord, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show)
    deriving newtype String -> Name
forall a. (String -> a) -> IsString a
fromString :: String -> Name
$cfromString :: String -> Name
IsString

{-| The names of the sockets that we have been given, corresponding to the
    FileDescriptorName of each systemd socket -}
newtype Names = NamesList { Names -> [Name]
namesList :: [Name] }
    deriving stock (Names -> Names -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Names -> Names -> Bool
$c/= :: Names -> Names -> Bool
== :: Names -> Names -> Bool
$c== :: Names -> Names -> Bool
Eq, Int -> Names -> ShowS
[Names] -> ShowS
Names -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Names] -> ShowS
$cshowList :: [Names] -> ShowS
show :: Names -> String
$cshow :: Names -> String
showsPrec :: Int -> Names -> ShowS
$cshowsPrec :: Int -> Names -> ShowS
Show)

data VarName = LISTEN_PID | LISTEN_FDS | LISTEN_FDNAMES
    deriving stock (VarName -> VarName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VarName -> VarName -> Bool
$c/= :: VarName -> VarName -> Bool
== :: VarName -> VarName -> Bool
$c== :: VarName -> VarName -> Bool
Eq, Int -> VarName -> ShowS
[VarName] -> ShowS
VarName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VarName] -> ShowS
$cshowList :: [VarName] -> ShowS
show :: VarName -> String
$cshow :: VarName -> String
showsPrec :: Int -> VarName -> ShowS
$cshowsPrec :: Int -> VarName -> ShowS
Show, Int -> VarName
VarName -> Int
VarName -> [VarName]
VarName -> VarName
VarName -> VarName -> [VarName]
VarName -> VarName -> VarName -> [VarName]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: VarName -> VarName -> VarName -> [VarName]
$cenumFromThenTo :: VarName -> VarName -> VarName -> [VarName]
enumFromTo :: VarName -> VarName -> [VarName]
$cenumFromTo :: VarName -> VarName -> [VarName]
enumFromThen :: VarName -> VarName -> [VarName]
$cenumFromThen :: VarName -> VarName -> [VarName]
enumFrom :: VarName -> [VarName]
$cenumFrom :: VarName -> [VarName]
fromEnum :: VarName -> Int
$cfromEnum :: VarName -> Int
toEnum :: Int -> VarName
$ctoEnum :: Int -> VarName
pred :: VarName -> VarName
$cpred :: VarName -> VarName
succ :: VarName -> VarName
$csucc :: VarName -> VarName
Enum, VarName
forall a. a -> a -> Bounded a
maxBound :: VarName
$cmaxBound :: VarName
minBound :: VarName
$cminBound :: VarName
Bounded)

data Error =
    Missing VarName
  | Invalid VarName
  | WrongProcess
  | NoSuchName Name [Name]
    deriving stock Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show

instance Exception Error where
    fromException :: SomeException -> Maybe Error
fromException (SomeException e
e) = forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e
    toException :: Error -> SomeException
toException = forall e. Exception e => e -> SomeException
SomeException
    displayException :: Error -> String
displayException = \case
        Missing VarName
v -> [Text] -> String
unwords
            [ Text
"The environment variable"
            , forall a. Show a => a -> Text
tshow @VarName VarName
v
            , Text
"is required but not present."
            ]
        Invalid VarName
v -> [Text] -> String
unwords
            [ Text
"The environment variable"
            , forall a. Show a => a -> Text
tshow @VarName VarName
v
            , Text
"has a malformed value that could not be parsed."
            ]
        Error
WrongProcess -> [Text] -> String
unwords
            [ Text
"A socket is present, but it was rejected because"
            , forall a. Show a => a -> Text
tshow @VarName VarName
LISTEN_PID
            , Text
"differs from the current process ID."
            ]
        NoSuchName Name
wanted [Name]
found -> [Text] -> String
unwords
            [ Text
"Cannot find a socket named"
            , Text -> Text
quote (Name -> Text
nameText Name
wanted) forall a. Semigroup a => a -> a -> a
<> Text
"."
            , case [Name]
found of
                [] -> Text
"There are no available sockets."
                [Name
x] -> [Text] -> Text
Text.unwords
                    [ Text
"This is one available socket and its name is"
                    , Text -> Text
quote (Name -> Text
nameText Name
x) forall a. Semigroup a => a -> a -> a
<> Text
"."
                    ]
                [Name]
xs -> [Text] -> Text
Text.unwords
                    [ Text
"The available sockets are:"
                    , Text -> [Text] -> Text
Text.intercalate Text
", " (Name -> Text
nameText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
xs) forall a. Semigroup a => a -> a -> a
<> Text
"."
                    ]
            ]

quote :: Text -> Text
quote :: Text -> Text
quote Text
x = Text
"‘" forall a. Semigroup a => a -> a -> a
<> Text
x forall a. Semigroup a => a -> a -> a
<> Text
"’"

tshow :: forall a. Show a => a -> Text
tshow :: forall a. Show a => a -> Text
tshow = String -> Text
Text.pack forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Show a => a -> String
show

unwords :: [Text] -> String
unwords :: [Text] -> String
unwords = Text -> String
Text.unpack forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Text] -> Text
Text.unwords