{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
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
data GopherLogLevel
= GopherLogLevelError
| GopherLogLevelWarn
| GopherLogLevelInfo
deriving (Int -> GopherLogLevel -> ShowS
[GopherLogLevel] -> ShowS
GopherLogLevel -> String
(Int -> GopherLogLevel -> ShowS)
-> (GopherLogLevel -> String)
-> ([GopherLogLevel] -> ShowS)
-> Show GopherLogLevel
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
(GopherLogLevel -> GopherLogLevel -> Bool)
-> (GopherLogLevel -> GopherLogLevel -> Bool) -> Eq GopherLogLevel
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
Eq GopherLogLevel
-> (GopherLogLevel -> GopherLogLevel -> Ordering)
-> (GopherLogLevel -> GopherLogLevel -> Bool)
-> (GopherLogLevel -> GopherLogLevel -> Bool)
-> (GopherLogLevel -> GopherLogLevel -> Bool)
-> (GopherLogLevel -> GopherLogLevel -> Bool)
-> (GopherLogLevel -> GopherLogLevel -> GopherLogLevel)
-> (GopherLogLevel -> GopherLogLevel -> GopherLogLevel)
-> Ord 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
$cp1Ord :: Eq GopherLogLevel
Ord, Int -> GopherLogLevel
GopherLogLevel -> Int
GopherLogLevel -> [GopherLogLevel]
GopherLogLevel -> GopherLogLevel
GopherLogLevel -> GopherLogLevel -> [GopherLogLevel]
GopherLogLevel
-> GopherLogLevel -> GopherLogLevel -> [GopherLogLevel]
(GopherLogLevel -> GopherLogLevel)
-> (GopherLogLevel -> GopherLogLevel)
-> (Int -> GopherLogLevel)
-> (GopherLogLevel -> Int)
-> (GopherLogLevel -> [GopherLogLevel])
-> (GopherLogLevel -> GopherLogLevel -> [GopherLogLevel])
-> (GopherLogLevel -> GopherLogLevel -> [GopherLogLevel])
-> (GopherLogLevel
-> GopherLogLevel -> GopherLogLevel -> [GopherLogLevel])
-> Enum 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)
newtype GopherLogStr
= GopherLogStr { GopherLogStr -> Seq GopherLogStrChunk
unGopherLogStr :: S.Seq GopherLogStrChunk }
instance Show GopherLogStr where
show :: GopherLogStr -> String
show = ShowS
forall a. Show a => a -> String
show ShowS -> (GopherLogStr -> String) -> GopherLogStr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GopherLogStr -> String
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 Seq GopherLogStrChunk
-> Seq GopherLogStrChunk -> Seq GopherLogStrChunk
forall a. Semigroup a => a -> a -> a
<> Seq GopherLogStrChunk
s2)
instance Monoid GopherLogStr where
mempty :: GopherLogStr
mempty = Seq GopherLogStrChunk -> GopherLogStr
GopherLogStr Seq GopherLogStrChunk
forall a. Monoid a => a
mempty
instance IsString GopherLogStr where
fromString :: String -> GopherLogStr
fromString = String -> GopherLogStr
forall a. ToGopherLogStr a => a -> GopherLogStr
toGopherLogStr
data GopherLogStrChunk
= GopherLogStrChunk
{ GopherLogStrChunk -> Bool
glscSensitive :: Bool
, GopherLogStrChunk -> Builder
glscBuilder :: Builder
}
makeSensitive :: GopherLogStr -> GopherLogStr
makeSensitive :: GopherLogStr -> GopherLogStr
makeSensitive = Seq GopherLogStrChunk -> GopherLogStr
GopherLogStr
(Seq GopherLogStrChunk -> GopherLogStr)
-> (GopherLogStr -> Seq GopherLogStrChunk)
-> GopherLogStr
-> GopherLogStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GopherLogStrChunk -> GopherLogStrChunk)
-> Seq GopherLogStrChunk -> Seq GopherLogStrChunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\GopherLogStrChunk
c -> GopherLogStrChunk
c { glscSensitive :: Bool
glscSensitive = Bool
True })
(Seq GopherLogStrChunk -> Seq GopherLogStrChunk)
-> (GopherLogStr -> Seq GopherLogStrChunk)
-> GopherLogStr
-> Seq GopherLogStrChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GopherLogStr -> Seq GopherLogStrChunk
unGopherLogStr
hideSensitive :: GopherLogStr -> GopherLogStr
hideSensitive :: GopherLogStr -> GopherLogStr
hideSensitive = Seq GopherLogStrChunk -> GopherLogStr
GopherLogStr
(Seq GopherLogStrChunk -> GopherLogStr)
-> (GopherLogStr -> Seq GopherLogStrChunk)
-> GopherLogStr
-> GopherLogStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GopherLogStrChunk -> GopherLogStrChunk)
-> Seq GopherLogStrChunk -> Seq GopherLogStrChunk
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\GopherLogStrChunk
c -> Bool -> Builder -> GopherLogStrChunk
GopherLogStrChunk Bool
False (Builder -> GopherLogStrChunk) -> Builder -> GopherLogStrChunk
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)
(Seq GopherLogStrChunk -> Seq GopherLogStrChunk)
-> (GopherLogStr -> Seq GopherLogStrChunk)
-> GopherLogStr
-> Seq GopherLogStrChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GopherLogStr -> Seq GopherLogStrChunk
unGopherLogStr
class FromGopherLogStr a where
fromGopherLogStr :: GopherLogStr -> a
instance FromGopherLogStr GopherLogStr where
fromGopherLogStr :: GopherLogStr -> GopherLogStr
fromGopherLogStr = GopherLogStr -> GopherLogStr
forall a. a -> a
id
instance FromGopherLogStr Builder where
fromGopherLogStr :: GopherLogStr -> Builder
fromGopherLogStr = (GopherLogStrChunk -> Builder) -> Seq GopherLogStrChunk -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap GopherLogStrChunk -> Builder
glscBuilder (Seq GopherLogStrChunk -> Builder)
-> (GopherLogStr -> Seq GopherLogStrChunk)
-> GopherLogStr
-> Builder
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 (Builder -> ByteString)
-> (GopherLogStr -> Builder) -> GopherLogStr -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GopherLogStr -> Builder
forall a. FromGopherLogStr a => GopherLogStr -> a
fromGopherLogStr
instance FromGopherLogStr B.ByteString where
fromGopherLogStr :: GopherLogStr -> ByteString
fromGopherLogStr = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (GopherLogStr -> ByteString) -> GopherLogStr -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GopherLogStr -> ByteString
forall a. FromGopherLogStr a => GopherLogStr -> a
fromGopherLogStr
instance FromGopherLogStr T.Text where
fromGopherLogStr :: GopherLogStr -> Text
fromGopherLogStr = ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (GopherLogStr -> ByteString) -> GopherLogStr -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GopherLogStr -> ByteString
forall a. FromGopherLogStr a => GopherLogStr -> a
fromGopherLogStr
instance FromGopherLogStr TL.Text where
fromGopherLogStr :: GopherLogStr -> Text
fromGopherLogStr = ByteString -> Text
TL.decodeUtf8 (ByteString -> Text)
-> (GopherLogStr -> ByteString) -> GopherLogStr -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GopherLogStr -> ByteString
forall a. FromGopherLogStr a => GopherLogStr -> a
fromGopherLogStr
instance FromGopherLogStr [Char] where
fromGopherLogStr :: GopherLogStr -> String
fromGopherLogStr = ByteString -> String
uDecode (ByteString -> String)
-> (GopherLogStr -> ByteString) -> GopherLogStr -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GopherLogStr -> ByteString
forall a. FromGopherLogStr a => GopherLogStr -> a
fromGopherLogStr
class ToGopherLogStr a where
toGopherLogStr :: a -> GopherLogStr
instance ToGopherLogStr GopherLogStr where
toGopherLogStr :: GopherLogStr -> GopherLogStr
toGopherLogStr = GopherLogStr -> GopherLogStr
forall a. a -> a
id
instance ToGopherLogStr Builder where
toGopherLogStr :: Builder -> GopherLogStr
toGopherLogStr Builder
b = Seq GopherLogStrChunk -> GopherLogStr
GopherLogStr
(Seq GopherLogStrChunk -> GopherLogStr)
-> (GopherLogStrChunk -> Seq GopherLogStrChunk)
-> GopherLogStrChunk
-> GopherLogStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GopherLogStrChunk -> Seq GopherLogStrChunk
forall a. a -> Seq a
S.singleton
(GopherLogStrChunk -> GopherLogStr)
-> GopherLogStrChunk -> GopherLogStr
forall a b. (a -> b) -> a -> b
$ GopherLogStrChunk :: Bool -> Builder -> GopherLogStrChunk
GopherLogStrChunk
{ glscSensitive :: Bool
glscSensitive = Bool
False
, glscBuilder :: Builder
glscBuilder = Builder
b
}
instance ToGopherLogStr B.ByteString where
toGopherLogStr :: ByteString -> GopherLogStr
toGopherLogStr = Builder -> GopherLogStr
forall a. ToGopherLogStr a => a -> GopherLogStr
toGopherLogStr (Builder -> GopherLogStr)
-> (ByteString -> Builder) -> ByteString -> GopherLogStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
BB.byteString
instance ToGopherLogStr BL.ByteString where
toGopherLogStr :: ByteString -> GopherLogStr
toGopherLogStr = Builder -> GopherLogStr
forall a. ToGopherLogStr a => a -> GopherLogStr
toGopherLogStr (Builder -> GopherLogStr)
-> (ByteString -> Builder) -> ByteString -> GopherLogStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
BB.lazyByteString
instance ToGopherLogStr [Char] where
toGopherLogStr :: String -> GopherLogStr
toGopherLogStr = ByteString -> GopherLogStr
forall a. ToGopherLogStr a => a -> GopherLogStr
toGopherLogStr (ByteString -> GopherLogStr)
-> (String -> ByteString) -> String -> GopherLogStr
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 -> ByteString -> GopherLogStr
forall a. ToGopherLogStr a => a -> GopherLogStr
toGopherLogStr (ByteString
"info" :: B.ByteString)
GopherLogLevel
GopherLogLevelWarn -> ByteString -> GopherLogStr
forall a. ToGopherLogStr a => a -> GopherLogStr
toGopherLogStr (ByteString
"warn" :: B.ByteString)
GopherLogLevel
GopherLogLevelError -> ByteString -> GopherLogStr
forall a. ToGopherLogStr a => a -> GopherLogStr
toGopherLogStr (ByteString
"error" :: B.ByteString)
instance ToGopherLogStr (SocketAddress Inet6) where
toGopherLogStr :: SocketAddress Inet6 -> GopherLogStr
toGopherLogStr (SocketAddressInet6 addr port _ _) =
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 Builder -> GopherLogStr
forall a. ToGopherLogStr a => a -> GopherLogStr
toGopherLogStr (Builder -> GopherLogStr) -> Builder -> GopherLogStr
forall a b. (a -> b) -> a -> b
$
Char -> Builder
BB.charUtf8 Char
'[' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Word16 -> Builder
BB.word16HexFixed Word16
b1 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
':' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Word16 -> Builder
BB.word16HexFixed Word16
b2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
':' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Word16 -> Builder
BB.word16HexFixed Word16
b3 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
':' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Word16 -> Builder
BB.word16HexFixed Word16
b4 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
':' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Word16 -> Builder
BB.word16HexFixed Word16
b5 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
':' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Word16 -> Builder
BB.word16HexFixed Word16
b6 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
':' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Word16 -> Builder
BB.word16HexFixed Word16
b7 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
':' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Word16 -> Builder
BB.word16HexFixed Word16
b8 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.charUtf8 Char
']' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Char -> Builder
BB.charUtf8 Char
':' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
BB.intDec (Inet6Port -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Inet6Port
port)