----------------------------------------------------------------------------------------------------

-- | Streaming interface to journalctl. Use 'entryStream' to stream
--   journalctl entries as they are created.
--
--   Designed with qualified import in mind.
--   For example, if you import it as @Journal@, then 'Entry' becomes
--   @Journal.Entry@, and 'Exception' becomes @Journal.Exception@.
--
module Systemd.Journalctl.Stream (
    -- * Journal entry
    Entry (..)
  , Cursor
    -- * Streaming
  , entryStream
    -- * Exceptions
  , Exception
  ) where

-- base
import System.IO (Handle)
import Data.Maybe (fromJust)
import Control.Exception qualified as Base
-- text
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
-- unix
import System.Posix.Types (CPid (..), ProcessID)
-- aeson
import Data.Aeson (FromJSON, (.:), (.:?))
import Data.Aeson qualified as JSON
-- time
import Data.Time.Clock (secondsToNominalDiffTime)
import Data.Time.Clock.POSIX (POSIXTime)
-- process
import System.Process qualified as System
-- conduit
import Conduit (MonadResource, MonadThrow, throwM)
import Data.Conduit (ConduitT, (.|))
import Data.Conduit.Combinators qualified as Conduit

-- | A cursor is an opaque text string that uniquely describes
--   the position of an entry in the journal and is portable
--   across machines, platforms and journal files.
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

-- | A journal entry.
data Entry = Entry
  { -- | Process ID.
    Entry -> ProcessID
entryPID :: ProcessID
    -- | The name of the originating host.
  , Entry -> Text
entryHostname :: Text
    -- | The cursor for the entry.
  , Entry -> Cursor
entryCursor :: Cursor
    -- | The time the entry was received by the journal.
  , Entry -> POSIXTime
entryTimestamp :: POSIXTime
    -- | Unit name, if present.
  , Entry -> Maybe Text
entryUnit :: Maybe Text
    -- | Entry message.
  , 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"

-- | Exception raised while streaming entries from journalctl.
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

-- | Stream of journal entries.
entryStream
  :: (MonadResource m, MonadThrow m)
  => Maybe String -- ^ Filter by unit name.
  -> Int -- ^ Number of previous messages to stream.
  -> 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)