{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
-- | This module is completely exposed by 'Network.Gopher'
module Network.Gopher.Log
  ( GopherLogStr ()
  , makeSensitive
  , hideSensitive
  , GopherLogLevel (..)
  , ToGopherLogStr (..)
  , FromGopherLogStr (..)
  ) where

import Network.Gopher.Util (uEncode, uDecode)

import Data.ByteString.Builder (Builder ())
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Builder as BB
import qualified Data.Sequence as S
import Data.String (IsString (..))
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import System.Socket.Family.Inet6

-- | Indicates the log level of a 'GopherLogStr' to a
--   'Network.Gopher.GopherLogHandler'. If you want to
--   filter by log level you can use either the 'Ord'
--   or 'Enum' instance of 'GopherLogLevel' as the following
--   holds:
--
-- @
-- 'GopherLogLevelError' < 'GopherLogLevelWarn' < 'GopherLogLevelInfo'
-- @
data GopherLogLevel
  = GopherLogLevelError
  | GopherLogLevelWarn
  | GopherLogLevelInfo
  deriving (Int -> GopherLogLevel -> ShowS
[GopherLogLevel] -> ShowS
GopherLogLevel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GopherLogLevel] -> ShowS
$cshowList :: [GopherLogLevel] -> ShowS
show :: GopherLogLevel -> String
$cshow :: GopherLogLevel -> String
showsPrec :: Int -> GopherLogLevel -> ShowS
$cshowsPrec :: Int -> GopherLogLevel -> ShowS
Show, GopherLogLevel -> GopherLogLevel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GopherLogLevel -> GopherLogLevel -> Bool
$c/= :: GopherLogLevel -> GopherLogLevel -> Bool
== :: GopherLogLevel -> GopherLogLevel -> Bool
$c== :: GopherLogLevel -> GopherLogLevel -> Bool
Eq, Eq GopherLogLevel
GopherLogLevel -> GopherLogLevel -> Bool
GopherLogLevel -> GopherLogLevel -> Ordering
GopherLogLevel -> GopherLogLevel -> GopherLogLevel
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 :: GopherLogLevel -> GopherLogLevel -> GopherLogLevel
$cmin :: GopherLogLevel -> GopherLogLevel -> GopherLogLevel
max :: GopherLogLevel -> GopherLogLevel -> GopherLogLevel
$cmax :: GopherLogLevel -> GopherLogLevel -> GopherLogLevel
>= :: GopherLogLevel -> GopherLogLevel -> Bool
$c>= :: GopherLogLevel -> GopherLogLevel -> Bool
> :: GopherLogLevel -> GopherLogLevel -> Bool
$c> :: GopherLogLevel -> GopherLogLevel -> Bool
<= :: GopherLogLevel -> GopherLogLevel -> Bool
$c<= :: GopherLogLevel -> GopherLogLevel -> Bool
< :: GopherLogLevel -> GopherLogLevel -> Bool
$c< :: GopherLogLevel -> GopherLogLevel -> Bool
compare :: GopherLogLevel -> GopherLogLevel -> Ordering
$ccompare :: GopherLogLevel -> GopherLogLevel -> Ordering
Ord, Int -> GopherLogLevel
GopherLogLevel -> Int
GopherLogLevel -> [GopherLogLevel]
GopherLogLevel -> GopherLogLevel
GopherLogLevel -> GopherLogLevel -> [GopherLogLevel]
GopherLogLevel
-> GopherLogLevel -> GopherLogLevel -> [GopherLogLevel]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GopherLogLevel
-> GopherLogLevel -> GopherLogLevel -> [GopherLogLevel]
$cenumFromThenTo :: GopherLogLevel
-> GopherLogLevel -> GopherLogLevel -> [GopherLogLevel]
enumFromTo :: GopherLogLevel -> GopherLogLevel -> [GopherLogLevel]
$cenumFromTo :: GopherLogLevel -> GopherLogLevel -> [GopherLogLevel]
enumFromThen :: GopherLogLevel -> GopherLogLevel -> [GopherLogLevel]
$cenumFromThen :: GopherLogLevel -> GopherLogLevel -> [GopherLogLevel]
enumFrom :: GopherLogLevel -> [GopherLogLevel]
$cenumFrom :: GopherLogLevel -> [GopherLogLevel]
fromEnum :: GopherLogLevel -> Int
$cfromEnum :: GopherLogLevel -> Int
toEnum :: Int -> GopherLogLevel
$ctoEnum :: Int -> GopherLogLevel
pred :: GopherLogLevel -> GopherLogLevel
$cpred :: GopherLogLevel -> GopherLogLevel
succ :: GopherLogLevel -> GopherLogLevel
$csucc :: GopherLogLevel -> GopherLogLevel
Enum)

-- | UTF-8 encoded string which may have parts of it marked as
--   sensitive (see 'makeSensitive'). Use its 'ToGopherLogStr',
--   'Semigroup' and 'IsString' instances to construct
--   'GopherLogStr's and 'FromGopherLogStr' to convert to the
--   commonly used Haskell string types.
newtype GopherLogStr
  = GopherLogStr { GopherLogStr -> Seq GopherLogStrChunk
unGopherLogStr :: S.Seq GopherLogStrChunk }

instance Show GopherLogStr where
  show :: GopherLogStr -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. FromGopherLogStr a => GopherLogStr -> a
fromGopherLogStr :: GopherLogStr -> String)

instance Semigroup GopherLogStr where
  GopherLogStr Seq GopherLogStrChunk
s1 <> :: GopherLogStr -> GopherLogStr -> GopherLogStr
<> GopherLogStr Seq GopherLogStrChunk
s2 = Seq GopherLogStrChunk -> GopherLogStr
GopherLogStr (Seq GopherLogStrChunk
s1 forall a. Semigroup a => a -> a -> a
<> Seq GopherLogStrChunk
s2)

instance Monoid GopherLogStr where
  mempty :: GopherLogStr
mempty = Seq GopherLogStrChunk -> GopherLogStr
GopherLogStr forall a. Monoid a => a
mempty

instance IsString GopherLogStr where
  fromString :: String -> GopherLogStr
fromString = forall a. ToGopherLogStr a => a -> GopherLogStr
toGopherLogStr

data GopherLogStrChunk
  = GopherLogStrChunk
  { GopherLogStrChunk -> Bool
glscSensitive :: Bool
  , GopherLogStrChunk -> Builder
glscBuilder   :: Builder
  }

-- | Mark a 'GopherLogStr' as sensitive. This is used by this
--   library mostly to mark IP addresses of connecting clients.
--   By using 'hideSensitive' on a 'GopherLogStr' sensitive
--   parts will be hidden from the string — even if the sensitive
--   string was concatenated to other strings.
makeSensitive :: GopherLogStr -> GopherLogStr
makeSensitive :: GopherLogStr -> GopherLogStr
makeSensitive = Seq GopherLogStrChunk -> GopherLogStr
GopherLogStr
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\GopherLogStrChunk
c -> GopherLogStrChunk
c { glscSensitive :: Bool
glscSensitive = Bool
True })
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. GopherLogStr -> Seq GopherLogStrChunk
unGopherLogStr

-- | Replaces all chunks of the 'GopherLogStr' that have been
--   marked as sensitive by 'makeSensitive' with @[redacted]@.
--   Note that the chunking is dependent on the way the string
--   was assembled by the user and the internal implementation
--   of 'GopherLogStr' which can lead to multiple consecutive
--   @[redacted]@ being returned unexpectedly. This may be
--   improved in the future.
hideSensitive :: GopherLogStr -> GopherLogStr
hideSensitive :: GopherLogStr -> GopherLogStr
hideSensitive = Seq GopherLogStrChunk -> GopherLogStr
GopherLogStr
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\GopherLogStrChunk
c -> Bool -> Builder -> GopherLogStrChunk
GopherLogStrChunk Bool
False forall a b. (a -> b) -> a -> b
$
      if GopherLogStrChunk -> Bool
glscSensitive GopherLogStrChunk
c
        then ByteString -> Builder
BB.byteString ByteString
"[redacted]"
        else GopherLogStrChunk -> Builder
glscBuilder GopherLogStrChunk
c)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. GopherLogStr -> Seq GopherLogStrChunk
unGopherLogStr

-- | Convert 'GopherLogStr's to other string types. Since it is used
--   internally by 'GopherLogStr', it is best to use the 'Builder'
--   instance for performance if possible.
class FromGopherLogStr a where
  fromGopherLogStr :: GopherLogStr -> a

instance FromGopherLogStr GopherLogStr where
  fromGopherLogStr :: GopherLogStr -> GopherLogStr
fromGopherLogStr = forall a. a -> a
id

instance FromGopherLogStr Builder where
  fromGopherLogStr :: GopherLogStr -> Builder
fromGopherLogStr = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap GopherLogStrChunk -> Builder
glscBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. GopherLogStr -> Seq GopherLogStrChunk
unGopherLogStr

instance FromGopherLogStr BL.ByteString where
  fromGopherLogStr :: GopherLogStr -> ByteString
fromGopherLogStr = Builder -> ByteString
BB.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromGopherLogStr a => GopherLogStr -> a
fromGopherLogStr

instance FromGopherLogStr B.ByteString where
  fromGopherLogStr :: GopherLogStr -> ByteString
fromGopherLogStr = ByteString -> ByteString
BL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromGopherLogStr a => GopherLogStr -> a
fromGopherLogStr

instance FromGopherLogStr T.Text where
  fromGopherLogStr :: GopherLogStr -> Text
fromGopherLogStr = ByteString -> Text
T.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromGopherLogStr a => GopherLogStr -> a
fromGopherLogStr

instance FromGopherLogStr TL.Text where
  fromGopherLogStr :: GopherLogStr -> Text
fromGopherLogStr = ByteString -> Text
TL.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromGopherLogStr a => GopherLogStr -> a
fromGopherLogStr

instance FromGopherLogStr [Char] where
  fromGopherLogStr :: GopherLogStr -> String
fromGopherLogStr = ByteString -> String
uDecode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromGopherLogStr a => GopherLogStr -> a
fromGopherLogStr

-- | Convert something to a 'GopherLogStr'. In terms of
--   performance it is best to implement a 'Builder' for
--   the type you are trying to render to 'GopherLogStr'
--   and then reuse its 'ToGopherLogStr' instance.
class ToGopherLogStr a where
  toGopherLogStr :: a -> GopherLogStr

instance ToGopherLogStr GopherLogStr where
  toGopherLogStr :: GopherLogStr -> GopherLogStr
toGopherLogStr = forall a. a -> a
id

instance ToGopherLogStr Builder where
  toGopherLogStr :: Builder -> GopherLogStr
toGopherLogStr Builder
b = Seq GopherLogStrChunk -> GopherLogStr
GopherLogStr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Seq a
S.singleton
    forall a b. (a -> b) -> a -> b
$ GopherLogStrChunk
    { glscSensitive :: Bool
glscSensitive = Bool
False
    , glscBuilder :: Builder
glscBuilder = Builder
b
    }

instance ToGopherLogStr B.ByteString where
  toGopherLogStr :: ByteString -> GopherLogStr
toGopherLogStr = forall a. ToGopherLogStr a => a -> GopherLogStr
toGopherLogStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
BB.byteString

instance ToGopherLogStr BL.ByteString where
  toGopherLogStr :: ByteString -> GopherLogStr
toGopherLogStr = forall a. ToGopherLogStr a => a -> GopherLogStr
toGopherLogStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
BB.lazyByteString

instance ToGopherLogStr [Char] where
  toGopherLogStr :: String -> GopherLogStr
toGopherLogStr = forall a. ToGopherLogStr a => a -> GopherLogStr
toGopherLogStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
uEncode

instance ToGopherLogStr GopherLogLevel where
  toGopherLogStr :: GopherLogLevel -> GopherLogStr
toGopherLogStr GopherLogLevel
l =
    case GopherLogLevel
l of
      GopherLogLevel
GopherLogLevelInfo  -> forall a. ToGopherLogStr a => a -> GopherLogStr
toGopherLogStr (ByteString
"info"  :: B.ByteString)
      GopherLogLevel
GopherLogLevelWarn  -> forall a. ToGopherLogStr a => a -> GopherLogStr
toGopherLogStr (ByteString
"warn"  :: B.ByteString)
      GopherLogLevel
GopherLogLevelError -> forall a. ToGopherLogStr a => a -> GopherLogStr
toGopherLogStr (ByteString
"error" :: B.ByteString)

instance ToGopherLogStr (SocketAddress Inet6) where
  -- TODO shorten address if possible
  toGopherLogStr :: SocketAddress Inet6 -> GopherLogStr
toGopherLogStr (SocketAddressInet6 Inet6Address
addr Inet6Port
port Inet6FlowInfo
_ Inet6ScopeId
_) =
    let (Word16
b1, Word16
b2, Word16
b3, Word16
b4, Word16
b5, Word16
b6, Word16
b7, Word16
b8) = Inet6Address
-> (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
inet6AddressToTuple Inet6Address
addr
      in forall a. ToGopherLogStr a => a -> GopherLogStr
toGopherLogStr forall a b. (a -> b) -> a -> b
$
        Char -> Builder
BB.charUtf8 Char
'[' forall a. Semigroup a => a -> a -> a
<>
        Word16 -> Builder
BB.word16HexFixed Word16
b1 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
':' forall a. Semigroup a => a -> a -> a
<>
        Word16 -> Builder
BB.word16HexFixed Word16
b2 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
':' forall a. Semigroup a => a -> a -> a
<>
        Word16 -> Builder
BB.word16HexFixed Word16
b3 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
':' forall a. Semigroup a => a -> a -> a
<>
        Word16 -> Builder
BB.word16HexFixed Word16
b4 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
':' forall a. Semigroup a => a -> a -> a
<>
        Word16 -> Builder
BB.word16HexFixed Word16
b5 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
':' forall a. Semigroup a => a -> a -> a
<>
        Word16 -> Builder
BB.word16HexFixed Word16
b6 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
':' forall a. Semigroup a => a -> a -> a
<>
        Word16 -> Builder
BB.word16HexFixed Word16
b7 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
':' forall a. Semigroup a => a -> a -> a
<>
        Word16 -> Builder
BB.word16HexFixed Word16
b8 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
']' forall a. Semigroup a => a -> a -> a
<>
        Char -> Builder
BB.charUtf8 Char
':' forall a. Semigroup a => a -> a -> a
<> Int -> Builder
BB.intDec (forall a b. (Integral a, Num b) => a -> b
fromIntegral Inet6Port
port)