diff --git a/Foundation.hs b/Foundation.hs index e3cbec2..7eb3948 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -179,6 +179,7 @@ instance Yesod App where isAuthorized TriggerRemotelyR _ = return Authorized isAuthorized (TriggerRemotelySimpleR _ _ _ _) _ = return Authorized isAuthorized TriggerLocallyR _ = return Authorized + isAuthorized (TriggerByWebhookR _ _) _ = return Authorized isAuthorized (OpenViewProgressR _) _ = return Authorized isAuthorized CreateResetLinkR _ = isAdmin diff --git a/Handler/ShowChallenge.hs b/Handler/ShowChallenge.hs index 94ba71d..aa20749 100644 --- a/Handler/ShowChallenge.hs +++ b/Handler/ShowChallenge.hs @@ -20,8 +20,12 @@ import Handler.Dashboard import Handler.Common import Handler.Evaluate +import Data.Maybe (fromJust) + import Text.Blaze +import Data.Aeson + import Gonito.ExtractMetadata (ExtractionOptions(..), extractMetadataFromRepoDir, GonitoMetadata(..), @@ -279,6 +283,38 @@ getTriggerRemotelySimpleR :: Text -> Text -> Text -> Text -> Handler TypedConten getTriggerRemotelySimpleR token challengeName url branch = doTrigger token challengeName (decodeSlash url) (Just branch) Nothing +data GitServerPayload = GitServerPayload { + gitServerPayloadRef :: Text, + -- Unfortunately, the URL is given in "ssh_url" field + -- for Gogs and "git_ssh_url" for GitLab, hence two + -- fields here + gitServerPayloadSshUrl :: Maybe Text, + gitServerPayloadGitSshUrl :: Maybe Text + } + deriving (Show, Eq) + +instance FromJSON GitServerPayload where + parseJSON (Object o) = GitServerPayload + <$> o .: "ref" + <*> ((o .: "repository") >>= (.:? "ssh_url")) + <*> ((o .: "repository") >>= (.:? "git_ssh_url")) + +postTriggerByWebhookR :: Text -> Text -> Handler TypedContent +postTriggerByWebhookR token challengeName = do + payload <- requireJsonBody :: Handler GitServerPayload + let ref = gitServerPayloadRef payload + let refPrefix = "refs/heads/" + if refPrefix `isPrefixOf` ref + then + do + let branch = T.replace refPrefix "" ref + let url = fromMaybe (fromJust $ gitServerPayloadGitSshUrl payload) + (gitServerPayloadSshUrl payload) + doTrigger token challengeName url (Just branch) Nothing + else + error $ "unexpected ref `" ++ (T.unpack ref) ++ "`" + + doTrigger :: Text -> Text -> Text -> Maybe Text -> Maybe Text -> Handler TypedContent doTrigger token challengeName url mBranch mGitAnnexRemote = do [Entity userId _] <- runDB $ selectList [UserTriggerToken ==. Just token] [] diff --git a/config/routes b/config/routes index fdd68a2..74c6588 100644 --- a/config/routes +++ b/config/routes @@ -27,6 +27,8 @@ /trigger-remotely TriggerRemotelyR POST /trigger-remotely-simple/#Text/#Text/#Text/#Text TriggerRemotelySimpleR GET POST /trigger-locally TriggerLocallyR POST +-- trigger by JSON payload (from e.g. GitLab or Gogs) +/trigger-by-webhook/#Text/#Text TriggerByWebhookR POST /indicator-graph-data/#IndicatorId IndicatorGraphDataR GET