module Systemd.Journalctl.Stream (
Entry (..)
, Cursor
, StreamStart (..)
, entryStream
, Exception
) where
import System.IO (Handle)
import Data.Maybe (fromJust)
import Control.Exception qualified as Base
import System.Posix.Types (CPid (..), ProcessID)
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Data.Text qualified as Text
import Data.Aeson (FromJSON, (.:), (.:?), ToJSON)
import Data.Aeson qualified as JSON
import Data.Time.Clock (secondsToNominalDiffTime)
import Data.Time.Clock.POSIX (POSIXTime)
import Data.Time.LocalTime (LocalTime)
import Data.Time.Format (formatTime, defaultTimeLocale)
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, Eq Cursor
Cursor -> Cursor -> Bool
Cursor -> Cursor -> Ordering
Cursor -> Cursor -> Cursor
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 :: Cursor -> Cursor -> Cursor
$cmin :: Cursor -> Cursor -> Cursor
max :: Cursor -> Cursor -> Cursor
$cmax :: Cursor -> Cursor -> Cursor
>= :: Cursor -> Cursor -> Bool
$c>= :: Cursor -> Cursor -> Bool
> :: Cursor -> Cursor -> Bool
$c> :: Cursor -> Cursor -> Bool
<= :: Cursor -> Cursor -> Bool
$c<= :: Cursor -> Cursor -> Bool
< :: Cursor -> Cursor -> Bool
$c< :: Cursor -> Cursor -> Bool
compare :: Cursor -> Cursor -> Ordering
$ccompare :: Cursor -> Cursor -> Ordering
Ord, 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
instance ToJSON Cursor where
toJSON :: Cursor -> Value
toJSON (Cursor Text
t) = Text -> Value
JSON.String Text
t
data Entry = Entry
{
Entry -> Maybe ProcessID
entryPID :: Maybe ProcessID
, Entry -> Text
entryHostname :: Text
, Entry -> Maybe Text
entryNamespace :: Maybe Text
, Entry -> Maybe Text
entryProcess :: Maybe Text
, Entry -> Maybe String
entryExecutable :: Maybe FilePath
, 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 -> Maybe ProcessID
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe String
-> Cursor
-> POSIXTime
-> Maybe Text
-> Text
-> Entry
Entry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 (Maybe 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 (Maybe a)
.:? Key
"_NAMESPACE"
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
"_COMM"
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
"_EXE"
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
data StreamStart =
StartTime LocalTime
| Lines Int
| AtCursor Cursor
| AfterCursor Cursor
streamStartArgs :: StreamStart -> [String]
streamStartArgs :: StreamStart -> [String]
streamStartArgs (StartTime LocalTime
t) =
[ String
"--since", forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%F %T" LocalTime
t ]
streamStartArgs (Lines Int
n) =
[ String
"--lines" , forall a. Show a => a -> String
show Int
n ]
streamStartArgs (AtCursor (Cursor Text
t)) =
[ String
"--cursor", Text -> String
Text.unpack Text
t ]
streamStartArgs (AfterCursor (Cursor Text
t)) =
[ String
"--after-cursor", Text -> String
Text.unpack Text
t ]
entryStream
:: (MonadResource m, MonadThrow m)
=> StreamStart
-> ConduitT i Entry m ()
entryStream :: forall (m :: * -> *) i.
(MonadResource m, MonadThrow m) =>
StreamStart -> ConduitT i Entry m ()
entryStream StreamStart
start =
let args :: [String]
args :: [String]
args = StreamStart -> [String]
streamStartArgs StreamStart
start forall a. [a] -> [a] -> [a]
++ [ String
"--follow", String
"--output", String
"json" ]
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)