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
(Recipient -> Recipient -> Bool)
-> (Recipient -> Recipient -> Bool) -> Eq Recipient
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Recipient -> Recipient -> Bool
== :: Recipient -> Recipient -> Bool
$c/= :: Recipient -> Recipient -> Bool
/= :: Recipient -> Recipient -> Bool
Eq, Int -> Recipient -> ShowS
[Recipient] -> ShowS
Recipient -> String
(Int -> Recipient -> ShowS)
-> (Recipient -> String)
-> ([Recipient] -> ShowS)
-> Show Recipient
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Recipient -> ShowS
showsPrec :: Int -> Recipient -> ShowS
$cshow :: Recipient -> String
show :: Recipient -> String
$cshowList :: [Recipient] -> ShowS
showList :: [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
(Count -> Count -> Bool) -> (Count -> Count -> Bool) -> Eq Count
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Count -> Count -> Bool
== :: Count -> Count -> Bool
$c/= :: Count -> Count -> Bool
/= :: Count -> Count -> Bool
Eq, Int -> Count -> ShowS
[Count] -> ShowS
Count -> String
(Int -> Count -> ShowS)
-> (Count -> String) -> ([Count] -> ShowS) -> Show Count
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Count -> ShowS
showsPrec :: Int -> Count -> ShowS
$cshow :: Count -> String
show :: Count -> String
$cshowList :: [Count] -> ShowS
showList :: [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
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
/= :: Name -> Name -> Bool
Eq, Eq Name
Eq Name =>
(Name -> Name -> Ordering)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Name)
-> (Name -> Name -> Name)
-> Ord 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
$ccompare :: Name -> Name -> Ordering
compare :: Name -> Name -> Ordering
$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
>= :: Name -> Name -> Bool
$cmax :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
min :: Name -> Name -> Name
Ord, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Name -> ShowS
showsPrec :: Int -> Name -> ShowS
$cshow :: Name -> String
show :: Name -> String
$cshowList :: [Name] -> ShowS
showList :: [Name] -> ShowS
Show)
    deriving newtype String -> Name
(String -> Name) -> IsString Name
forall a. (String -> a) -> IsString a
$cfromString :: String -> Name
fromString :: 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
(Names -> Names -> Bool) -> (Names -> Names -> Bool) -> Eq Names
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Names -> Names -> Bool
== :: Names -> Names -> Bool
$c/= :: Names -> Names -> Bool
/= :: Names -> Names -> Bool
Eq, Int -> Names -> ShowS
[Names] -> ShowS
Names -> String
(Int -> Names -> ShowS)
-> (Names -> String) -> ([Names] -> ShowS) -> Show Names
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Names -> ShowS
showsPrec :: Int -> Names -> ShowS
$cshow :: Names -> String
show :: Names -> String
$cshowList :: [Names] -> ShowS
showList :: [Names] -> ShowS
Show)

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

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

instance Exception Error where
    fromException :: SomeException -> Maybe Error
fromException (SomeException e
e) = e -> Maybe Error
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e
    toException :: Error -> SomeException
toException = Error -> SomeException
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) Text -> Text -> Text
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) Text -> Text -> Text
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 (Name -> Text) -> [Name] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
xs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
                    ]
            ]

quote :: Text -> Text
quote :: Text -> Text
quote Text
x = Text
"‘" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
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 (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> String
forall a. Show a => a -> String
show

unwords :: [Text] -> String
unwords :: [Text] -> String
unwords = Text -> String
Text.unpack (Text -> String) -> ([Text] -> Text) -> [Text] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
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