{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE NoImplicitPrelude    #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE UndecidableInstances #-}

-- |Types
module Chakra.Types where

import Data.Default
import qualified Data.Aeson             as A
import qualified Data.Text              as T
import           RIO
import           Servant.Auth.Server
import           System.Envy

data InfoDetail = InfoDetail
  { InfoDetail -> Text
appName        :: !Text,
    InfoDetail -> Text
appEnvironment :: !Text,
    InfoDetail -> Text
appVersion     :: !Text,
    InfoDetail -> Text
appDescription :: !Text
  }
  deriving (Int -> InfoDetail -> ShowS
[InfoDetail] -> ShowS
InfoDetail -> String
(Int -> InfoDetail -> ShowS)
-> (InfoDetail -> String)
-> ([InfoDetail] -> ShowS)
-> Show InfoDetail
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InfoDetail] -> ShowS
$cshowList :: [InfoDetail] -> ShowS
show :: InfoDetail -> String
$cshow :: InfoDetail -> String
showsPrec :: Int -> InfoDetail -> ShowS
$cshowsPrec :: Int -> InfoDetail -> ShowS
Show, InfoDetail -> InfoDetail -> Bool
(InfoDetail -> InfoDetail -> Bool)
-> (InfoDetail -> InfoDetail -> Bool) -> Eq InfoDetail
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InfoDetail -> InfoDetail -> Bool
$c/= :: InfoDetail -> InfoDetail -> Bool
== :: InfoDetail -> InfoDetail -> Bool
$c== :: InfoDetail -> InfoDetail -> Bool
Eq, (forall x. InfoDetail -> Rep InfoDetail x)
-> (forall x. Rep InfoDetail x -> InfoDetail) -> Generic InfoDetail
forall x. Rep InfoDetail x -> InfoDetail
forall x. InfoDetail -> Rep InfoDetail x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InfoDetail x -> InfoDetail
$cfrom :: forall x. InfoDetail -> Rep InfoDetail x
Generic)

instance FromEnv InfoDetail

instance Default InfoDetail where
  def :: InfoDetail
def = Text -> Text -> Text -> Text -> InfoDetail
InfoDetail Text
"example" Text
"dev" Text
"0.1" Text
"change me"

instance A.ToJSON InfoDetail where
  toJSON :: InfoDetail -> Value
toJSON =
    Options -> InfoDetail -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
A.genericToJSON
      Options
A.defaultOptions {fieldLabelModifier :: ShowS
A.fieldLabelModifier = Char -> ShowS
A.camelTo2 Char
'_' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
3}

data AuthenticatedUser = AuthenticatedUser
  { AuthenticatedUser -> Text
aud   :: !Text,
    AuthenticatedUser -> Text
iss   :: !Text,
    AuthenticatedUser -> Text
appid :: !Text,
    AuthenticatedUser -> Text
aio   :: !Text,
    AuthenticatedUser -> Text
oid   :: !Text,
    AuthenticatedUser -> Text
sub   :: !Text,
    AuthenticatedUser -> Text
tid   :: !Text
  }
  deriving (Int -> AuthenticatedUser -> ShowS
[AuthenticatedUser] -> ShowS
AuthenticatedUser -> String
(Int -> AuthenticatedUser -> ShowS)
-> (AuthenticatedUser -> String)
-> ([AuthenticatedUser] -> ShowS)
-> Show AuthenticatedUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticatedUser] -> ShowS
$cshowList :: [AuthenticatedUser] -> ShowS
show :: AuthenticatedUser -> String
$cshow :: AuthenticatedUser -> String
showsPrec :: Int -> AuthenticatedUser -> ShowS
$cshowsPrec :: Int -> AuthenticatedUser -> ShowS
Show, (forall x. AuthenticatedUser -> Rep AuthenticatedUser x)
-> (forall x. Rep AuthenticatedUser x -> AuthenticatedUser)
-> Generic AuthenticatedUser
forall x. Rep AuthenticatedUser x -> AuthenticatedUser
forall x. AuthenticatedUser -> Rep AuthenticatedUser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AuthenticatedUser x -> AuthenticatedUser
$cfrom :: forall x. AuthenticatedUser -> Rep AuthenticatedUser x
Generic)

instance A.ToJSON AuthenticatedUser

instance A.FromJSON AuthenticatedUser

instance ToJWT AuthenticatedUser

instance FromJWT AuthenticatedUser where
  decodeJWT :: ClaimsSet -> Either Text AuthenticatedUser
decodeJWT ClaimsSet
m = case Value -> Result AuthenticatedUser
forall a. FromJSON a => Value -> Result a
A.fromJSON (Value -> Result AuthenticatedUser)
-> (ClaimsSet -> Value) -> ClaimsSet -> Result AuthenticatedUser
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClaimsSet -> Value
forall a. ToJSON a => a -> Value
A.toJSON (ClaimsSet -> Result AuthenticatedUser)
-> ClaimsSet -> Result AuthenticatedUser
forall a b. (a -> b) -> a -> b
$ ClaimsSet
m of
    A.Error String
e   -> Text -> Either Text AuthenticatedUser
forall a b. a -> Either a b
Left (Text -> Either Text AuthenticatedUser)
-> Text -> Either Text AuthenticatedUser
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
e
    A.Success AuthenticatedUser
a -> AuthenticatedUser -> Either Text AuthenticatedUser
forall a b. b -> Either a b
Right AuthenticatedUser
a