diff --git a/semantic.cabal b/semantic.cabal index 11d1cb59a..e45451a18 100644 --- a/semantic.cabal +++ b/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 diff --git a/src/Data/GitHub/Auth.hs b/src/Data/GitHub/Auth.hs new file mode 100644 index 000000000..c83802dd3 --- /dev/null +++ b/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 diff --git a/src/Data/GitHub/Events/Push.hs b/src/Data/GitHub/Events/Push.hs new file mode 100644 index 000000000..3b0025beb --- /dev/null +++ b/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) diff --git a/src/Data/GitHub/IPVersion.hs b/src/Data/GitHub/IPVersion.hs new file mode 100644 index 000000000..0e5020748 --- /dev/null +++ b/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 ..] diff --git a/src/Data/GitHub/Request/Context.hs b/src/Data/GitHub/Request/Context.hs new file mode 100644 index 000000000..cc55531d8 --- /dev/null +++ b/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) + } diff --git a/src/Data/GitHub/Request/Method.hs b/src/Data/GitHub/Request/Method.hs new file mode 100644 index 000000000..57a493435 --- /dev/null +++ b/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 diff --git a/src/Data/GitHub/Spamurai.hs b/src/Data/GitHub/Spamurai.hs new file mode 100644 index 000000000..40545c569 --- /dev/null +++ b/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 ..] diff --git a/src/Data/GitHub/Timestamp.hs b/src/Data/GitHub/Timestamp.hs new file mode 100644 index 000000000..4581731e3 --- /dev/null +++ b/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) diff --git a/src/Data/GitHub/User.hs b/src/Data/GitHub/User.hs new file mode 100644 index 000000000..d2bf95db9 --- /dev/null +++ b/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) diff --git a/src/Data/GitHub/User/Type.hs b/src/Data/GitHub/User/Type.hs new file mode 100644 index 000000000..3a73b6b43 --- /dev/null +++ b/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) + ] diff --git a/src/Prologue.hs b/src/Prologue.hs index 42ff6fda2..1a3eec743 100644 --- a/src/Prologue.hs +++ b/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) diff --git a/src/Proto3/Google/Wrapped.hs b/src/Proto3/Google/Wrapped.hs new file mode 100644 index 000000000..f75070ec4 --- /dev/null +++ b/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) diff --git a/src/Proto3/Suite/Exts.hs b/src/Proto3/Suite/Exts.hs new file mode 100644 index 000000000..e36422975 --- /dev/null +++ b/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