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/.

semantic.cabal

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

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/Events/Push.hs

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

src/Data/GitHub/IPVersion.hs

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

src/Data/GitHub/Request/Context.hs

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

src/Data/GitHub/Request/Method.hs

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

src/Data/GitHub/Spamurai.hs

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

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

src/Data/GitHub/User/Type.hs

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

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 { wrappedValue :: 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,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