module Hydra.API.APIServerLog where

import Hydra.Prelude

import Data.Aeson qualified as Aeson
import Data.Text qualified as Text
import Hydra.Network (PortNumber)
import Network.HTTP.Types (renderStdMethod)
import Test.QuickCheck (chooseEnum, listOf, oneof)

data APIServerLog
  = APIServerStarted {APIServerLog -> PortNumber
listeningPort :: PortNumber}
  | NewAPIConnection
  | APIOutputSent {APIServerLog -> Value
sentOutput :: Aeson.Value}
  | APIInputReceived {APIServerLog -> Value
receivedInput :: Aeson.Value}
  | APIInvalidInput {APIServerLog -> String
reason :: String, APIServerLog -> Text
inputReceived :: Text}
  | APIConnectionError {reason :: String}
  | APIHTTPRequestReceived
      { APIServerLog -> Method
method :: Method
      , APIServerLog -> PathInfo
path :: PathInfo
      }
  deriving stock (APIServerLog -> APIServerLog -> Bool
(APIServerLog -> APIServerLog -> Bool)
-> (APIServerLog -> APIServerLog -> Bool) -> Eq APIServerLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: APIServerLog -> APIServerLog -> Bool
== :: APIServerLog -> APIServerLog -> Bool
$c/= :: APIServerLog -> APIServerLog -> Bool
/= :: APIServerLog -> APIServerLog -> Bool
Eq, Int -> APIServerLog -> ShowS
[APIServerLog] -> ShowS
APIServerLog -> String
(Int -> APIServerLog -> ShowS)
-> (APIServerLog -> String)
-> ([APIServerLog] -> ShowS)
-> Show APIServerLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> APIServerLog -> ShowS
showsPrec :: Int -> APIServerLog -> ShowS
$cshow :: APIServerLog -> String
show :: APIServerLog -> String
$cshowList :: [APIServerLog] -> ShowS
showList :: [APIServerLog] -> ShowS
Show, (forall x. APIServerLog -> Rep APIServerLog x)
-> (forall x. Rep APIServerLog x -> APIServerLog)
-> Generic APIServerLog
forall x. Rep APIServerLog x -> APIServerLog
forall x. APIServerLog -> Rep APIServerLog x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. APIServerLog -> Rep APIServerLog x
from :: forall x. APIServerLog -> Rep APIServerLog x
$cto :: forall x. Rep APIServerLog x -> APIServerLog
to :: forall x. Rep APIServerLog x -> APIServerLog
Generic)
  deriving anyclass ([APIServerLog] -> Value
[APIServerLog] -> Encoding
APIServerLog -> Bool
APIServerLog -> Value
APIServerLog -> Encoding
(APIServerLog -> Value)
-> (APIServerLog -> Encoding)
-> ([APIServerLog] -> Value)
-> ([APIServerLog] -> Encoding)
-> (APIServerLog -> Bool)
-> ToJSON APIServerLog
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: APIServerLog -> Value
toJSON :: APIServerLog -> Value
$ctoEncoding :: APIServerLog -> Encoding
toEncoding :: APIServerLog -> Encoding
$ctoJSONList :: [APIServerLog] -> Value
toJSONList :: [APIServerLog] -> Value
$ctoEncodingList :: [APIServerLog] -> Encoding
toEncodingList :: [APIServerLog] -> Encoding
$comitField :: APIServerLog -> Bool
omitField :: APIServerLog -> Bool
ToJSON, Maybe APIServerLog
Value -> Parser [APIServerLog]
Value -> Parser APIServerLog
(Value -> Parser APIServerLog)
-> (Value -> Parser [APIServerLog])
-> Maybe APIServerLog
-> FromJSON APIServerLog
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser APIServerLog
parseJSON :: Value -> Parser APIServerLog
$cparseJSONList :: Value -> Parser [APIServerLog]
parseJSONList :: Value -> Parser [APIServerLog]
$comittedField :: Maybe APIServerLog
omittedField :: Maybe APIServerLog
FromJSON)

instance Arbitrary APIServerLog where
  arbitrary :: Gen APIServerLog
arbitrary =
    [Gen APIServerLog] -> Gen APIServerLog
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ PortNumber -> APIServerLog
APIServerStarted (PortNumber -> APIServerLog) -> Gen PortNumber -> Gen APIServerLog
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PortNumber
forall a. Arbitrary a => Gen a
arbitrary
      , APIServerLog -> Gen APIServerLog
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure APIServerLog
NewAPIConnection
      , APIServerLog -> Gen APIServerLog
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (APIServerLog -> Gen APIServerLog)
-> APIServerLog -> Gen APIServerLog
forall a b. (a -> b) -> a -> b
$ Value -> APIServerLog
APIOutputSent (Object -> Value
Aeson.Object Object
forall a. Monoid a => a
mempty)
      , APIServerLog -> Gen APIServerLog
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (APIServerLog -> Gen APIServerLog)
-> APIServerLog -> Gen APIServerLog
forall a b. (a -> b) -> a -> b
$ Value -> APIServerLog
APIInputReceived (Object -> Value
Aeson.Object Object
forall a. Monoid a => a
mempty)
      , String -> Text -> APIServerLog
APIInvalidInput (String -> Text -> APIServerLog)
-> Gen String -> Gen (Text -> APIServerLog)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
forall a. Arbitrary a => Gen a
arbitrary Gen (Text -> APIServerLog) -> Gen Text -> Gen APIServerLog
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Text
Text.pack (String -> Text) -> Gen String -> Gen Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf Gen Char
forall a. Arbitrary a => Gen a
arbitrary)
      , String -> APIServerLog
APIConnectionError (String -> APIServerLog) -> Gen String -> Gen APIServerLog
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
forall a. Arbitrary a => Gen a
arbitrary
      , Method -> PathInfo -> APIServerLog
APIHTTPRequestReceived (Method -> PathInfo -> APIServerLog)
-> Gen Method -> Gen (PathInfo -> APIServerLog)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Method
forall a. Arbitrary a => Gen a
arbitrary Gen (PathInfo -> APIServerLog) -> Gen PathInfo -> Gen APIServerLog
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen PathInfo
forall a. Arbitrary a => Gen a
arbitrary
      ]

  shrink :: APIServerLog -> [APIServerLog]
shrink = \case
    APIInvalidInput String
r Text
i -> [String -> Text -> APIServerLog
APIInvalidInput String
r' (String -> Text
Text.pack String
i') | String
r' <- String -> [String]
forall a. Arbitrary a => a -> [a]
shrink String
r, String
i' <- String -> [String]
forall a. Arbitrary a => a -> [a]
shrink (Text -> String
Text.unpack Text
i)]
    APIServerLog
_other -> []

-- | New type wrapper to define JSON instances.
newtype PathInfo = PathInfo ByteString
  deriving stock (PathInfo -> PathInfo -> Bool
(PathInfo -> PathInfo -> Bool)
-> (PathInfo -> PathInfo -> Bool) -> Eq PathInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathInfo -> PathInfo -> Bool
== :: PathInfo -> PathInfo -> Bool
$c/= :: PathInfo -> PathInfo -> Bool
/= :: PathInfo -> PathInfo -> Bool
Eq, Int -> PathInfo -> ShowS
[PathInfo] -> ShowS
PathInfo -> String
(Int -> PathInfo -> ShowS)
-> (PathInfo -> String) -> ([PathInfo] -> ShowS) -> Show PathInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PathInfo -> ShowS
showsPrec :: Int -> PathInfo -> ShowS
$cshow :: PathInfo -> String
show :: PathInfo -> String
$cshowList :: [PathInfo] -> ShowS
showList :: [PathInfo] -> ShowS
Show)

instance Arbitrary PathInfo where
  arbitrary :: Gen PathInfo
arbitrary =
    ByteString -> PathInfo
PathInfo (ByteString -> PathInfo)
-> (String -> ByteString) -> String -> PathInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> PathInfo) -> Gen String -> Gen PathInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf Gen Char
forall a. Arbitrary a => Gen a
arbitrary

instance ToJSON PathInfo where
  toJSON :: PathInfo -> Value
toJSON (PathInfo ByteString
bytes) =
    Text -> Value
Aeson.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 ByteString
bytes

instance FromJSON PathInfo where
  parseJSON :: Value -> Parser PathInfo
parseJSON = String -> (Text -> Parser PathInfo) -> Value -> Parser PathInfo
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"PathInfo" ((Text -> Parser PathInfo) -> Value -> Parser PathInfo)
-> (Text -> Parser PathInfo) -> Value -> Parser PathInfo
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    PathInfo -> Parser PathInfo
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PathInfo -> Parser PathInfo)
-> (ByteString -> PathInfo) -> ByteString -> Parser PathInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PathInfo
PathInfo (ByteString -> Parser PathInfo) -> ByteString -> Parser PathInfo
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
t

-- | New type wrapper to define JSON instances.
--
-- NOTE: We are not using http-types 'StdMethod' as we do not want to be
-- constrained in terms of logging and accept any method in a 'Request'.
newtype Method = Method ByteString
  deriving stock (Method -> Method -> Bool
(Method -> Method -> Bool)
-> (Method -> Method -> Bool) -> Eq Method
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Method -> Method -> Bool
== :: Method -> Method -> Bool
$c/= :: Method -> Method -> Bool
/= :: Method -> Method -> Bool
Eq, Int -> Method -> ShowS
[Method] -> ShowS
Method -> String
(Int -> Method -> ShowS)
-> (Method -> String) -> ([Method] -> ShowS) -> Show Method
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Method -> ShowS
showsPrec :: Int -> Method -> ShowS
$cshow :: Method -> String
show :: Method -> String
$cshowList :: [Method] -> ShowS
showList :: [Method] -> ShowS
Show)

instance Arbitrary Method where
  arbitrary :: Gen Method
arbitrary = ByteString -> Method
Method (ByteString -> Method)
-> (StdMethod -> ByteString) -> StdMethod -> Method
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdMethod -> ByteString
renderStdMethod (StdMethod -> Method) -> Gen StdMethod -> Gen Method
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StdMethod, StdMethod) -> Gen StdMethod
forall a. Enum a => (a, a) -> Gen a
chooseEnum (StdMethod
forall a. Bounded a => a
minBound, StdMethod
forall a. Bounded a => a
maxBound)

instance ToJSON Method where
  toJSON :: Method -> Value
toJSON (Method ByteString
bytes) =
    Text -> Value
Aeson.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 ByteString
bytes

instance FromJSON Method where
  parseJSON :: Value -> Parser Method
parseJSON = String -> (Text -> Parser Method) -> Value -> Parser Method
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"Method" ((Text -> Parser Method) -> Value -> Parser Method)
-> (Text -> Parser Method) -> Value -> Parser Method
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    Method -> Parser Method
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Method -> Parser Method)
-> (ByteString -> Method) -> ByteString -> Parser Method
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Method
Method (ByteString -> Parser Method) -> ByteString -> Parser Method
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
t