|
1 | 1 | {-# LANGUAGE RecordWildCards #-} |
2 | 2 |
|
3 | 3 | module App.Fossa.Ficus.Types ( |
4 | | - FicusResults(..) |
| 4 | + FicusResults (..), |
| 5 | + FicusConfig (..), |
| 6 | + FicusRegex (..), |
| 7 | + FicusScanType (..), |
| 8 | + FicusMessage (..), |
| 9 | + FicusMessages (..), |
| 10 | + FicusMatch (..), |
| 11 | + FicusMatchData (..), |
| 12 | + FicusWarning (..), |
| 13 | + FicusError (..), |
5 | 14 | ) where |
6 | 15 |
|
7 | | -data FicusResults = FicusResults { ficusAnalysisId :: Int } |
| 16 | +import Data.Aeson (FromJSON, KeyValue ((.=)), ToJSON (toJSON), Value (Object), object, withObject, withText, (.:?)) |
| 17 | +import Data.Aeson qualified as A |
| 18 | +import Data.Aeson.Types ((.:)) |
| 19 | +import Data.String.Conversion (ToText (toText)) |
| 20 | +import Data.Text (Text) |
| 21 | +import GHC.Generics (Generic) |
| 22 | +import Path (Abs, Dir, Path) |
| 23 | +import Srclib.Types (LicenseSourceUnit) |
| 24 | +import Types (LicenseScanPathFilters (..)) |
| 25 | + |
| 26 | +data FicusResults = FicusResults { ficusAnalysisId :: Int } deriving (Eq, Ord, Show, Generic) |
| 27 | + |
| 28 | +-- FOSSA_API_TOKEN=foobar cargo run -- analyze --exclude ".git/**" --exclude "target/**" --endpoint http://localhost:3000 --locator "pip+flask$1.2.3" --set snippet-scanning:batch-length=123 |
| 29 | + |
| 30 | +data FicusConfig = FicusConfig |
| 31 | + { ficusRootDir :: Path Abs Dir |
| 32 | + , ficusFossaToken :: Text |
| 33 | + , ficusLocator :: Text |
| 34 | + , ficusGitignore :: Bool |
| 35 | + , ficusSkipHidden :: Bool |
| 36 | + , ficusAllExtensions :: Bool |
| 37 | + , ficusExcludes :: [Text] |
| 38 | + } |
| 39 | + deriving (Eq, Ord, Show, Generic) |
| 40 | + |
| 41 | +data FicusRegex = FicusRegex |
| 42 | + { ficusPat :: Text |
| 43 | + , ficusName :: Text |
| 44 | + , ficusScanType :: FicusScanType |
| 45 | + } |
| 46 | + deriving (Eq, Ord, Show, Generic) |
| 47 | + |
| 48 | +instance ToJSON FicusRegex where |
| 49 | + toJSON FicusRegex{..} = |
| 50 | + object |
| 51 | + [ "pattern" .= toText ficusPat |
| 52 | + , "name" .= toText ficusName |
| 53 | + , "scan_type" .= toText ficusScanType |
| 54 | + ] |
| 55 | + |
| 56 | +data FicusScanType = FicusCustomLicense | FicusKeywordSearch |
| 57 | + deriving (Eq, Ord, Show, Generic) |
| 58 | + |
| 59 | +instance ToText FicusScanType where |
| 60 | + toText FicusCustomLicense = "CustomLicense" |
| 61 | + toText FicusKeywordSearch = "KeywordSearch" |
| 62 | + |
| 63 | +instance ToJSON FicusScanType where |
| 64 | + toJSON = toJSON . toText |
| 65 | + |
| 66 | +instance FromJSON FicusScanType |
| 67 | + |
| 68 | +data FicusMessageType = FicusMessageTypeMatch | FicusMessageTypeError | FicusMessageTypeWarning |
| 69 | + deriving (Eq, Ord, Show, Generic) |
| 70 | + |
| 71 | +instance ToText FicusMessageType where |
| 72 | + toText FicusMessageTypeMatch = "Match" |
| 73 | + toText FicusMessageTypeError = "Error" |
| 74 | + toText FicusMessageTypeWarning = "Warning" |
| 75 | + |
| 76 | +instance ToJSON FicusMessageType where |
| 77 | + toJSON = toJSON . toText |
| 78 | + |
| 79 | +instance FromJSON FicusMessageType where |
| 80 | + parseJSON = withText "FicusMessageType" $ \msg -> do |
| 81 | + case msg of |
| 82 | + "Match" -> pure FicusMessageTypeMatch |
| 83 | + "Error" -> pure FicusMessageTypeError |
| 84 | + "Warning" -> pure FicusMessageTypeWarning |
| 85 | + _ -> fail "invalid Ficus message type" |
| 86 | + |
| 87 | +data FicusMatch = FicusMatch |
| 88 | + { ficusMatchPath :: Text |
| 89 | + , ficusMatchMatches :: [FicusMatchData] |
| 90 | + , ficusMatchContents :: Maybe Text |
| 91 | + } |
| 92 | + deriving (Eq, Ord, Show, Generic) |
| 93 | + |
| 94 | +instance FromJSON FicusMatch where |
| 95 | + parseJSON = withObject "FicusMatch" $ \obj -> |
| 96 | + FicusMatch |
| 97 | + <$> (obj .: "path") |
| 98 | + <*> (obj .: "matches") |
| 99 | + <*> (obj .:? "contents") |
| 100 | + |
| 101 | +data FicusWarning = FicusWarning |
| 102 | + { ficusWarningMessage :: Text |
| 103 | + , ficusWarningType :: Text |
| 104 | + } |
| 105 | + deriving (Eq, Ord, Show, Generic) |
| 106 | + |
| 107 | +instance FromJSON FicusWarning where |
| 108 | + parseJSON = withObject "FicusWarning" $ \obj -> |
| 109 | + FicusWarning |
| 110 | + <$> (obj .: "message") |
| 111 | + <*> (obj .: "type") |
| 112 | + |
| 113 | +data FicusError = FicusError |
| 114 | + { ficusErrorMessage :: Text |
| 115 | + , ficusErrorType :: Text |
| 116 | + } |
| 117 | + deriving (Eq, Ord, Show, Generic) |
| 118 | + |
| 119 | +instance FromJSON FicusError where |
| 120 | + parseJSON = withObject "FicusError" $ \obj -> |
| 121 | + FicusError |
| 122 | + <$> (obj .: "message") |
| 123 | + <*> (obj .: "type") |
| 124 | + |
| 125 | +data FicusMatchData = FicusMatchData |
| 126 | + { ficusMatchDataPattern :: Text |
| 127 | + , ficusMatchDataMatchString :: Text |
| 128 | + , ficusMatchDataScanType :: FicusScanType |
| 129 | + , ficusMatchDataName :: Text |
| 130 | + , ficusMatchDataStartByte :: Integer |
| 131 | + , ficusMatchDataEndByte :: Integer |
| 132 | + , ficusMatchDataStartLine :: Integer |
| 133 | + , ficusMatchDataEndLine :: Integer |
| 134 | + } |
| 135 | + deriving (Eq, Ord, Show, Generic) |
| 136 | + |
| 137 | +instance FromJSON FicusMatchData where |
| 138 | + parseJSON = withObject "FicusMatchData" $ \obj -> |
| 139 | + FicusMatchData |
| 140 | + <$> (obj .: "pattern") |
| 141 | + <*> (obj .: "match_str") |
| 142 | + <*> (obj .: "scan_type") |
| 143 | + <*> (obj .: "name") |
| 144 | + <*> (obj .: "start_byte") |
| 145 | + <*> (obj .: "end_byte") |
| 146 | + <*> (obj .: "start_line") |
| 147 | + <*> (obj .: "end_line") |
| 148 | + |
| 149 | +instance ToJSON FicusMatchData |
| 150 | + |
| 151 | +data FicusMessages = FicusMessages |
| 152 | + { ficusMessageWarnings :: [FicusWarning] |
| 153 | + , ficusMessageErrors :: [FicusError] |
| 154 | + , ficusMessageMatches :: [FicusMatch] |
| 155 | + } |
| 156 | + deriving (Eq, Ord, Show, Generic) |
| 157 | + |
| 158 | +instance Semigroup FicusMessages where |
| 159 | + FicusMessages w1 e1 m1 <> FicusMessages w2 e2 m2 = FicusMessages (w1 <> w2) (e1 <> e2) (m1 <> m2) |
| 160 | + |
| 161 | +instance Monoid FicusMessages where |
| 162 | + mempty = FicusMessages [] [] [] |
| 163 | + |
| 164 | +data FicusMessage = FicusMessageFicusMatch FicusMatch | FicusMessageFicusWarning FicusWarning | FicusMessageFicusError FicusError |
| 165 | + deriving (Eq, Ord, Show, Generic) |
| 166 | + |
| 167 | +instance FromJSON FicusMessage where |
| 168 | + parseJSON (Object o) = do |
| 169 | + messageType <- o .: "type" |
| 170 | + case messageType of |
| 171 | + FicusMessageTypeWarning -> do |
| 172 | + Object d <- o .: "data" |
| 173 | + let message = d .: "message" |
| 174 | + let warningType = d .: "type" |
| 175 | + warning <- FicusWarning <$> warningType <*> message |
| 176 | + pure $ FicusMessageFicusWarning warning |
| 177 | + FicusMessageTypeError -> do |
| 178 | + Object d <- o .: "data" |
| 179 | + let errorType = d .: "type" |
| 180 | + let message = d .: "message" |
| 181 | + err <- FicusError <$> errorType <*> message |
| 182 | + pure $ FicusMessageFicusError err |
| 183 | + FicusMessageTypeMatch -> do |
| 184 | + Object d <- o .: "data" |
| 185 | + let path = d .: "path" |
| 186 | + let matches = d .: "matches" |
| 187 | + let contents = d .:? "contents" |
| 188 | + match <- FicusMatch <$> path <*> matches <*> contents |
| 189 | + pure $ FicusMessageFicusMatch match |
| 190 | + parseJSON _ = fail "Invalid schema for FicusMessage. It must be an object" |
0 commit comments