1
1
mirror of https://github.com/github/semantic.git synced 2024-12-25 07:55:12 +03:00

Add Hydro data types corresponding to proposed push schema.

Provides a `Push` type. To build that, we needed `RequestContext`,
`UserType`, `RequestMethod`, `Spamurai`, `Timestamp`, and `IPVersion`.

The schemas have all been taken from https://github.com/github/hydro-schemas/.
This commit is contained in:
Patrick Thomson 2019-01-08 13:55:09 -05:00
parent 00abc88daa
commit 39bdfdf01f
13 changed files with 319 additions and 0 deletions

View File

@ -81,6 +81,14 @@ library
, Data.File
, Data.Functor.Both
, Data.Functor.Classes.Generic
, Data.GitHub.Auth
, Data.GitHub.IPVersion
, Data.GitHub.Timestamp
, Data.GitHub.Request.Context
, Data.GitHub.Request.Method
, Data.GitHub.Spamurai
, Data.GitHub.User
, Data.GitHub.User.Type
, Data.Graph
, Data.Graph.ControlFlowVertex
, Data.Graph.TermVertex
@ -174,6 +182,8 @@ library
, Parsing.Parser
, Parsing.TreeSitter
, Paths_semantic
, Proto3.Google.Wrapped
, Proto3.Suite.Exts
-- Rendering formats
, Rendering.Graph
, Rendering.JSON

58
src/Data/GitHub/Auth.hs Normal file
View File

@ -0,0 +1,58 @@
{-# LANGUAGE DeriveAnyClass, LambdaCase #-}
module Data.GitHub.Auth
( AuthTypes (..)
) where
import Prologue
import Proto3.Suite
-- | There is no Enum instance for this type, as the schema
-- does not describe a well-formed Enum instance (7 has no value).
-- As such, a Finite instance is also omitted, so we can't generate
-- this type with proto-gen. But that's fine, since it's already
-- specified elsewhere.
data AuthTypes
= Unknown
| Anon
| IntegrationServerToServer
| Basic
| OAuth
| JWT
| PersonalAccessToken
| IntegrationUserToServer
| OAuthServerToServer
deriving (Eq, Show, Generic, Named, MessageField)
instance HasDefault AuthTypes where def = Unknown
toSchemaInt :: AuthTypes -> Int
toSchemaInt = \case
Unknown -> 0
Anon -> 1
IntegrationServerToServer -> 2
Basic -> 3
OAuth -> 4
JWT -> 5
PersonalAccessToken -> 6
IntegrationUserToServer -> 8
OAuthServerToServer -> 9
fromSchemaInt :: Int -> AuthTypes
fromSchemaInt = \case
0 -> Unknown
1 -> Anon
2 -> IntegrationServerToServer
3 -> Basic
4 -> OAuth
5 -> JWT
6 -> PersonalAccessToken
7 -> Unknown -- not specified in the schema
8 -> IntegrationUserToServer
9 -> OAuthServerToServer
_ -> Unknown
instance Primitive AuthTypes where
encodePrimitive i = encodePrimitive i . toSchemaInt
decodePrimitive = fromSchemaInt <$> decodePrimitive

View File

@ -0,0 +1,30 @@
{-# LANGUAGE DeriveAnyClass #-}
module Data.GitHub.Events.Push
( RepositoryPush (..)
) where
import Prologue
import Proto3.Suite
import Data.GitHub.Request.Context
newtype SHA = SHA { shaContents :: Text }
data ChangedFile = ChangedFile
{ filePreviousOID :: Git.OID
, fileOID :: Git.OID
, fileChangeType :: Text -- TODO refine this, as it's always "A", "M", or "D"
, filePath :: Text
, filePreviousPath :: Text
} deriving (Eq, Show, Generic, Message, Named)
data RepositoryPush = RepositoryPush
{ pushRequestContext :: Nested RequestContext
, pushActor :: Nested User
, pushBefore :: SHA
, pushAfter :: SHA
, pushRef :: Text
, pushChangedFiles :: NestedVec ChangedFile
} deriving (Eq, Show, Generic, Message, Named)

View File

@ -0,0 +1,20 @@
{-# LANGUAGE DeriveAnyClass, DerivingStrategies, DerivingVia #-}
module Data.GitHub.IPVersion
( IPVersion (..)
) where
import Prologue
import Proto3.Suite
import Proto3.Suite.Exts
data IPVersion
= Unknown
| IPV4
| IPV6
deriving (Eq, Show, Enum, Bounded, MessageField, Named, Generic)
deriving Primitive via PrimitiveEnum IPVersion
instance HasDefault IPVersion where def = Unknown
instance Finite IPVersion where enumerate = enumerateUpper "VERSION_UNKNOWN" [IPV4 ..]

View File

@ -0,0 +1,38 @@
module Data.GitHub.Request.Context
( RequestContext (..)
) where
import Prologue
import Proto3.Suite
import Proto3.Google.Wrapped
import Data.GitHub.Request.Method
import Data.GitHub.Auth
import Data.GitHub.IPVersion
data RequestContext = RequestContext
{ requestID :: Text
, requestMethod :: RequestMethod
, requestURL :: Text
, requestIPAddress :: Text
, requestIPVersion :: IPVersion
, requestV4Int :: Word32
, requestV6Int :: ByteString
, requestUserAgent :: Text
, requestSessionID :: Word32
, requestController :: Text
, requestControllerAction :: Text
, requestAPIRoute :: Text
, requestCategory :: Text
, requestFrom :: Text
, requestAuth :: AuthTypes
, requestClientID :: Text
, requestReferrer :: Text
, requestCountryCode :: Nested Text
, requestCountryName :: Nested Text
, requestRegion :: Nested (Wrapped Text)
, requestRegionName :: Nested (Wrapped Text)
, requestCity :: Nested (Wrapped Text)
}

View File

@ -0,0 +1,30 @@
{-# LANGUAGE DeriveAnyClass, DerivingVia #-}
module Data.GitHub.Request.Method
( RequestMethod (..)
) where
import Prologue
import Proto3.Suite
import Proto3.Suite.Exts
data RequestMethod
= Unknown
| Get
| Post
| Put
| Delete
| Update
| Options
| Connect
| Head
| Patch
deriving (Eq, Show, Ord, Enum, Bounded, Generic, Named, MessageField)
deriving Primitive via PrimitiveEnum RequestMethod
instance Finite RequestMethod where
enumerate = enumerateUpper "REQUEST_METHOD_UNKNOWN" [Get ..]
instance HasDefault RequestMethod where def = Unknown

View File

@ -0,0 +1,21 @@
{-# LANGUAGE DerivingVia, DeriveAnyClass #-}
module Data.GitHub.Spamurai
( SpamuraiClassification (..)
) where
import Prologue
import Proto3.Suite
import Proto3.Suite.Exts
data SpamuraiClassification
= Unknown
| Hammy
| Spammy
deriving (Eq, Show, Enum, Bounded, Generic, MessageField, Named)
deriving Primitive via PrimitiveEnum SpamuraiClassification
instance HasDefault SpamuraiClassification where def = Unknown
instance Finite SpamuraiClassification where
enumerate = enumerateUpper "SPAMURAI_CLASSIFICATION_UNKNOWN" [Hammy ..]

View File

@ -0,0 +1,12 @@
{-# LANGUAGE DeriveAnyClass #-}
module Data.GitHub.Timestamp (Timestamp (..)) where
import Prologue
import Proto3.Suite
data Timestamp = Timestamp
{ timestampSeconds :: Int64
, timestampNanos :: Int32
} deriving (Eq, Show, Generic, Message, Named)

26
src/Data/GitHub/User.hs Normal file
View File

@ -0,0 +1,26 @@
{-# LANGUAGE DeriveAnyClass, DerivingVia, LambdaCase #-}
module Data.GitHub.User
( User (..)
, SpamuraiClassification (..)
) where
import Prologue
import Proto3.Suite
import Data.GitHub.Timestamp
import Data.GitHub.User.Type (Type)
import Data.GitHub.Spamurai
data User = User
{ userId :: Word32
, userLogin :: Text
, userType :: Type
, userBillingPlan :: Text
, userSpammy :: Bool
, userTimestamp :: Nested Timestamp
, userSuspended :: Bool
, userSpamuraiCalculation :: SpamuraiClassification
, userAnalyticsTrackingId :: Text
} deriving (Eq, Show, Generic, Message, Named)

View File

@ -0,0 +1,26 @@
{-# LANGUAGE DeriveAnyClass, GeneralizedNewtypeDeriving, DerivingStrategies, DerivingVia, LambdaCase, ScopedTypeVariables #-}
module Data.GitHub.User.Type
( Type (..) ) where
import Prologue
import Proto3.Suite
import Proto3.Suite.Exts
data Type
= Unknown
| User
| Organization
| Bot
deriving (Eq, Show, Enum, Bounded, MessageField, Named, Generic)
deriving Primitive via PrimitiveEnum Type
instance HasDefault Type where def = Unknown
instance Finite Type where
enumerate _ = [ ("UNKNOWN", 0)
, ("USER", 1)
, ("ORGANIZATION", 2)
, ("BOT", 3)
]

View File

@ -16,6 +16,7 @@ import Data.Bits as X
import Data.ByteString as X (ByteString)
import Data.Coerce as X
import Data.Functor.Both as X (Both, both, runBothWith)
import Data.Int as X (Int8, Int16, Int32, Int64)
import Data.IntMap as X (IntMap)
import Data.IntSet as X (IntSet)
import Data.Ix as X (Ix (..))
@ -29,6 +30,7 @@ import Data.Set as X (Set)
import Data.Sum as X (Sum, Element, Elements, (:<), (:<:), Apply (..), inject)
import Data.Text as X (Text)
import Data.These as X
import Data.Word as X (Word8, Word16, Word32, Word64)
import Control.Exception as X hiding (Handler (..), assert, evaluate, throw, throwIO, throwTo)

View File

@ -0,0 +1,16 @@
{-# LANGUAGE DeriveAnyClass #-}
module Proto3.Google.Wrapped
( Wrapped (..)
) where
import Prologue
import Proto3.Suite
newtype Wrapped a = Wrapped { wrappedValue :: a }
deriving (Eq, Show, Generic)
instance Named (Wrapped Text) where nameOf _ = "StringValue"
deriving instance Message (Wrapped Text)

30
src/Proto3/Suite/Exts.hs Normal file
View File

@ -0,0 +1,30 @@
{-# LANGUAGE DeriveAnyClass, GeneralizedNewtypeDeriving, DerivingStrategies, DerivingVia, LambdaCase, ScopedTypeVariables, UndecidableInstances #-}
module Proto3.Suite.Exts
( PrimitiveEnum (..)
, enumerateUpper
) where
import Prologue
import Data.Char (toUpper)
import Data.String
import Proto3.Suite
import Proto3.Wire.Encode as Encode
import Proto3.Wire.Decode as Decode
newtype PrimitiveEnum a = PrimitiveEnum a
deriving stock (Eq, Ord)
deriving newtype (Bounded, Named, Enum, HasDefault)
-- | Piggybacks on top of the 'Enumerated' instance, as the generated code would.
-- This instance will get easier when we have DerivingVia.
instance forall a. (Enum a, Bounded a, Named a, HasDefault a) => Primitive (PrimitiveEnum a) where
primType _ = Named (Single (nameOf (Proxy @a)))
encodePrimitive = Encode.enum
decodePrimitive = either (const def) id <$> Decode.enum
enumerateUpper :: (IsString string, Show a, Enum a) => string -> [a] -> Proxy a -> [(string, Int)]
enumerateUpper msg as _ = (msg, 0) : fmap (\a -> (go a, fromEnum a)) as
where go = fromString . fmap toUpper . show