module Systemd.Journalctl.Stream (
Entry (..)
, Cursor
, entryStream
, Exception
) where
import System.IO (Handle)
import Data.Maybe (fromJust)
import Control.Exception qualified as Base
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import System.Posix.Types (CPid (..), ProcessID)
import Data.Aeson (FromJSON, (.:), (.:?))
import Data.Aeson qualified as JSON
import Data.Time.Clock (secondsToNominalDiffTime)
import Data.Time.Clock.POSIX (POSIXTime)
import System.Process qualified as System
import Conduit (MonadResource, MonadThrow, throwM)
import Data.Conduit (ConduitT, (.|))
import Data.Conduit.Combinators qualified as Conduit
newtype Cursor = Cursor Text deriving (Cursor -> Cursor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cursor -> Cursor -> Bool
$c/= :: Cursor -> Cursor -> Bool
== :: Cursor -> Cursor -> Bool
$c== :: Cursor -> Cursor -> Bool
Eq, Int -> Cursor -> ShowS
[Cursor] -> ShowS
Cursor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cursor] -> ShowS
$cshowList :: [Cursor] -> ShowS
show :: Cursor -> String
$cshow :: Cursor -> String
showsPrec :: Int -> Cursor -> ShowS
$cshowsPrec :: Int -> Cursor -> ShowS
Show)
instance FromJSON Cursor where
parseJSON :: Value -> Parser Cursor
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"Cursor" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Cursor
Cursor
data Entry = Entry
{
Entry -> ProcessID
entryPID :: ProcessID
, Entry -> Text
entryHostname :: Text
, Entry -> Cursor
entryCursor :: Cursor
, Entry -> POSIXTime
entryTimestamp :: POSIXTime
, Entry -> Maybe Text
entryUnit :: Maybe Text
, Entry -> Text
entryMessage :: Text
} deriving Int -> Entry -> ShowS
[Entry] -> ShowS
Entry -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Entry] -> ShowS
$cshowList :: [Entry] -> ShowS
show :: Entry -> String
$cshow :: Entry -> String
showsPrec :: Int -> Entry -> ShowS
$cshowsPrec :: Int -> Entry -> ShowS
Show
newtype AsText a = AsText { forall a. AsText a -> a
asText :: a } deriving Int -> AsText a -> ShowS
forall a. Show a => Int -> AsText a -> ShowS
forall a. Show a => [AsText a] -> ShowS
forall a. Show a => AsText a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AsText a] -> ShowS
$cshowList :: forall a. Show a => [AsText a] -> ShowS
show :: AsText a -> String
$cshow :: forall a. Show a => AsText a -> String
showsPrec :: Int -> AsText a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> AsText a -> ShowS
Show
instance FromJSON a => FromJSON (AsText a) where
parseJSON :: Value -> Parser (AsText a)
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
JSON.withText String
"AsText" forall a b. (a -> b) -> a -> b
$
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> AsText a
AsText) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Either String a
JSON.eitherDecodeStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
instance FromJSON Entry where
parseJSON :: Value -> Parser Entry
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject String
"Entry" forall a b. (a -> b) -> a -> b
$ \Object
o -> ProcessID
-> Text -> Cursor -> POSIXTime -> Maybe Text -> Text -> Entry
Entry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int32 -> ProcessID
CPid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AsText a -> a
asText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_PID")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_HOSTNAME"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"__CURSOR"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Pico -> POSIXTime
secondsToNominalDiffTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Fractional a => a -> a -> a
/Pico
1000000) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. AsText a -> a
asText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"__REALTIME_TIMESTAMP")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"UNIT"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"MESSAGE"
data Exception = JSONError String deriving Int -> Exception -> ShowS
[Exception] -> ShowS
Exception -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Exception] -> ShowS
$cshowList :: [Exception] -> ShowS
show :: Exception -> String
$cshow :: Exception -> String
showsPrec :: Int -> Exception -> ShowS
$cshowsPrec :: Int -> Exception -> ShowS
Show
instance Base.Exception Exception where
entryStream
:: (MonadResource m, MonadThrow m)
=> Maybe String
-> Int
-> ConduitT i Entry m ()
entryStream :: forall (m :: * -> *) i.
(MonadResource m, MonadThrow m) =>
Maybe String -> Int -> ConduitT i Entry m ()
entryStream Maybe String
munit Int
n =
let args :: [String]
args :: [String]
args =
[ String
"--follow"
, String
"--lines"
, forall a. Show a => a -> String
show Int
n
, String
"--output"
, String
"json"
] forall a. [a] -> [a] -> [a]
++
(forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
unit -> [String
"--unit", String
unit]) Maybe String
munit)
hdl :: IO Handle
hdl :: IO Handle
hdl = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Maybe Handle
_, Maybe Handle
h, Maybe Handle
_, ProcessHandle
_) -> forall a. HasCallStack => Maybe a -> a
fromJust Maybe Handle
h)
forall a b. (a -> b) -> a -> b
$ CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
System.createProcess
forall a b. (a -> b) -> a -> b
$ (String -> [String] -> CreateProcess
System.proc String
"journalctl" [String]
args)
{ std_out :: StdStream
System.std_out = StdStream
System.CreatePipe
}
in forall (m :: * -> *) i.
MonadResource m =>
IO Handle -> ConduitT i ByteString m ()
Conduit.sourceIOHandle IO Handle
hdl
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) seq.
(Monad m, IsSequence seq, Element seq ~ Word8) =>
ConduitT seq seq m ()
Conduit.linesUnboundedAscii
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConduitT a b m ()
Conduit.mapM (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
JSONError) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Either String a
JSON.eitherDecodeStrict)