{- |
Copyright: (c) 2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

__Observation__ — a vulnerability found in the target project by @Stan@.
-}

module Stan.Observation
    ( Observation (..)
    , Observations

      -- * Smart constructors
    , mkObservation
    , mkObservationId

    , ignoredObservations

      -- * Pretty print
    , prettyShowObservation
    , prettyShowIgnoredObservations
    , prettyObservationSource
    ) where

import Colourista (blue, bold, formatWith, green, italic, reset, yellow)
import Colourista.Short (b, i)
import Data.Aeson.Micro (ToJSON (..), object, (.=))
import Data.List (partition)
import Slist (Slist)

import Stan.Category (prettyShowCategory)
import Stan.Core.Id (Id (..))
import Stan.Core.ModuleName (ModuleName (..), fromGhcModule)
import Stan.Ghc.Compat (RealSrcSpan, srcSpanEndCol, srcSpanEndLine, srcSpanFile, srcSpanStartCol,
                        srcSpanStartLine)
import Stan.Hie.Compat (HieFile (..))
import Stan.Inspection (Inspection (..))
import Stan.Inspection.All (getInspectionById)
import Stan.Report.Settings (OutputSettings (..), Verbosity (..), isHidden)
import Stan.Severity (prettyShowSeverity, severityColour)

import qualified Crypto.Hash.SHA1 as SHA1
import qualified Data.ByteString.Base64 as Base64
import qualified Data.ByteString.Char8 as BS
import qualified Data.HashSet as HS
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as Text
import qualified Slist as S


{- | Data type to represent discovered by Stan vulnerabilities.
-}
data Observation = Observation
    { Observation -> Id Observation
observationId           :: !(Id Observation)
    , Observation -> Id Inspection
observationInspectionId :: !(Id Inspection)
    , Observation -> RealSrcSpan
observationSrcSpan      :: !RealSrcSpan
    , Observation -> FilePath
observationFile         :: !FilePath
    , Observation -> ModuleName
observationModuleName   :: !ModuleName
    , Observation -> ByteString
observationFileContent  :: !ByteString
    } deriving stock (Int -> Observation -> ShowS
[Observation] -> ShowS
Observation -> FilePath
(Int -> Observation -> ShowS)
-> (Observation -> FilePath)
-> ([Observation] -> ShowS)
-> Show Observation
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Observation] -> ShowS
$cshowList :: [Observation] -> ShowS
show :: Observation -> FilePath
$cshow :: Observation -> FilePath
showsPrec :: Int -> Observation -> ShowS
$cshowsPrec :: Int -> Observation -> ShowS
Show, Observation -> Observation -> Bool
(Observation -> Observation -> Bool)
-> (Observation -> Observation -> Bool) -> Eq Observation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Observation -> Observation -> Bool
$c/= :: Observation -> Observation -> Bool
== :: Observation -> Observation -> Bool
$c== :: Observation -> Observation -> Bool
Eq)

instance ToJSON Observation where
    toJSON :: Observation -> Value
toJSON Observation{..} = [Pair] -> Value
object
        [ "id"           Text -> Id Observation -> Pair
forall v. ToJSON v => Text -> v -> Pair
.= Id Observation
observationId
        , "inspectionId" Text -> Id Inspection -> Pair
forall v. ToJSON v => Text -> v -> Pair
.= Id Inspection
observationInspectionId
        , "srcSpan"      Text -> Text -> Pair
forall v. ToJSON v => Text -> v -> Pair
.= RealSrcSpan -> Text
showSpan RealSrcSpan
observationSrcSpan
        , "startLine"    Text -> Int -> Pair
forall v. ToJSON v => Text -> v -> Pair
.= RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
observationSrcSpan
        , "startCol"     Text -> Int -> Pair
forall v. ToJSON v => Text -> v -> Pair
.= RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
observationSrcSpan
        , "endLine"      Text -> Int -> Pair
forall v. ToJSON v => Text -> v -> Pair
.= RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
observationSrcSpan
        , "endCol"       Text -> Int -> Pair
forall v. ToJSON v => Text -> v -> Pair
.= RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
observationSrcSpan
        , "file"         Text -> Text -> Pair
forall v. ToJSON v => Text -> v -> Pair
.= FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
observationFile
        , "moduleName"   Text -> ModuleName -> Pair
forall v. ToJSON v => Text -> v -> Pair
.= ModuleName
observationModuleName
        ]

-- | Type alias for the sized list of 'Observation's.
type Observations = Slist Observation

-- | Smart constructor for 'Observation's from 'HieFile's.
mkObservation
    :: Id Inspection  -- ^ Corresponding 'Inspection's 'Id'.
    -> HieFile
    -> RealSrcSpan  -- ^ Position.
    -> Observation
mkObservation :: Id Inspection -> HieFile -> RealSrcSpan -> Observation
mkObservation insId :: Id Inspection
insId HieFile{..} srcSpan :: RealSrcSpan
srcSpan = $WObservation :: Id Observation
-> Id Inspection
-> RealSrcSpan
-> FilePath
-> ModuleName
-> ByteString
-> Observation
Observation
    { observationId :: Id Observation
observationId = Id Inspection -> ModuleName -> RealSrcSpan -> Id Observation
mkObservationId Id Inspection
insId ModuleName
moduleName RealSrcSpan
srcSpan
    , observationInspectionId :: Id Inspection
observationInspectionId = Id Inspection
insId
    , observationSrcSpan :: RealSrcSpan
observationSrcSpan = RealSrcSpan
srcSpan
    , observationFile :: FilePath
observationFile = FilePath
hie_hs_file
    , observationModuleName :: ModuleName
observationModuleName = ModuleName
moduleName
    , observationFileContent :: ByteString
observationFileContent = ByteString
hie_hs_src
    }
  where
    moduleName :: ModuleName
    moduleName :: ModuleName
moduleName = Module -> ModuleName
fromGhcModule Module
hie_module


-- | Show 'Observation' in a human-friendly format.
prettyShowObservation :: OutputSettings -> Observation -> Text
prettyShowObservation :: OutputSettings -> Observation -> Text
prettyShowObservation OutputSettings{..} o :: Observation
o@Observation{..} = case Verbosity
outputSettingsVerbosity of
    NonVerbose -> Text
simpleShowObservation
    Verbose -> [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (" ┃  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
        ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$  [Text]
observationTable
        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> ("" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Bool -> Observation -> [Text]
prettyObservationSource Bool
True Observation
o)
        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> ("" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
solution)
  where
    simpleShowObservation :: Text
    simpleShowObservation :: Text
simpleShowObservation =
        " ✦ "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
b (Id Observation -> Text
forall a. Id a -> Text
unId Id Observation
observationId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>" [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sev Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "] "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
i (RealSrcSpan -> Text
showSpan RealSrcSpan
observationSrcSpan)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " — "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Inspection -> Text
inspectionName Inspection
inspection


    observationTable :: [Text]
    observationTable :: [Text]
observationTable =
        [ Text -> Text
element "ID:            " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
b (Id Observation -> Text
forall a. Id a -> Text
unId Id Observation
observationId)
        , Text -> Text
element "Severity:      " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sev
        , Text -> Text
element "Inspection ID: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Id Inspection -> Text
forall a. Id a -> Text
unId Id Inspection
observationInspectionId
        , Text -> Text
element "Name:          " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Inspection -> Text
inspectionName Inspection
inspection
        , Text -> Text
element "Description:   " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Inspection -> Text
inspectionDescription Inspection
inspection
        , Text -> Text
element "Category:      " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
categories
        , Text -> Text
element "File:          " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
forall a. ToText a => a -> Text
toText FilePath
observationFile
        ]
      where
        element :: Text -> Text
        element :: Text -> Text
element = [Text] -> Text -> Text
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [Text
forall str. IsString str => str
italic] (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("✦ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)

    sev :: Text
    sev :: Text
sev = Severity -> Text
prettyShowSeverity (Inspection -> Severity
inspectionSeverity Inspection
inspection)

    inspection :: Inspection
    inspection :: Inspection
inspection = Id Inspection -> Inspection
getInspectionById Id Inspection
observationInspectionId

    categories :: Text
    categories :: Text
categories = Text -> [Text] -> Text
Text.intercalate " "
        ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Category -> Text) -> [Category] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Category -> Text
prettyShowCategory ([Category] -> [Text]) -> [Category] -> [Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty Category -> [Category]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty Category -> [Category])
-> NonEmpty Category -> [Category]
forall a b. (a -> b) -> a -> b
$ Inspection -> NonEmpty Category
inspectionCategory Inspection
inspection

    solution :: [Text]
    solution :: [Text]
solution
        | ToggleSolution -> Bool
isHidden ToggleSolution
outputSettingsSolutionVerbosity Bool -> Bool -> Bool
|| [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
sols = []
        | Bool
otherwise = "💡 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text -> Text
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [Text
forall str. IsString str => str
italic, Text
forall str. IsString str => str
green] "Possible solution:" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:
            (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ("    ⍟ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
sols
      where
        sols :: [Text]
        sols :: [Text]
sols = Inspection -> [Text]
inspectionSolution Inspection
inspection


prettyObservationSource
    :: Bool  -- ^ Use colouring
    -> Observation
    -> [Text]
prettyObservationSource :: Bool -> Observation -> [Text]
prettyObservationSource isColour :: Bool
isColour Observation{..} =
      Int -> Text
alignLine (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
    Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: Int
x -> Int -> Text
alignLine Int
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
getSourceLine Int
x) [Int
n .. Int
endL]
    [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Int -> Text
alignLine (Int
endL Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
arrows]
  where
    n, endL :: Int
    n :: Int
n = RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
observationSrcSpan
    endL :: Int
endL = RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
observationSrcSpan

    alignLine :: Int -> Text
    alignLine :: Int -> Text
alignLine x :: Int
x = Int -> Char -> Text -> Text
Text.justifyRight 4 ' ' (Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " ┃ "

    getSourceLine :: Int -> Text
    getSourceLine :: Int -> Text
getSourceLine x :: Int
x = Text -> (ByteString -> Text) -> Maybe ByteString -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        "<UNAVAILABLE> Open the issue in the tool that created the HIE files for you."
        ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8
        (ByteString -> [ByteString]
BS.lines ByteString
observationFileContent [ByteString] -> Int -> Maybe ByteString
forall a. [a] -> Int -> Maybe a
!!? (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1))

    arrows :: Text
    arrows :: Text
arrows = Bool -> Text -> Text
whenColour Bool
isColour (Severity -> Text
severityColour (Severity -> Text) -> Severity -> Text
forall a b. (a -> b) -> a -> b
$ Inspection -> Severity
inspectionSeverity (Inspection -> Severity) -> Inspection -> Severity
forall a b. (a -> b) -> a -> b
$ Id Inspection -> Inspection
getInspectionById Id Inspection
observationInspectionId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate Int
start " "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate Int
arrow "^"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bool -> Text -> Text
whenColour Bool
isColour Text
forall str. IsString str => str
reset
      where
        start :: Int
start = RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
observationSrcSpan Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
        arrow :: Int
arrow = RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
observationSrcSpan Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1

{- | Show 'RealSrcSpan' in the following format:

@
filename.ext(11:12-13:14)
@
-}
showSpan :: RealSrcSpan -> Text
showSpan :: RealSrcSpan -> Text
showSpan s :: RealSrcSpan
s = FastString -> Text
forall b a. (Show a, IsString b) => a -> b
show (RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
s)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
s)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
s)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
s)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
s)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"

{- | Checkes the predicate on colourfulness and returns an empty text when the
colouroing is disabled.
-}
whenColour :: Bool -> Text -> Text
whenColour :: Bool -> Text -> Text
whenColour = Bool -> Text -> Text
forall m. Monoid m => Bool -> m -> m
memptyIfFalse

{- Returns the list of ignored and unrecognised 'Observation' 'Id's
respectfully.
-}
ignoredObservations
    :: [Id Observation]
    -> Observations
    -> ([Id Observation], [Id Observation])
      -- ^ Ignored         ^ Unknown
ignoredObservations :: [Id Observation]
-> Observations -> ([Id Observation], [Id Observation])
ignoredObservations ids :: [Id Observation]
ids obs :: Observations
obs = ([Id Observation]
ignoredIds, [Id Observation]
unknownIds)
  where
    obsIds :: HashSet (Id Observation)
    obsIds :: HashSet (Id Observation)
obsIds = [Item (HashSet (Id Observation))] -> HashSet (Id Observation)
forall l. IsList l => [Item l] -> l
fromList ([Item (HashSet (Id Observation))] -> HashSet (Id Observation))
-> [Item (HashSet (Id Observation))] -> HashSet (Id Observation)
forall a b. (a -> b) -> a -> b
$ Slist (Id Observation) -> [Item (HashSet (Id Observation))]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Slist (Id Observation) -> [Item (HashSet (Id Observation))])
-> Slist (Id Observation) -> [Item (HashSet (Id Observation))]
forall a b. (a -> b) -> a -> b
$ (Observation -> Id Observation)
-> Observations -> Slist (Id Observation)
forall a b. (a -> b) -> Slist a -> Slist b
S.map Observation -> Id Observation
observationId Observations
obs

    ignoredIds, unknownIds :: [Id Observation]
    (ignoredIds :: [Id Observation]
ignoredIds, unknownIds :: [Id Observation]
unknownIds) = (Id Observation -> Bool)
-> [Id Observation] -> ([Id Observation], [Id Observation])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Id Observation -> HashSet (Id Observation) -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HS.member` HashSet (Id Observation)
obsIds) [Id Observation]
ids

{- Pretty shows the list of ignored and unrecognised 'Observation' 'Id's
respectfully.

@
Ignored Observation IDs:
    - OBS-STAN-0005-ZKmeC0-125:45
Unrecognised Observation IDs:
    - asd
@
-}
prettyShowIgnoredObservations :: [Id Observation] -> Observations -> Text
prettyShowIgnoredObservations :: [Id Observation] -> Observations -> Text
prettyShowIgnoredObservations [] _ = ""
prettyShowIgnoredObservations ids :: [Id Observation]
ids obs :: Observations
obs = Text
ignored Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
unknown
  where
    ignored :: Text
    ignored :: Text
ignored =
        if [Id Observation] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Id Observation]
ignoredIds
        then ""
        else [Text] -> Text -> Text
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [Text
forall str. IsString str => str
bold, Text
forall str. IsString str => str
blue] "Ignored Observation IDs:\n"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Id Observation] -> Text
showIds [Id Observation]
ignoredIds

    unknown :: Text
    unknown :: Text
unknown =
        if [Id Observation] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Id Observation]
unknownIds
        then ""
        else [Text] -> Text -> Text
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [Text
forall str. IsString str => str
bold, Text
forall str. IsString str => str
yellow] "Unrecognised Observation IDs:\n"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Id Observation] -> Text
showIds [Id Observation]
unknownIds

    showIds :: [Id Observation] -> Text
    showIds :: [Id Observation] -> Text
showIds = [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines ([Text] -> Text)
-> ([Id Observation] -> [Text]) -> [Id Observation] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Id Observation -> Text) -> [Id Observation] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) "    - " (Text -> Text)
-> (Id Observation -> Text) -> Id Observation -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id Observation -> Text
forall a. Id a -> Text
unId)

    ignoredIds, unknownIds :: [Id Observation]
    (ignoredIds :: [Id Observation]
ignoredIds, unknownIds :: [Id Observation]
unknownIds) = [Id Observation]
-> Observations -> ([Id Observation], [Id Observation])
ignoredObservations [Id Observation]
ids Observations
obs

{- | Create a stable 'Observation' 'Id' in a such way that:

1. 'Id' doesn't depend on other inspections in this file.
2. 'Id' uniquely identifies 'Observation' location.
3. 'Id's are guaranteed to be the same if the module content didn't
change between different @stan@ runs.

The 'Observation' 'Id' should look like this:

@
OBS-STAN-XXXX-<module-name-hash>-10:42
@
-}
mkObservationId :: Id Inspection -> ModuleName -> RealSrcSpan -> Id Observation
mkObservationId :: Id Inspection -> ModuleName -> RealSrcSpan -> Id Observation
mkObservationId insId :: Id Inspection
insId moduleName :: ModuleName
moduleName srcSpan :: RealSrcSpan
srcSpan = Text -> Id Observation
forall a. Text -> Id a
Id (Text -> Id Observation) -> Text -> Id Observation
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Text.intercalate "-"
    [ "OBS"
    , Id Inspection -> Text
forall a. Id a -> Text
unId Id Inspection
insId
    , ModuleName -> Text
hashModuleName ModuleName
moduleName
    , Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
srcSpan) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show (RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
srcSpan)
    ]

{- | Hash module name to a short string of length @6@. Hashing
algorithm is the following:

1. First, run SHA-1.
2. Then, encode with @base64@.
3. Last, take first @6@ characters.
-}
hashModuleName :: ModuleName -> Text
hashModuleName :: ModuleName -> Text
hashModuleName =
    Int -> Text -> Text
Text.take 6
    (Text -> Text) -> (ModuleName -> Text) -> ModuleName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Base64.encodeBase64
    (ByteString -> Text)
-> (ModuleName -> ByteString) -> ModuleName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
SHA1.hash
    (ByteString -> ByteString)
-> (ModuleName -> ByteString) -> ModuleName -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8
    (Text -> ByteString)
-> (ModuleName -> Text) -> ModuleName -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Text
unModuleName