Merge pull request #2326 from github/add-hydro-data-types

Add data types for Kafka event messages.

semantic.cabal

@@ -81,6 +81,16 @@ library
                      , Data.File
                      , Data.Functor.Both
                      , Data.Functor.Classes.Generic
+                     , Data.GitHub.Auth
+                     , Data.GitHub.Event.Push
+                     , Data.GitHub.Git
+                     , 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 +184,8 @@ library
                      , Parsing.Parser
                      , Parsing.TreeSitter
                      , Paths_semantic
+                     , Proto3.Google.Wrapped
+                     , Proto3.Suite.Exts
                      -- Rendering formats
                      , Rendering.Graph
                      , Rendering.JSON

src/Data/GitHub/Auth.hs

@@ -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

src/Data/GitHub/Event/Push.hs

@@ -0,0 +1,30 @@
+{-# LANGUAGE DeriveAnyClass #-}
+
+module Data.GitHub.Event.Push
+  ( RepositoryPush (..)
+  ) where
+
+import Prologue
+
+import Proto3.Suite
+
+import qualified Data.GitHub.Git as Git
+import Data.GitHub.Request.Context
+import Data.GitHub.User
+
+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         :: Git.SHA
+  , pushAfter          :: Git.SHA
+  , pushRef            :: Text
+  , pushChangedFiles   :: NestedVec ChangedFile
+  } deriving (Eq, Show, Generic, Message, Named)

src/Data/GitHub/Git.hs

@@ -0,0 +1,18 @@
+{-# LANGUAGE DerivingStrategies, GeneralizedNewtypeDeriving #-}
+
+module Data.GitHub.Git
+  ( OID (..)
+  , SHA (..)
+  ) where
+
+import Prologue
+
+import Proto3.Suite
+
+newtype OID = OID Text
+  deriving stock (Eq, Show, Ord)
+  deriving newtype (MessageField, Primitive)
+
+newtype SHA = SHA Text
+  deriving stock (Eq, Show, Ord)
+  deriving newtype (MessageField, Primitive)

src/Data/GitHub/IPVersion.hs

@@ -0,0 +1,19 @@
+{-# 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

src/Data/GitHub/Request/Context.hs

@@ -0,0 +1,39 @@
+{-# LANGUAGE DeriveAnyClass #-}
+
+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 (Wrapped Text)
+  , requestCountryName      :: Nested (Wrapped Text)
+  , requestRegion           :: Nested (Wrapped Text)
+  , requestRegionName       :: Nested (Wrapped Text)
+  , requestCity             :: Nested (Wrapped Text)
+  } deriving (Eq, Show, Generic, Named, Message)

src/Data/GitHub/Request/Method.hs

@@ -0,0 +1,26 @@
+{-# 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 HasDefault RequestMethod where def = Unknown

src/Data/GitHub/Spamurai.hs

@@ -0,0 +1,19 @@
+{-# 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

src/Data/GitHub/Timestamp.hs

@@ -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)

src/Data/GitHub/User.hs

@@ -0,0 +1,26 @@
+{-# LANGUAGE DeriveAnyClass, DerivingVia #-}
+
+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)

src/Data/GitHub/User/Type.hs

@@ -0,0 +1,20 @@
+{-# LANGUAGE DeriveAnyClass, DerivingStrategies, DerivingVia, 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

src/Prologue.hs

@@ -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)
 

src/Proto3/Google/Wrapped.hs

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

src/Proto3/Suite/Exts.hs

@@ -0,0 +1,23 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, DerivingStrategies, DerivingVia, ScopedTypeVariables, UndecidableInstances #-}
+
+module Proto3.Suite.Exts
+  ( PrimitiveEnum (..)
+  ) where
+
+import Prologue
+
+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)
+
+-- | Provides a DerivingVia hook to opt into a sensible definition of 'Primitive'
+-- for a given 'Enum'. Should the decoding fail, the 'HasDefault' instance is used
+-- as a fallback.
+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