module Hasura.RQL.Types.Network
  ( AddHostToTLSAllowlist,
    DropHostFromTLSAllowlist (..),
    Network (..),
    TlsAllow (..),
    TlsPermission (..),
    emptyNetwork,
  )
where

import Data.Aeson as A
import Data.Text qualified as T
import Hasura.Prelude
import Test.QuickCheck.Arbitrary as Q

data Network = Network
  { Network -> [TlsAllow]
networkTlsAllowlist :: [TlsAllow]
  }
  deriving (Int -> Network -> ShowS
[Network] -> ShowS
Network -> String
(Int -> Network -> ShowS)
-> (Network -> String) -> ([Network] -> ShowS) -> Show Network
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Network] -> ShowS
$cshowList :: [Network] -> ShowS
show :: Network -> String
$cshow :: Network -> String
showsPrec :: Int -> Network -> ShowS
$cshowsPrec :: Int -> Network -> ShowS
Show, Network -> Network -> Bool
(Network -> Network -> Bool)
-> (Network -> Network -> Bool) -> Eq Network
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Network -> Network -> Bool
$c/= :: Network -> Network -> Bool
== :: Network -> Network -> Bool
$c== :: Network -> Network -> Bool
Eq, (forall x. Network -> Rep Network x)
-> (forall x. Rep Network x -> Network) -> Generic Network
forall x. Rep Network x -> Network
forall x. Network -> Rep Network x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Network x -> Network
$cfrom :: forall x. Network -> Rep Network x
Generic)

instance Q.Arbitrary Network where
  -- TODO: Decide if the arbitrary instance should be extended to actual arbitrary networks
  -- This could prove complicated for testing purposes since the implications
  -- Are difficult to test.
  arbitrary :: Gen Network
arbitrary = Network -> Gen Network
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TlsAllow] -> Network
Network [])

instance FromJSON Network where
  parseJSON :: Value -> Parser Network
parseJSON = String -> (Object -> Parser Network) -> Value -> Parser Network
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Network" ((Object -> Parser Network) -> Value -> Parser Network)
-> (Object -> Parser Network) -> Value -> Parser Network
forall a b. (a -> b) -> a -> b
$ \Object
o -> [TlsAllow] -> Network
Network ([TlsAllow] -> Network) -> Parser [TlsAllow] -> Parser Network
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe [TlsAllow])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tls_allowlist" Parser (Maybe [TlsAllow]) -> [TlsAllow] -> Parser [TlsAllow]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []

instance ToJSON Network where
  toJSON :: Network -> Value
toJSON (Network [TlsAllow]
t) = [Pair] -> Value
object [Key
"tls_allowlist" Key -> [TlsAllow] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= [TlsAllow]
t]

emptyNetwork :: Network
emptyNetwork :: Network
emptyNetwork = [TlsAllow] -> Network
Network []

data TlsAllow = TlsAllow
  { TlsAllow -> String
taHost :: String,
    TlsAllow -> Maybe String
taSuffix :: Maybe String,
    TlsAllow -> Maybe [TlsPermission]
taPermit :: Maybe [TlsPermission]
  }
  deriving (Int -> TlsAllow -> ShowS
[TlsAllow] -> ShowS
TlsAllow -> String
(Int -> TlsAllow -> ShowS)
-> (TlsAllow -> String) -> ([TlsAllow] -> ShowS) -> Show TlsAllow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TlsAllow] -> ShowS
$cshowList :: [TlsAllow] -> ShowS
show :: TlsAllow -> String
$cshow :: TlsAllow -> String
showsPrec :: Int -> TlsAllow -> ShowS
$cshowsPrec :: Int -> TlsAllow -> ShowS
Show, ReadPrec [TlsAllow]
ReadPrec TlsAllow
Int -> ReadS TlsAllow
ReadS [TlsAllow]
(Int -> ReadS TlsAllow)
-> ReadS [TlsAllow]
-> ReadPrec TlsAllow
-> ReadPrec [TlsAllow]
-> Read TlsAllow
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TlsAllow]
$creadListPrec :: ReadPrec [TlsAllow]
readPrec :: ReadPrec TlsAllow
$creadPrec :: ReadPrec TlsAllow
readList :: ReadS [TlsAllow]
$creadList :: ReadS [TlsAllow]
readsPrec :: Int -> ReadS TlsAllow
$creadsPrec :: Int -> ReadS TlsAllow
Read, TlsAllow -> TlsAllow -> Bool
(TlsAllow -> TlsAllow -> Bool)
-> (TlsAllow -> TlsAllow -> Bool) -> Eq TlsAllow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TlsAllow -> TlsAllow -> Bool
$c/= :: TlsAllow -> TlsAllow -> Bool
== :: TlsAllow -> TlsAllow -> Bool
$c== :: TlsAllow -> TlsAllow -> Bool
Eq, (forall x. TlsAllow -> Rep TlsAllow x)
-> (forall x. Rep TlsAllow x -> TlsAllow) -> Generic TlsAllow
forall x. Rep TlsAllow x -> TlsAllow
forall x. TlsAllow -> Rep TlsAllow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TlsAllow x -> TlsAllow
$cfrom :: forall x. TlsAllow -> Rep TlsAllow x
Generic)

instance FromJSON TlsAllow where
  parseJSON :: Value -> Parser TlsAllow
parseJSON Value
j = Value -> Parser TlsAllow
aString Value
j Parser TlsAllow -> Parser TlsAllow -> Parser TlsAllow
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser TlsAllow
anObject Value
j
    where
      aString :: Value -> Parser TlsAllow
aString = String -> (Text -> Parser TlsAllow) -> Value -> Parser TlsAllow
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"TlsAllow" ((Text -> Parser TlsAllow) -> Value -> Parser TlsAllow)
-> (Text -> Parser TlsAllow) -> Value -> Parser TlsAllow
forall a b. (a -> b) -> a -> b
$ \Text
s ->
        if Text -> Bool
T.null Text
s
          then String -> Parser TlsAllow
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"missing \"host\" field in input"
          else TlsAllow -> Parser TlsAllow
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TlsAllow -> Parser TlsAllow) -> TlsAllow -> Parser TlsAllow
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> Maybe [TlsPermission] -> TlsAllow
TlsAllow (Text -> String
T.unpack Text
s) Maybe String
forall a. Maybe a
Nothing Maybe [TlsPermission]
forall a. Maybe a
Nothing

      anObject :: Value -> Parser TlsAllow
anObject = String -> (Object -> Parser TlsAllow) -> Value -> Parser TlsAllow
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TlsAllow" ((Object -> Parser TlsAllow) -> Value -> Parser TlsAllow)
-> (Object -> Parser TlsAllow) -> Value -> Parser TlsAllow
forall a b. (a -> b) -> a -> b
$ \Object
o ->
        String -> Maybe String -> Maybe [TlsPermission] -> TlsAllow
TlsAllow
          (String -> Maybe String -> Maybe [TlsPermission] -> TlsAllow)
-> Parser String
-> Parser (Maybe String -> Maybe [TlsPermission] -> TlsAllow)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"host"
          Parser (Maybe String -> Maybe [TlsPermission] -> TlsAllow)
-> Parser (Maybe String)
-> Parser (Maybe [TlsPermission] -> TlsAllow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe String)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"suffix"
          Parser (Maybe [TlsPermission] -> TlsAllow)
-> Parser (Maybe [TlsPermission]) -> Parser TlsAllow
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [TlsPermission])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"permissions"

instance ToJSON TlsAllow where
  toJSON :: TlsAllow -> Value
toJSON (TlsAllow String
h Maybe String
p Maybe [TlsPermission]
a) =
    [Pair] -> Value
object
      [ Key
"host" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= String
h,
        Key
"suffix" Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Maybe String
p,
        Key
"permissions" Key -> Maybe [TlsPermission] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Maybe [TlsPermission]
a
      ]

data TlsPermission
  = SelfSigned
  deriving (Int -> TlsPermission -> ShowS
[TlsPermission] -> ShowS
TlsPermission -> String
(Int -> TlsPermission -> ShowS)
-> (TlsPermission -> String)
-> ([TlsPermission] -> ShowS)
-> Show TlsPermission
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TlsPermission] -> ShowS
$cshowList :: [TlsPermission] -> ShowS
show :: TlsPermission -> String
$cshow :: TlsPermission -> String
showsPrec :: Int -> TlsPermission -> ShowS
$cshowsPrec :: Int -> TlsPermission -> ShowS
Show, ReadPrec [TlsPermission]
ReadPrec TlsPermission
Int -> ReadS TlsPermission
ReadS [TlsPermission]
(Int -> ReadS TlsPermission)
-> ReadS [TlsPermission]
-> ReadPrec TlsPermission
-> ReadPrec [TlsPermission]
-> Read TlsPermission
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TlsPermission]
$creadListPrec :: ReadPrec [TlsPermission]
readPrec :: ReadPrec TlsPermission
$creadPrec :: ReadPrec TlsPermission
readList :: ReadS [TlsPermission]
$creadList :: ReadS [TlsPermission]
readsPrec :: Int -> ReadS TlsPermission
$creadsPrec :: Int -> ReadS TlsPermission
Read, TlsPermission -> TlsPermission -> Bool
(TlsPermission -> TlsPermission -> Bool)
-> (TlsPermission -> TlsPermission -> Bool) -> Eq TlsPermission
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TlsPermission -> TlsPermission -> Bool
$c/= :: TlsPermission -> TlsPermission -> Bool
== :: TlsPermission -> TlsPermission -> Bool
$c== :: TlsPermission -> TlsPermission -> Bool
Eq, (forall x. TlsPermission -> Rep TlsPermission x)
-> (forall x. Rep TlsPermission x -> TlsPermission)
-> Generic TlsPermission
forall x. Rep TlsPermission x -> TlsPermission
forall x. TlsPermission -> Rep TlsPermission x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TlsPermission x -> TlsPermission
$cfrom :: forall x. TlsPermission -> Rep TlsPermission x
Generic, Int -> TlsPermission
TlsPermission -> Int
TlsPermission -> [TlsPermission]
TlsPermission -> TlsPermission
TlsPermission -> TlsPermission -> [TlsPermission]
TlsPermission -> TlsPermission -> TlsPermission -> [TlsPermission]
(TlsPermission -> TlsPermission)
-> (TlsPermission -> TlsPermission)
-> (Int -> TlsPermission)
-> (TlsPermission -> Int)
-> (TlsPermission -> [TlsPermission])
-> (TlsPermission -> TlsPermission -> [TlsPermission])
-> (TlsPermission -> TlsPermission -> [TlsPermission])
-> (TlsPermission
    -> TlsPermission -> TlsPermission -> [TlsPermission])
-> Enum TlsPermission
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 :: TlsPermission -> TlsPermission -> TlsPermission -> [TlsPermission]
$cenumFromThenTo :: TlsPermission -> TlsPermission -> TlsPermission -> [TlsPermission]
enumFromTo :: TlsPermission -> TlsPermission -> [TlsPermission]
$cenumFromTo :: TlsPermission -> TlsPermission -> [TlsPermission]
enumFromThen :: TlsPermission -> TlsPermission -> [TlsPermission]
$cenumFromThen :: TlsPermission -> TlsPermission -> [TlsPermission]
enumFrom :: TlsPermission -> [TlsPermission]
$cenumFrom :: TlsPermission -> [TlsPermission]
fromEnum :: TlsPermission -> Int
$cfromEnum :: TlsPermission -> Int
toEnum :: Int -> TlsPermission
$ctoEnum :: Int -> TlsPermission
pred :: TlsPermission -> TlsPermission
$cpred :: TlsPermission -> TlsPermission
succ :: TlsPermission -> TlsPermission
$csucc :: TlsPermission -> TlsPermission
Enum, TlsPermission
TlsPermission -> TlsPermission -> Bounded TlsPermission
forall a. a -> a -> Bounded a
maxBound :: TlsPermission
$cmaxBound :: TlsPermission
minBound :: TlsPermission
$cminBound :: TlsPermission
Bounded)

instance FromJSON TlsPermission where
  parseJSON :: Value -> Parser TlsPermission
parseJSON (String Text
"self-signed") = TlsPermission -> Parser TlsPermission
forall (f :: * -> *) a. Applicative f => a -> f a
pure TlsPermission
SelfSigned
  parseJSON Value
_ =
    String -> Parser TlsPermission
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser TlsPermission) -> String -> Parser TlsPermission
forall a b. (a -> b) -> a -> b
$
      String
"TlsPermission expecting one of " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((TlsPermission -> String) -> [TlsPermission] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (TlsPermission -> String
forall a. Show a => a -> String
show :: TlsPermission -> String) [TlsPermission
forall a. Bounded a => a
minBound .. TlsPermission
forall a. Bounded a => a
maxBound])

instance ToJSON TlsPermission where
  toJSON :: TlsPermission -> Value
toJSON TlsPermission
SelfSigned = Text -> Value
String Text
"self-signed"

type AddHostToTLSAllowlist = TlsAllow

data DropHostFromTLSAllowlist = DropHostFromTLSAllowlist {DropHostFromTLSAllowlist -> String
_dhftaHost :: String}
  deriving (Int -> DropHostFromTLSAllowlist -> ShowS
[DropHostFromTLSAllowlist] -> ShowS
DropHostFromTLSAllowlist -> String
(Int -> DropHostFromTLSAllowlist -> ShowS)
-> (DropHostFromTLSAllowlist -> String)
-> ([DropHostFromTLSAllowlist] -> ShowS)
-> Show DropHostFromTLSAllowlist
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DropHostFromTLSAllowlist] -> ShowS
$cshowList :: [DropHostFromTLSAllowlist] -> ShowS
show :: DropHostFromTLSAllowlist -> String
$cshow :: DropHostFromTLSAllowlist -> String
showsPrec :: Int -> DropHostFromTLSAllowlist -> ShowS
$cshowsPrec :: Int -> DropHostFromTLSAllowlist -> ShowS
Show, DropHostFromTLSAllowlist -> DropHostFromTLSAllowlist -> Bool
(DropHostFromTLSAllowlist -> DropHostFromTLSAllowlist -> Bool)
-> (DropHostFromTLSAllowlist -> DropHostFromTLSAllowlist -> Bool)
-> Eq DropHostFromTLSAllowlist
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DropHostFromTLSAllowlist -> DropHostFromTLSAllowlist -> Bool
$c/= :: DropHostFromTLSAllowlist -> DropHostFromTLSAllowlist -> Bool
== :: DropHostFromTLSAllowlist -> DropHostFromTLSAllowlist -> Bool
$c== :: DropHostFromTLSAllowlist -> DropHostFromTLSAllowlist -> Bool
Eq)

instance FromJSON DropHostFromTLSAllowlist where
  parseJSON :: Value -> Parser DropHostFromTLSAllowlist
parseJSON = String
-> (Object -> Parser DropHostFromTLSAllowlist)
-> Value
-> Parser DropHostFromTLSAllowlist
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DropHostFromTLSAllowlist" ((Object -> Parser DropHostFromTLSAllowlist)
 -> Value -> Parser DropHostFromTLSAllowlist)
-> (Object -> Parser DropHostFromTLSAllowlist)
-> Value
-> Parser DropHostFromTLSAllowlist
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    String -> DropHostFromTLSAllowlist
DropHostFromTLSAllowlist (String -> DropHostFromTLSAllowlist)
-> Parser String -> Parser DropHostFromTLSAllowlist
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"host"

instance ToJSON DropHostFromTLSAllowlist where
  toJSON :: DropHostFromTLSAllowlist -> Value
toJSON (DropHostFromTLSAllowlist String
h) = [Pair] -> Value
object [Key
"host" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= String
h]