Implement `--obfuscate`

Support replacing all (non-keyword) identifiers with
randomly generated characters

brittany.cabal

@@ -55,6 +55,7 @@ library {
     Language.Haskell.Brittany.Internal.Config
     Language.Haskell.Brittany.Internal.Config.Types
     Language.Haskell.Brittany.Internal.Config.Types.Instances
+    Language.Haskell.Brittany.Internal.Obfuscation
     Paths_brittany
   }
   other-modules: {
@@ -112,6 +113,7 @@ library {
     , czipwith >=1.0.1.0 && <1.1
     , ghc-boot-th >=8.0.1 && <8.5
     , filepath >=1.4.1.0 && <1.5
+    , random >= 1.1 && <1.2
     }
   default-extensions: {
     CPP

src-brittany/Main.hs

@@ -28,6 +28,7 @@ import           Language.Haskell.Brittany.Internal
 import           Language.Haskell.Brittany.Internal.Config
 import           Language.Haskell.Brittany.Internal.Config.Types
 import           Language.Haskell.Brittany.Internal.Utils
+import           Language.Haskell.Brittany.Internal.Obfuscation
 
 import qualified Text.PrettyPrint as PP
 
@@ -272,7 +273,10 @@ coreIO putErrorLnIO config suppressOutput inputPathM outputPathM = ExceptT.runEx
             let out = TextL.toStrict $ if hackAroundIncludes
                   then TextL.intercalate (TextL.pack "\n") $ fmap hackF $ TextL.splitOn (TextL.pack "\n") outRaw
                   else outRaw
-            pure $ (ews, out)
+            out' <- if config & _conf_obfuscate & confUnpack
+              then lift $ obfuscate out
+              else pure out
+            pure $ (ews, out')
       let customErrOrder ErrorInput{}         = 4
           customErrOrder LayoutWarning{}      = 0 :: Int
           customErrOrder ErrorOutputCheck{}   = 1

src-literatetests/Main.hs

@@ -184,6 +184,7 @@ defaultTestConfig = Config
   , _conf_preprocessor              = _conf_preprocessor staticDefaultConfig
   , _conf_forward = ForwardOptions {_options_ghc = Identity []}
   , _conf_roundtrip_exactprint_only = coerce False
+  , _conf_obfuscate = coerce False
   }
 
 contextFreeTestConfig :: Config

src-unittests/TestUtils.hs

@@ -66,4 +66,5 @@ defaultTestConfig = Config
   , _conf_preprocessor              = (_conf_preprocessor staticDefaultConfig)
   , _conf_forward = ForwardOptions {_options_ghc = Identity []}
   , _conf_roundtrip_exactprint_only = coerce False
+  , _conf_obfuscate = coerce False
   }

src/Language/Haskell/Brittany/Internal/Config.hs

@@ -90,6 +90,7 @@ staticDefaultConfig = Config
     { _options_ghc = Identity []
     }
   , _conf_roundtrip_exactprint_only  = coerce False
+  , _conf_obfuscate                  = coerce False
   }
 
 forwardOptionsSyntaxExtsEnabled :: ForwardOptions
@@ -143,6 +144,7 @@ cmdlineConfigParser = do
                                            ["ghc-options"]
                                            "STRING"
                                            (flagHelp $ parDoc "allows to define default language extensions. The parameter is forwarded to ghc.")
+  obfuscate <- addSimpleBoolFlag "" ["obfuscate"] (flagHelp $ parDoc "apply obfuscator to the output.")
 
   return $ Config
     { _conf_version = mempty
@@ -190,6 +192,7 @@ cmdlineConfigParser = do
       { _options_ghc = [ optionsGhc & List.unwords & CmdArgs.splitArgs | not $ null optionsGhc ]
       }
     , _conf_roundtrip_exactprint_only  = wrapLast $ falseToNothing roundtripOnly
+    , _conf_obfuscate                  = wrapLast $ falseToNothing obfuscate
     }
  where
   falseToNothing = Option . Bool.bool Nothing (Just True)

src/Language/Haskell/Brittany/Internal/Config/Types.hs

@@ -146,6 +146,7 @@ data CConfig f = Config
   , _conf_forward       :: CForwardOptions f
   , _conf_preprocessor  :: CPreProcessorConfig f
   , _conf_roundtrip_exactprint_only :: f (Semigroup.Last Bool)
+  , _conf_obfuscate     :: f (Semigroup.Last Bool)
     -- ^ this field is somewhat of a duplicate of the one in DebugConfig.
     -- It is used for per-declaration disabling by the inline config
     -- implementation. Could have re-used the existing field, but felt risky

src/Language/Haskell/Brittany/Internal/Config/Types/Instances.hs

@@ -120,6 +120,7 @@ instance FromJSON (CConfig Maybe) where
     <*> v .:?= Text.pack "conf_forward"
     <*> v .:?= Text.pack "conf_preprocessor"
     <*> v .:?  Text.pack "conf_roundtrip_exactprint_only"
+    <*> v .:?  Text.pack "conf_obfuscate"
   parseJSON invalid    = Aeson.typeMismatch "Config" invalid
 
 -- Pretends that the value is {} when the key is not present.

src/Language/Haskell/Brittany/Internal/Obfuscation.hs

@@ -0,0 +1,100 @@
+module Language.Haskell.Brittany.Internal.Obfuscation
+  ( obfuscate
+  )
+where
+
+
+
+#include "prelude.inc"
+
+import           Data.Char
+import           System.Random
+
+
+
+obfuscate :: Text -> IO Text
+obfuscate input = do
+  let predi x = isAlphaNum x || x `elem` "_'"
+  let groups = List.groupBy (\a b -> predi a && predi b) (Text.unpack input)
+  let idents = Set.toList $ Set.fromList $ filter (all predi) groups
+  let exceptionFilter x | x `elem` keywords = False
+      exceptionFilter x | x `elem` extraKWs = False
+      exceptionFilter x                     = not $ null $ drop 1 x
+  let filtered = filter exceptionFilter idents
+  mappings <- fmap Map.fromList $ filtered `forM` \x -> do
+    r <- createAlias x
+    pure (x, r)
+  let groups' = groups <&> \w -> fromMaybe w (Map.lookup w mappings)
+  pure $ Text.concat $ fmap Text.pack groups'
+
+keywords :: [String]
+keywords =
+  [ "case"
+  , "class"
+  , "data"
+  , "default"
+  , "deriving"
+  , "do"
+  , "mdo"
+  , "else"
+  , "forall"
+  , "if"
+  , "import"
+  , "in"
+  , "infix"
+  , "infixl"
+  , "infixr"
+  , "instance"
+  , "let"
+  , "module"
+  , "newtype"
+  , "of"
+  , "qualified"
+  , "then"
+  , "type"
+  , "where"
+  , "_"
+  , "foreign"
+  , "ccall"
+  , "as"
+  , "safe"
+  , "unsafe"
+  , "hiding"
+  , "proc"
+  , "rec"
+  , "family"
+  ]
+
+extraKWs :: [String]
+extraKWs = ["return", "pure", "Int", "True", "False", "otherwise"]
+
+createAlias :: String -> IO String
+createAlias xs = go NoHint xs
+ where
+  go _hint ""       = pure ""
+  go hint (c : cr)  = do
+    c' <- case hint of
+      VocalHint | isUpper c -> randomFrom $ "AAAEEEOOOIIIUUU" ++ ['A' .. 'Z']
+      _ | isUpper c         -> randomFrom ['A' .. 'Z']
+      VocalHint | isLower c -> randomFrom $ "aaaeeeoooiiiuuu" ++ ['a' .. 'z']
+      _ | isLower c         -> randomFrom ['a' .. 'z']
+      _                     -> pure c
+    cr' <- go (if c' `elem` "aeuioAEUIO" then NoVocalHint else VocalHint) cr
+    pure (c' : cr')
+
+data Hint = NoHint | VocalHint | NoVocalHint
+
+_randomRange :: Random a => a -> a -> IO a
+_randomRange lo hi = do
+  gen <- getStdGen
+  let (x, gen') = randomR (lo, hi) gen
+  setStdGen gen'
+  pure x
+
+randomFrom :: Random a => [a] -> IO a
+randomFrom l = do
+  let hi = length l - 1
+  gen <- getStdGen
+  let (x, gen') = randomR (0, hi) gen
+  setStdGen gen'
+  pure $ l List.!! x