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.Foldable (toList)
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Data.Text qualified as Text
import Data.ByteString (ByteString)
import Data.ByteString qualified as ByteString
import Data.Aeson (FromJSON, parseJSON, (.:), (.:?), ToJSON)
import Data.Aeson qualified as JSON
import Data.Aeson.Types qualified as JSON
#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.KeyMap qualified as KeyMap
#endif
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
#if !MIN_VERSION_aeson(2,0,0)
import Data.HashMap.Strict qualified as HashMap
#endif
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 -> Maybe (Either ByteString Text)
entryMessage :: Maybe (Either ByteString 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
-> Maybe (Either ByteString 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 -> Parser (Maybe (Either ByteString Text))
messageParser Object
o
messageParser :: JSON.Object -> JSON.Parser (Maybe (Either ByteString Text))
messageParser :: Object -> Parser (Maybe (Either ByteString Text))
messageParser Object
obj =
#if MIN_VERSION_aeson(2,0,0)
case forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"MESSAGE" Object
obj of
#else
case HashMap.lookup "MESSAGE" obj of
#endif
Just (JSON.String Text
t) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Text
t
Just (JSON.Array Array
arr) -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
ByteString.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. FromJSON a => Value -> Parser a
parseJSON (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
arr)
Just Value
JSON.Null -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Maybe Value
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Maybe Value
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Couldn't parse MESSAGE. Expected String, Array or Null."
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)