{-# 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
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)
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
}
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
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
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
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
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)