packages feed

systemd-socket-activation 1.1.0.0 → 1.1.0.1

raw patch · 11 files changed

+70/−97 lines, 11 filesdep +quaaludedep ~basedep ~unixPVP ok

version bump matches the API change (PVP)

Dependencies added: quaalude

Dependency ranges changed: base, unix

API changes (from Hackage documentation)

Files

changelog.md view
@@ -1,19 +1,27 @@-# 1.1.0.0 (2023-02-25)+## 1.1.0.1 (2023-02-25) +Various minor internal cleanup and simplification.++Added dependency on the `quaalude` package.++Haskell version is now GHC2021. Requires at least GHC 9.2.++## 1.1.0.0 (2023-02-25)+ The `NoSuchName` constructor of `Error` now has an additional field that indicates which sockets are available.  The `displayException` method of `Error` has been changed from the default implementation; it now constructs sentences. -# 1.0.0.2 (2023-01-08)+## 1.0.0.2 (2023-01-08)  Support GHC 9.4 -# 1.0.0.1 (2021-12-27)+## 1.0.0.1 (2021-12-27)  Support GHC 9.2 -# 1 (2021-07-07)+## 1 (2021-07-07)  Initial release
src/SocketActivation.hs view
@@ -5,8 +5,8 @@     )     where -import Control.Applicative (Applicative ((*>)))-import Control.Monad (Monad (return, (>>=)))+import Essentials+ import Data.Either (Either, either) import System.IO (IO, print) @@ -23,4 +23,4 @@ getMySocketByName name = f SA.checkRecipient *> f (SA.getSocketByName name)   where     f :: IO (Either Error a) -> IO a-    f = (>>= either (\e -> (SA.getEnvVars >>= print) *> Ex.throw e) return)+    f = (>>= either (\e -> (SA.getEnvVars >>= print) *> Ex.throw e) pure)
src/SocketActivation/CheckRecipient.hs view
@@ -2,13 +2,13 @@  module SocketActivation.CheckRecipient where -import Control.Monad (Monad (return, (>>=)))+import Essentials+ import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Either (Either)-import Data.Eq (Eq ((==)))-import Data.Function ((.)) import System.IO (IO) +import qualified Control.Monad as Monad import qualified System.Posix.Process as Sys  import SocketActivation.Concepts (Error(WrongProcess), Recipient (recipientPID))@@ -16,14 +16,11 @@ import SocketActivation.IO (IO' (IO', run), throwError)  checkRecipient :: IO (Either Error ())-checkRecipient = run (getIt >>= checkIt)-  where-    getIt = IO' (getEnv' @Recipient)-    checkIt = IO' . checkRecipient'+checkRecipient = run do+    recipient <- IO' $ getEnv' @Recipient+    IO' $ checkRecipient' recipient  checkRecipient' :: Recipient -> IO (Either Error ())-checkRecipient' x = run (getMyPid >>= throwIfDifferent)-  where-    getMyPid = liftIO Sys.getProcessID-    throwIfDifferent y =-        if recipientPID x == y then return () else throwError WrongProcess+checkRecipient' recipient = run do+    myPid <- liftIO Sys.getProcessID+    Monad.unless (recipientPID recipient == myPid) $ throwError WrongProcess
src/SocketActivation/Concepts.hs view
@@ -12,16 +12,15 @@     )     where +import Essentials+ import Control.Exception (Exception (..), SomeException (..))-import Data.Functor ((<$>))-import Data.Function ((.))-import Data.Semigroup ((<>))-import Data.String (IsString)+import Data.String (IsString, String) import Data.Text (Text) import Data.Typeable (cast) import Network.Socket (Socket) import Numeric.Natural (Natural)-import Prelude (Bounded, Enum, Eq, Ord, Show, String, show)+import Prelude (show) import System.Posix.Types (Fd (..), ProcessID)  import qualified Data.Text as Text
src/SocketActivation/Env.hs view
@@ -1,12 +1,10 @@ module SocketActivation.Env where -import Control.Monad (Monad (return, (>>=)))+import Essentials+ import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Either (Either, either)-import Data.Function (($), (.))-import Data.Maybe (Maybe (..), maybe) import Data.Text (Text)-import Data.Traversable (Traversable (traverse)) import Prelude (Bounded (maxBound, minBound)) import System.IO (IO) import Text.Show (show)@@ -20,26 +18,21 @@ import SocketActivation.Parsing (readRecipient, readCount, readNames)  getVarText :: VarName -> IO (Either Error Text)-getVarText name = run (getMaybe >>= throwIfMissing >>= pack)+getVarText name = run $ getMaybe >>= throwIfMissing <&> Text.pack   where-    throwIfMissing = maybe (throwError (Missing name)) return+    throwIfMissing = maybe (throwError (Missing name)) pure     getMaybe = liftIO $ Sys.lookupEnv $ show @VarName name-    pack = return . Text.pack  getEnvVars :: IO [(VarName, Maybe Text)]-getEnvVars =-    traverse-        (\x -> getVarText x >>= \y ->-            return (x, either (\_ -> Nothing) Just y))-        [minBound .. maxBound]+getEnvVars = [minBound .. maxBound] & traverse \x ->+    getVarText x <&> \y -> (x, either (\_ -> Nothing) Just y)  data Env a = Env VarName (Text -> Maybe a)  getEnv :: Env a -> IO (Either Error a)-getEnv (Env name read) = run (getText >>= readOrThrow)-  where-    getText = IO' (getVarText name)-    readOrThrow = maybe (throwError (Invalid name)) return . read+getEnv (Env name read) = run $+    IO' (getVarText name) >>=+    (maybe (throwError (Invalid name)) pure . read)  getEnv' :: Env' a => IO (Either Error a) getEnv' = getEnv env'
src/SocketActivation/GetByName.hs view
@@ -1,13 +1,11 @@ module SocketActivation.GetByName where -import Control.Applicative (Applicative ((<*>)), (<$>))-import Control.Monad (Monad (return, (>>=)))+import Essentials+ import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Either (Either)-import Data.Function ((.)) import Data.List (zip) import Data.Map (Map)-import Data.Maybe (maybe) import System.IO (IO)  import qualified Data.Map as Map@@ -20,30 +18,22 @@ import SocketActivation.IO (IO' (IO', run), throwError)  getNameList :: IO (Either Error [Name])-getNameList = run (getNames >>= unwrap)-  where-    getNames = IO' (getEnv' @Names)-    unwrap = return . namesList+getNameList = run $ IO' (getEnv' @Names) <&> namesList  getFileDescriptorMap :: IO (Either Error (Map Name Fd))-getFileDescriptorMap = run (entries >>= toMap)+getFileDescriptorMap = run $ entries <&> Map.fromList   where-    entries = zip <$> keys <*> values-    keys = IO' getNameList-    values = IO' getFileDescriptorList-    toMap = return . Map.fromList+    entries = zip <$> IO' getNameList <*> IO' getFileDescriptorList  getSocketMap :: IO (Either Error (Map Name Socket))-getSocketMap = run (entries >>= toMap)+getSocketMap = run (entries <&> Map.fromList)   where-    entries = zip <$> keys <*> values-    keys = IO' getNameList-    values = IO' getSocketList-    toMap = return . Map.fromList+    entries = zip <$> IO' getNameList <*> IO' getSocketList  getSocketByName :: Name -> IO (Either Error Socket)-getSocketByName name = run (getMap >>= findFd >>= convertToSocket)-  where-    getMap = IO' getFileDescriptorMap-    findFd m = maybe (throwError (NoSuchName name (Map.keys m))) return (Map.lookup name m)-    convertToSocket = liftIO . fdSocket+getSocketByName name = run do+    m <- IO' getFileDescriptorMap+    fd <- case Map.lookup name m of+        Nothing -> throwError (NoSuchName name (Map.keys m))+        Just x -> pure x+    liftIO $ fdSocket fd
src/SocketActivation/GetFileDescriptors.hs view
@@ -1,11 +1,9 @@ module SocketActivation.GetFileDescriptors where -import Control.Monad (Monad (return, (>>=)))+import Essentials+ import Data.Either (Either)-import Data.Function ((.))-import Data.Int (Int) import Data.List (take)-import Numeric.Natural (Natural) import Prelude (fromIntegral) import System.IO (IO) @@ -15,13 +13,7 @@  {-| Get a list of file descriptors for the sockets -} getFileDescriptorList :: IO (Either Error [Fd])-getFileDescriptorList = run (getCount >>= enumerateFds)-  where-    getCount = IO' (getEnv' @Count)-    enumerateFds = return . fds+getFileDescriptorList = run $ IO' (getEnv' @Count) <&> fds  fds :: Count -> [Fd]-fds n = take (convert n) [firstFd ..]-  where-    convert = (fromIntegral :: Natural -> Int) . countNat-    firstFd = Fd 3+fds n = take (fromIntegral (countNat n)) [Fd 3 ..]
src/SocketActivation/GetSockets.hs view
@@ -1,10 +1,9 @@ module SocketActivation.GetSockets where -import Control.Monad (Monad ((>>=)))+import Essentials+ import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Either (Either)-import Data.Function ((.))-import Data.Traversable (Traversable (traverse)) import System.IO (IO)  import qualified Network.Socket as Net@@ -14,10 +13,8 @@ import SocketActivation.IO (IO' (IO', run))  getSocketList :: IO (Either Error [Socket])-getSocketList = run (getFds >>= convertToSockets)-  where-    getFds = IO' getFileDescriptorList-    convertToSockets = traverse (liftIO . fdSocket)+getSocketList = run $+    IO' getFileDescriptorList >>= traverse (liftIO . fdSocket)  fdSocket :: Fd -> IO Socket fdSocket (Fd i) = Net.mkSocket i
src/SocketActivation/IO.hs view
@@ -1,11 +1,10 @@ module SocketActivation.IO where -import Control.Applicative (Applicative)-import Control.Monad (Functor, Monad (return))+import Essentials+ import Control.Monad.IO.Class (MonadIO) import Control.Monad.Trans.Except (ExceptT (..)) import Data.Either (Either (Left))-import Data.Function ((.)) import System.IO (IO)  import SocketActivation.Concepts (Error)@@ -14,4 +13,4 @@     deriving (Functor, Applicative, Monad, MonadIO) via ExceptT Error IO  throwError :: Error -> IO' a-throwError = IO' . return . Left+throwError = IO' . pure . Left
src/SocketActivation/Parsing.hs view
@@ -1,9 +1,8 @@ module SocketActivation.Parsing where -import Control.Monad (Functor (fmap), Monad (return), (>=>))+import Essentials+ import Data.Bits (toIntegralSized)-import Data.Function ((.))-import Data.Maybe (Maybe) import Data.Text (Text) import Foreign.C.Types (CInt) import Numeric.Natural (Natural)@@ -17,14 +16,14 @@ readRecipient = read >=> wrap   where     read = readMaybe @ProcessID . Text.unpack-    wrap = return . RecipientPID+    wrap = pure . RecipientPID  readCount :: Text -> Maybe Count readCount = read >=> convert >=> wrap   where     read = readMaybe @CInt . Text.unpack     convert = toIntegralSized :: CInt -> Maybe Natural-    wrap = return . CountNat+    wrap = pure . CountNat  readNames :: Text -> Names readNames = NamesList . fmap NameText . Text.splitOn ":"
systemd-socket-activation.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0  name: systemd-socket-activation-version: 1.1.0.0+version: 1.1.0.1 category: System, Network synopsis: Let systemd bind the server's socket for you @@ -28,14 +28,12 @@     location: https://github.com/typeclasses/systemd-socket-activation  library-    default-language: Haskell2010+    default-language: GHC2021     ghc-options: -Wall     hs-source-dirs: src -    default-extensions: DeriveAnyClass DerivingStrategies-        DerivingVia LambdaCase GeneralizedNewtypeDeriving+    default-extensions: BlockArguments DerivingVia LambdaCase         NoImplicitPrelude OverloadedStrings-        ScopedTypeVariables TypeApplications      exposed-modules:         SocketActivation@@ -51,8 +49,9 @@         SocketActivation.Parsing      build-depends:-      , base         ^>= 4.14 || ^>= 4.15 || ^>= 4.16 || ^>= 4.17+      , base         ^>= 4.16 || ^>= 4.17       , containers   ^>= 0.6.4+      , quaalude     ^>= 0.0.0       , network      ^>= 3.1.2       , text         ^>= 1.2.4 || ^>= 2.0       , transformers ^>= 0.5.6 || ^>= 0.6