ry
/
datarekisteri
10
0
Fork 0
Code Issues 10 Pull Requests Packages Projects Releases Wiki Activity

Add a type for permissions

This commit is contained in:
Saku Laesvuori 2024-01-19 13:28:25 +02:00
parent 97fbe99d06
commit c0c71b1203
Signed by: slaesvuo
GPG Key ID: 257D284A2A1D3A32
2 changed files with 29 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
core/datarekisteri-core.cabal
View File

@ -20,6 +20,7 @@ library
morpheus-graphql-core,
morpheus-graphql-server,
persistent,
persistent-postgresql,
relude,
text,
time,

31
core/src/Datarekisteri/Core/Types.hs
View File

@ -12,6 +12,7 @@ module Datarekisteri.Core.Types
, Email
, KeyID(..)
, Permission(..)
, Permissions(..)
, PhoneNumber
, Scope(..)
, Time(..)
@ -36,18 +37,21 @@ import Relude
import qualified "base64" Data.ByteString.Base64 as B64
import Data.Aeson (ToJSON(..), FromJSON(..))
import Data.Aeson (Value, ToJSON(..), FromJSON(..), Result(..), ToJSONKey(..), FromJSONKey(..), FromJSONKeyFunction(..), ToJSONKeyFunction(..), fromJSON, eitherDecodeStrict)
import Data.Aeson.Encoding (string)
import Data.Char (isSpace)
import Data.Morpheus.Server.Types (SCALAR)
import Data.Morpheus.Server.Types (SCALAR, TYPE)
import Data.Morpheus.Types (GQLType, DecodeScalar(..), KIND, EncodeScalar(..), ScalarValue(..))
import Data.Morpheus.Types.GQLScalar (scalarToJSON, scalarFromJSON)
import Data.Time (UTCTime, NominalDiffTime, addUTCTime, Day)
import Data.Time.Format.ISO8601 (iso8601Show, iso8601ParseM)
import Database.Persist.Class (PersistField(..))
import Database.Persist.PersistValue (PersistValue(..))
import Database.Persist.Postgresql.JSON () -- persistent instances for Aeson's Value
import Database.Persist.Sql (PersistFieldSql(..))
import Text.Email.Validate (EmailAddress, toByteString, validate, emailAddress)
import qualified Data.Map as Map
import qualified Data.Text as T
base64Encode :: ByteString -> Base64
@ -95,6 +99,10 @@ instance EncodeScalar Scope where
instance GQLType Scope where type KIND Scope = SCALAR
instance ToJSON Scope where toJSON = scalarToJSON
instance FromJSON Scope where parseJSON = scalarFromJSON <=< parseJSON
instance ToJSONKey Scope where toJSONKey = ToJSONKeyText (fromString . show) (string . show)
instance FromJSONKey Scope
where fromJSONKey = FromJSONKeyTextParser $
either fail pure . (eitherDecodeStrict . encodeUtf8)
data Permission = None
| ReadOnly
@ -112,7 +120,24 @@ instance GQLType Permission where type KIND Permission = SCALAR
instance ToJSON Permission where toJSON = scalarToJSON
instance FromJSON Permission where parseJSON = scalarFromJSON <=< parseJSON
readPermission :: Text -> Maybe (Map Scope Permission)
newtype Permissions = Permissions (Map Scope Permission)
deriving (Show, Eq, Read, Generic, ToJSON, FromJSON, Semigroup, Monoid)
instance GQLType Permissions where type KIND Permissions = TYPE
instance PersistField Permissions where
toPersistValue = toPersistValue . toJSON
fromPersistValue = resultToEither . fromJSON <=< fromPersistValue
where resultToEither (Success x) = Right x
resultToEither (Error err) = Left $ T.pack err
instance PersistFieldSql Permissions where sqlType _ = sqlType (Proxy :: Proxy Value)
instance Ord Permissions where
(Permissions a) <= (Permissions b) =
and $ Map.intersectionWith (<=) a $ b <> (const None <$> Map.difference a b)
readPermission :: Text -> Maybe Permissions
readPermission = rightToMaybe . readEither . toString
newtype PhoneNumber = PhoneNumber Text deriving (Show, Generic)