{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UnboxedTuples #-}

{- | Parse RFC 3164 messages. For example:

> <133>Feb 25 14:09:07 webserver syslogd: restart
> <0>Oct 22 10:52:01 scapegoat.dmz.example.org sched[0]: That's All Folks!

This library assumes that the @TAG@ field described by section 5.3 of
RFC 3164 is a process name. It also assumes that the optional bracketed
number that follows it is a process id. This library also addresses three
common extensions to RFC 3164:

* Some vendors include a year after the timestamp. For example:
  @<14>Oct 15 11:14:59 2019 example.com ...@. When present, the year
  is parsed and provided to the user.
* Some vendors include a priority that preceeds the process name. For
  example: @<133>Aug 10 09:05:14 my-host notice tmsh[4726]: ...@. The
  Linux man page for @syslog.conf@ lists these options for priority:
  @debug@, @info@, @notice@, @warning@, @warn@, @err@, @error@, @crit@,
  @alert@, @emerg@, @panic@. If a process name begins with any of these
  keywords (followed by a space), the keyword and the trailing space
  are removed from the process name, and the keyword is made available
  in the @priority@ field.
* Cisco ASAs omit the hostname sometimes. This is totally bizarre and leads
  to messages that looks like: @<190>Jun 08 2022 14:46:28: message@. In
  this case, the hostname is set to the empty string.
-}
module Syslog.Bsd
  ( -- * Types
    Message (..)
  , Process (..)
  , Timestamp (..)

    -- * Full Decode
  , decode
  , parser

    -- * Parsing Fragments
  , takePriority
  , takeTimestamp
  , takeHostname
  , takeProcess
  ) where

import Prelude hiding (id)

import Control.Monad (when)
import Data.Bytes.Parser (Parser)
import Data.Bytes.Types (Bytes (Bytes))
import Data.Word (Word32, Word8)

import qualified Chronos
import qualified Data.Bytes as Bytes
import qualified Data.Bytes.Parser as Parser
import qualified Data.Bytes.Parser.Latin as Latin
import qualified Data.Bytes.Parser.Unsafe as Unsafe
import qualified Data.Bytes.Text.Latin1 as Latin1
import qualified Data.Maybe.Unpacked.Numeric.Word32 as Word32

data Message = Message
  { Message -> Word32
priority :: !Word32
  , Message -> Timestamp
timestamp :: !Timestamp
  , Message -> Bytes
hostname :: {-# UNPACK #-} !Bytes
  , Message -> Maybe Process
process :: !(Maybe Process)
  , Message -> Bytes
message :: {-# UNPACK #-} !Bytes
  }
  deriving (Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
(Int -> Message -> ShowS)
-> (Message -> String) -> ([Message] -> ShowS) -> Show Message
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Message -> ShowS
showsPrec :: Int -> Message -> ShowS
$cshow :: Message -> String
show :: Message -> String
$cshowList :: [Message] -> ShowS
showList :: [Message] -> ShowS
Show)

data Timestamp = Timestamp
  { Timestamp -> Month
month :: !Chronos.Month
  , Timestamp -> DayOfMonth
day :: !Chronos.DayOfMonth
  , Timestamp -> Word8
hour :: !Word8
  , Timestamp -> Word8
minute :: !Word8
  , Timestamp -> Word8
second :: !Word8
  , Timestamp -> Maybe
year :: {-# UNPACK #-} !Word32.Maybe
  -- ^ Section 5.1 of RFC 3164 notes that some software appends
  -- a four-character year after the time of day. Since hostnames
  -- cannot start with digits, we can parse this unambiguously. We
  -- extend RFC 3164 to handle these nonstandard years.
  }
  deriving (Int -> Timestamp -> ShowS
[Timestamp] -> ShowS
Timestamp -> String
(Int -> Timestamp -> ShowS)
-> (Timestamp -> String)
-> ([Timestamp] -> ShowS)
-> Show Timestamp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Timestamp -> ShowS
showsPrec :: Int -> Timestamp -> ShowS
$cshow :: Timestamp -> String
show :: Timestamp -> String
$cshowList :: [Timestamp] -> ShowS
showList :: [Timestamp] -> ShowS
Show)

data Process = Process
  { Process -> Bytes
priority :: {-# UNPACK #-} !Bytes
  -- ^ Priority is nonstandard. This field is the empty byte sequence
  -- when the priority is not present.
  , Process -> Bytes
name :: {-# UNPACK #-} !Bytes
  , Process -> Maybe
id :: {-# UNPACK #-} !Word32.Maybe
  }
  deriving (Int -> Process -> ShowS
[Process] -> ShowS
Process -> String
(Int -> Process -> ShowS)
-> (Process -> String) -> ([Process] -> ShowS) -> Show Process
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Process -> ShowS
showsPrec :: Int -> Process -> ShowS
$cshow :: Process -> String
show :: Process -> String
$cshowList :: [Process] -> ShowS
showList :: [Process] -> ShowS
Show)

-- | Run the RFC 3164 parser. See 'parser'.
decode :: Bytes -> Maybe Message
decode :: Bytes -> Maybe Message
decode = (forall s. Parser () s Message) -> Bytes -> Maybe Message
forall e a. (forall s. Parser e s a) -> Bytes -> Maybe a
Parser.parseBytesMaybe Parser () s Message
forall s. Parser () s Message
parser

{- | Parse a RFC 3164 message. Note that this is just @takePriority@,
@takeTimestamp@, @takeHostname, and @takeProcess@ called in sequence,
followed by skipping whitespace and then treating the remaining input
as the original message.
-}
parser :: Parser () s Message
parser :: forall s. Parser () s Message
parser = do
  Word32
priority <- () -> Parser () s Word32
forall e s. e -> Parser e s Word32
takePriority ()
  Timestamp
timestamp <- () -> Parser () s Timestamp
forall e s. e -> Parser e s Timestamp
takeTimestamp ()
  (Char -> Bool) -> Parser () s Bool
forall e s. (Char -> Bool) -> Parser e s Bool
Latin.trySatisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Parser () s Bool
-> (Bool -> Parser () s Message) -> Parser () s Message
forall a b. Parser () s a -> (a -> Parser () s b) -> Parser () s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> do
      Char -> Parser () s ()
forall e s. Char -> Parser e s ()
Latin.skipChar Char
' '
      Bytes
message <- Parser () s Bytes
forall e s. Parser e s Bytes
Parser.remaining
      Message -> Parser () s Message
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Message {Word32
$sel:priority:Message :: Word32
priority :: Word32
priority, Timestamp
$sel:timestamp:Message :: Timestamp
timestamp :: Timestamp
timestamp, $sel:hostname:Message :: Bytes
hostname = Bytes
Bytes.empty, $sel:process:Message :: Maybe Process
process = Maybe Process
forall a. Maybe a
Nothing, Bytes
$sel:message:Message :: Bytes
message :: Bytes
message}
    Bool
False -> do
      Bytes
hostname <- () -> Parser () s Bytes
forall e s. e -> Parser e s Bytes
takeHostname ()
      -- Watchguard includes a serial number and an ISO8601-encoded datetime
      -- in parenthesis before the process name. If we detect this, we skip over it.
      -- Note that, in compliant BSD-style syslog, there is no way for
      -- an open parenthesis to appear in this position. So, by doing
      -- this, we do not reject any good logs.
      () -> Parser () s Char
forall e s. e -> Parser e s Char
Latin.peek' () Parser () s Char -> (Char -> Parser () s ()) -> Parser () s ()
forall a b. Parser () s a -> (a -> Parser () s b) -> Parser () s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Char
c
          | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z' ->
              Parser () s () -> Parser () s () -> Parser () s ()
forall x s a e. Parser x s a -> Parser e s a -> Parser e s a
Parser.orElse
                ( do
                    (Char -> Bool) -> Parser () s ()
forall e s. (Char -> Bool) -> Parser e s ()
Latin.skipWhile (\Char
x -> (Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z') Bool -> Bool -> Bool
|| (Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'))
                    () -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
' '
                    () -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
'('
                    () -> Parser () s ()
forall e s. e -> Parser e s ()
Latin.skipDigits1 ()
                    () -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
'-'
                    () -> Parser () s ()
forall e s. e -> Parser e s ()
Latin.skipDigits1 ()
                    () -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
'-'
                    () -> Parser () s ()
forall e s. e -> Parser e s ()
Latin.skipDigits1 ()
                    () -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
'T'
                    () -> Parser () s ()
forall e s. e -> Parser e s ()
Latin.skipDigits1 ()
                    () -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
':'
                    () -> Parser () s ()
forall e s. e -> Parser e s ()
Latin.skipDigits1 ()
                    () -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
':'
                    () -> Parser () s ()
forall e s. e -> Parser e s ()
Latin.skipDigits1 ()
                    () -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
')'
                    () -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
Latin.char () Char
' '
                )
                (() -> Parser () s ()
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
        Char
_ -> () -> Parser () s ()
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Maybe Process
process <-
        (Char -> Bool) -> Parser () s Bool
forall e s. (Char -> Bool) -> Parser e s Bool
Latin.trySatisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') Parser () s Bool
-> (Bool -> Parser () s (Maybe Process))
-> Parser () s (Maybe Process)
forall a b. Parser () s a -> (a -> Parser () s b) -> Parser () s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Bool
True -> Maybe Process -> Parser () s (Maybe Process)
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Process
forall a. Maybe a
Nothing
          Bool
False -> do
            Process
p <- () -> Parser () s Process
forall e s. e -> Parser e s Process
takeProcess ()
            Maybe Process -> Parser () s (Maybe Process)
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Process -> Maybe Process
forall a. a -> Maybe a
Just Process
p)
      Char -> Parser () s ()
forall e s. Char -> Parser e s ()
Latin.skipChar Char
' '
      Bytes
message <- Parser () s Bytes
forall e s. Parser e s Bytes
Parser.remaining
      Message -> Parser () s Message
forall a. a -> Parser () s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Message {Word32
$sel:priority:Message :: Word32
priority :: Word32
priority, Timestamp
$sel:timestamp:Message :: Timestamp
timestamp :: Timestamp
timestamp, Bytes
$sel:hostname:Message :: Bytes
hostname :: Bytes
hostname, Maybe Process
$sel:process:Message :: Maybe Process
process :: Maybe Process
process, Bytes
$sel:message:Message :: Bytes
message :: Bytes
message}

{- | Consume the angle-bracketed priority. RFC 3164 does not allow
a space to follow the priority, so this does not consume a
trailing space.
-}
takePriority :: e -> Parser e s Word32
takePriority :: forall e s. e -> Parser e s Word32
takePriority e
e = do
  e -> Char -> Parser e s ()
forall e s. e -> Char -> Parser e s ()
Latin.char e
e Char
'<'
  Word32
priority <- e -> Parser e s Word32
forall e s. e -> Parser e s Word32
Latin.decWord32 e
e
  e -> Char -> Parser e s ()
forall e s. e -> Char -> Parser e s ()
Latin.char e
e Char
'>'
  Word32 -> Parser e s Word32
forall a. a -> Parser e s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
priority

{- | Consume the hostname and the space that follows it. Returns
the hostname.
-}
takeHostname :: e -> Parser e s Bytes
takeHostname :: forall e s. e -> Parser e s Bytes
takeHostname e
e =
  -- TODO: This should actually use a takeWhile1.
  e -> Char -> Parser e s Bytes
forall e s. e -> Char -> Parser e s Bytes
Latin.takeTrailedBy e
e Char
' '

{- | Consume the timestamp and the trailing space character if a trailing
space exists. Returns the parsed timestamp. This allows two extensions
to the RFC 3164 datetime format. The year may be present either right
after the day of the month or after the time of day.
-}
takeTimestamp :: e -> Parser e s Timestamp
takeTimestamp :: forall e s. e -> Parser e s Timestamp
takeTimestamp e
e = do
  Bytes
monthBytes <- e -> Int -> Parser e s Bytes
forall e s. e -> Int -> Parser e s Bytes
Parser.take e
e Int
3
  Month
month <- case Bytes -> Month
resolveMonth Bytes
monthBytes of
    Chronos.Month Int
12 -> e -> Parser e s Month
forall e s a. e -> Parser e s a
Parser.fail e
e
    Month
m -> Month -> Parser e s Month
forall a. a -> Parser e s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Month
m
  -- There might be two spaces here since single-digit days get
  -- padded with a space.
  e -> Char -> Parser e s ()
forall e s. e -> Char -> Parser e s ()
Latin.skipChar1 e
e Char
' '
  Word8
dayRaw <- e -> Parser e s Word8
forall e s. e -> Parser e s Word8
Latin.decWord8 e
e
  DayOfMonth
day <-
    if Word8
dayRaw Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
32
      then DayOfMonth -> Parser e s DayOfMonth
forall a. a -> Parser e s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> DayOfMonth
Chronos.DayOfMonth (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
dayRaw))
      else e -> Parser e s DayOfMonth
forall e s a. e -> Parser e s a
Parser.fail e
e
  e -> Char -> Parser e s ()
forall e s. e -> Char -> Parser e s ()
Latin.char e
e Char
' '
  Word32
hourOrYear <- e -> Parser e s Word32
forall e s. e -> Parser e s Word32
Latin.decWord32 e
e
  e -> Parser e s Char
forall e s. e -> Parser e s Char
Latin.any e
e Parser e s Char
-> (Char -> Parser e s Timestamp) -> Parser e s Timestamp
forall a b. Parser e s a -> (a -> Parser e s b) -> Parser e s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    -- We interpret the number as a year if it is followed by
    -- a space, and we interpret it as an hour if it is followed
    -- by a colon.
    Char
' ' -> do
      Word8
hour <- e -> Parser e s Word8
forall e s. e -> Parser e s Word8
Latin.decWord8 e
e
      Bool -> Parser e s () -> Parser e s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
hour Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
23) (e -> Parser e s ()
forall e s a. e -> Parser e s a
Parser.fail e
e)
      e -> Char -> Parser e s ()
forall e s. e -> Char -> Parser e s ()
Latin.char e
e Char
':'
      Word8
minute <- e -> Parser e s Word8
forall e s. e -> Parser e s Word8
Latin.decWord8 e
e
      Bool -> Parser e s () -> Parser e s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
minute Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
59) (e -> Parser e s ()
forall e s a. e -> Parser e s a
Parser.fail e
e)
      e -> Char -> Parser e s ()
forall e s. e -> Char -> Parser e s ()
Latin.char e
e Char
':'
      Word8
second <- e -> Parser e s Word8
forall e s. e -> Parser e s Word8
Latin.decWord8 e
e
      Bool -> Parser e s () -> Parser e s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
second Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
59) (e -> Parser e s ()
forall e s a. e -> Parser e s a
Parser.fail e
e)
      Bool
_ <- (Char -> Bool) -> Parser e s Bool
forall e s. (Char -> Bool) -> Parser e s Bool
Latin.trySatisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')
      Timestamp -> Parser e s Timestamp
forall a. a -> Parser e s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Timestamp {Month
$sel:month:Timestamp :: Month
month :: Month
month, DayOfMonth
$sel:day:Timestamp :: DayOfMonth
day :: DayOfMonth
day, Word8
$sel:hour:Timestamp :: Word8
hour :: Word8
hour, Word8
$sel:minute:Timestamp :: Word8
minute :: Word8
minute, Word8
$sel:second:Timestamp :: Word8
second :: Word8
second, $sel:year:Timestamp :: Maybe
year = Word32 -> Maybe
Word32.just Word32
hourOrYear}
    Char
':' -> do
      Bool -> Parser e s () -> Parser e s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
hourOrYear Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
23) (e -> Parser e s ()
forall e s a. e -> Parser e s a
Parser.fail e
e)
      let hour :: Word8
hour = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Word8 Word32
hourOrYear
      Word8
minute <- e -> Parser e s Word8
forall e s. e -> Parser e s Word8
Latin.decWord8 e
e
      Bool -> Parser e s () -> Parser e s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
minute Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
59) (e -> Parser e s ()
forall e s a. e -> Parser e s a
Parser.fail e
e)
      e -> Char -> Parser e s ()
forall e s. e -> Char -> Parser e s ()
Latin.char e
e Char
':'
      Word8
second <- e -> Parser e s Word8
forall e s. e -> Parser e s Word8
Latin.decWord8 e
e
      Bool -> Parser e s () -> Parser e s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
second Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
59) (e -> Parser e s ()
forall e s a. e -> Parser e s a
Parser.fail e
e)
      (Char -> Bool) -> Parser e s Bool
forall e s. (Char -> Bool) -> Parser e s Bool
Latin.trySatisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Parser e s Bool
-> (Bool -> Parser e s Timestamp) -> Parser e s Timestamp
forall a b. Parser e s a -> (a -> Parser e s b) -> Parser e s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
False -> Timestamp -> Parser e s Timestamp
forall a. a -> Parser e s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Timestamp {Month
$sel:month:Timestamp :: Month
month :: Month
month, DayOfMonth
$sel:day:Timestamp :: DayOfMonth
day :: DayOfMonth
day, Word8
$sel:hour:Timestamp :: Word8
hour :: Word8
hour, Word8
$sel:minute:Timestamp :: Word8
minute :: Word8
minute, Word8
$sel:second:Timestamp :: Word8
second :: Word8
second, $sel:year:Timestamp :: Maybe
year = Maybe
Word32.nothing}
        Bool
True -> do
          -- The only good way to allow a year is with backtracking. We do not
          -- learn until we encounter the space following the decimal number
          -- whether it was a year or part of a hostname (likely an ip address).
          Parser e s Timestamp
-> Parser e s Timestamp -> Parser e s Timestamp
forall x s a e. Parser x s a -> Parser e s a -> Parser e s a
Parser.orElse
            ( do
                Word32
y <- e -> Parser e s Word32
forall e s. e -> Parser e s Word32
Latin.decWord32 e
e
                e -> Char -> Parser e s ()
forall e s. e -> Char -> Parser e s ()
Latin.char e
e Char
' '
                Timestamp -> Parser e s Timestamp
forall a. a -> Parser e s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Timestamp {Month
$sel:month:Timestamp :: Month
month :: Month
month, DayOfMonth
$sel:day:Timestamp :: DayOfMonth
day :: DayOfMonth
day, Word8
$sel:hour:Timestamp :: Word8
hour :: Word8
hour, Word8
$sel:minute:Timestamp :: Word8
minute :: Word8
minute, Word8
$sel:second:Timestamp :: Word8
second :: Word8
second, $sel:year:Timestamp :: Maybe
year = Word32 -> Maybe
Word32.just Word32
y}
            )
            (Timestamp -> Parser e s Timestamp
forall a. a -> Parser e s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Timestamp {Month
$sel:month:Timestamp :: Month
month :: Month
month, DayOfMonth
$sel:day:Timestamp :: DayOfMonth
day :: DayOfMonth
day, Word8
$sel:hour:Timestamp :: Word8
hour :: Word8
hour, Word8
$sel:minute:Timestamp :: Word8
minute :: Word8
minute, Word8
$sel:second:Timestamp :: Word8
second :: Word8
second, $sel:year:Timestamp :: Maybe
year = Maybe
Word32.nothing})
    Char
_ -> e -> Parser e s Timestamp
forall e s a. e -> Parser e s a
Parser.fail e
e

{- | Take the process name and the process id and consume the colon
that follows them. Does not consume any space after the colon.
-}
takeProcess :: e -> Parser e s Process
takeProcess :: forall e s. e -> Parser e s Process
takeProcess e
e = do
  Int
processStart <- Parser e s Int
forall e s. Parser e s Int
Unsafe.cursor
  Bool
hasPid <- e -> Word8 -> Word8 -> Parser e s Bool
forall e s. e -> Word8 -> Word8 -> Parser e s Bool
Parser.skipTrailedBy2 e
e Word8
0x3A Word8
0x5B
  Int
processEndSucc <- Parser e s Int
forall e s. Parser e s Int
Unsafe.cursor
  ByteArray
arr <- Parser e s ByteArray
forall e s. Parser e s ByteArray
Unsafe.expose
  let name0 :: Bytes
name0 = ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr Int
processStart ((Int
processEndSucc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
processStart)
      !(# Bytes
name, Bytes
priority #) = case Word8 -> Bytes -> Maybe (Bytes, Bytes)
Bytes.split1 Word8
0x20 Bytes
name0 of
        Just (Bytes
pre, Bytes
post)
          | Char -> Char -> Char -> Bytes -> Bool
Latin1.equals3 Char
'e' Char
'r' Char
'r' Bytes
pre -> (# Bytes
post, Bytes
pre #)
          | Char -> Char -> Char -> Char -> Bytes -> Bool
Latin1.equals4 Char
'c' Char
'r' Char
'i' Char
't' Bytes
pre -> (# Bytes
post, Bytes
pre #)
          | Char -> Char -> Char -> Char -> Bytes -> Bool
Latin1.equals4 Char
'i' Char
'n' Char
'f' Char
'o' Bytes
pre -> (# Bytes
post, Bytes
pre #)
          | Char -> Char -> Char -> Char -> Bytes -> Bool
Latin1.equals4 Char
'w' Char
'a' Char
'r' Char
'n' Bytes
pre -> (# Bytes
post, Bytes
pre #)
          | Char -> Char -> Char -> Char -> Char -> Bytes -> Bool
Latin1.equals5 Char
'a' Char
'l' Char
'e' Char
'r' Char
't' Bytes
pre -> (# Bytes
post, Bytes
pre #)
          | Char -> Char -> Char -> Char -> Char -> Bytes -> Bool
Latin1.equals5 Char
'd' Char
'e' Char
'b' Char
'u' Char
'g' Bytes
pre -> (# Bytes
post, Bytes
pre #)
          | Char -> Char -> Char -> Char -> Char -> Bytes -> Bool
Latin1.equals5 Char
'e' Char
'm' Char
'e' Char
'r' Char
'g' Bytes
pre -> (# Bytes
post, Bytes
pre #)
          | Char -> Char -> Char -> Char -> Char -> Bytes -> Bool
Latin1.equals5 Char
'e' Char
'r' Char
'r' Char
'o' Char
'r' Bytes
pre -> (# Bytes
post, Bytes
pre #)
          | Char -> Char -> Char -> Char -> Char -> Bytes -> Bool
Latin1.equals5 Char
'p' Char
'a' Char
'n' Char
'i' Char
'c' Bytes
pre -> (# Bytes
post, Bytes
pre #)
          | Char -> Char -> Char -> Char -> Char -> Char -> Bytes -> Bool
Latin1.equals6 Char
'n' Char
'o' Char
't' Char
'i' Char
'c' Char
'e' Bytes
pre -> (# Bytes
post, Bytes
pre #)
          | Char
-> Char -> Char -> Char -> Char -> Char -> Char -> Bytes -> Bool
Latin1.equals7 Char
'w' Char
'a' Char
'r' Char
'n' Char
'i' Char
'n' Char
'g' Bytes
pre -> (# Bytes
post, Bytes
pre #)
        Maybe (Bytes, Bytes)
_ -> (# Bytes
name0, ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
arr Int
0 Int
0 #)
  case Bool
hasPid of
    Bool
False -> Process -> Parser e s Process
forall a. a -> Parser e s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Process {Bytes
$sel:priority:Process :: Bytes
priority :: Bytes
priority, Bytes
$sel:name:Process :: Bytes
name :: Bytes
name, $sel:id:Process :: Maybe
id = Maybe
Word32.nothing}
    Bool
True -> do
      Word32
pid <- e -> Parser e s Word32
forall e s. e -> Parser e s Word32
Latin.decWord32 e
e
      e -> Char -> Char -> Parser e s ()
forall e s. e -> Char -> Char -> Parser e s ()
Latin.char2 e
e Char
']' Char
':'
      Process -> Parser e s Process
forall a. a -> Parser e s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Process {Bytes
$sel:priority:Process :: Bytes
priority :: Bytes
priority, Bytes
$sel:name:Process :: Bytes
name :: Bytes
name, $sel:id:Process :: Maybe
id = Word32 -> Maybe
Word32.just Word32
pid}

-- Precondition: length of bytes is 3
resolveMonth :: Bytes -> Chronos.Month
resolveMonth :: Bytes -> Month
resolveMonth Bytes
b
  | Char -> Char -> Char -> Bytes -> Bool
Latin1.equals3 Char
'A' Char
'p' Char
'r' Bytes
b = Month
Chronos.april
  | Char -> Char -> Char -> Bytes -> Bool
Latin1.equals3 Char
'A' Char
'u' Char
'g' Bytes
b = Month
Chronos.august
  | Char -> Char -> Char -> Bytes -> Bool
Latin1.equals3 Char
'D' Char
'e' Char
'c' Bytes
b = Month
Chronos.december
  | Char -> Char -> Char -> Bytes -> Bool
Latin1.equals3 Char
'F' Char
'e' Char
'b' Bytes
b = Month
Chronos.february
  | Char -> Char -> Char -> Bytes -> Bool
Latin1.equals3 Char
'J' Char
'a' Char
'n' Bytes
b = Month
Chronos.january
  | Char -> Char -> Char -> Bytes -> Bool
Latin1.equals3 Char
'J' Char
'u' Char
'l' Bytes
b = Month
Chronos.july
  | Char -> Char -> Char -> Bytes -> Bool
Latin1.equals3 Char
'J' Char
'u' Char
'n' Bytes
b = Month
Chronos.june
  | Char -> Char -> Char -> Bytes -> Bool
Latin1.equals3 Char
'M' Char
'a' Char
'r' Bytes
b = Month
Chronos.march
  | Char -> Char -> Char -> Bytes -> Bool
Latin1.equals3 Char
'M' Char
'a' Char
'y' Bytes
b = Month
Chronos.may
  | Char -> Char -> Char -> Bytes -> Bool
Latin1.equals3 Char
'N' Char
'o' Char
'v' Bytes
b = Month
Chronos.november
  | Char -> Char -> Char -> Bytes -> Bool
Latin1.equals3 Char
'O' Char
'c' Char
't' Bytes
b = Month
Chronos.october
  | Char -> Char -> Char -> Bytes -> Bool
Latin1.equals3 Char
'S' Char
'e' Char
'p' Bytes
b = Month
Chronos.september
  | Bool
otherwise = Int -> Month
Chronos.Month Int
12