oh-my-gadt
slight haskell type system tomfoolery

Haskell is an introcate and beautiful language with so many features, which can help a developer write neat code.
These features can also be twisted and obfuscated to hide the workings of a program behind layers and layers of compiler addons.

Haskell is also usually a language which heavily relies on indentation. Nearly all Haskell code is written so.
But that is not mandatory. One can easily create a hellish, 2.6 KiB one-liner, imports and all.

Combine this with type-level numbers, some name obfuscation, heavy shadowing and some simple reversible flag checking with just a sprinkle of compiler addons, and you have this challenge.

Part 1: deobfuscation

Here is our source: a beautiful, 2705 character haskell one-liner, in all its horizontal scrolly glory:

{-# LANGUAGE GADTs, FlexibleInstances, FunctionalDependencies, EmptyDataDeriving #-}module Main(main)where{import Data.Char(ord);import Data.Bits(xor,Bits);import Data.Word(Word8);import System.IO;data IIlIll;data IIlIlI llIIII;lIllll::IlIlIl lIIlII->lIIlII;lIllll IlIIll=concat;lIllll IllllI=zipWith;lIllll IIlIIl=take;lIllll IIIIlI=drop;lIllll IIIlIl=length;lIllll IIllII=foldr;lIllll IIlIll=foldl1;lIllll IIIlll=xor;lIllll IlIllI=iterate;lIllll IIIllI=map;lIllll IIIIII=fromIntegral;lIllll IlllIl=ord;data IlIlIl llIIII where{IlIIll::Foldable llIllI=>IlIlIl(llIllI[lIIlII]->[lIIlII]);IllllI::IlIlIl((lIIlII->lllIII->lIlIlI)->[lIIlII]->[lllIII]->[lIlIlI]);IIlIIl::IlIlIl(Int->[lIIlII]->[lIIlII]);IIIIlI::IlIlIl(Int->[lIIlII]->[lIIlII]);IIIlIl::Foldable llIllI=>IlIlIl(llIllI lIIlII->Int);IIllII::Foldable llIllI=>IlIlIl((lIIlII->lllIII->lllIII)->lllIII->llIllI lIIlII->lllIII);IIlIll::Foldable llIllI=>IlIlIl((lIIlII->lIIlII->lIIlII)->llIllI lIIlII->lIIlII);IIIlll::Bits lIIlII=>IlIlIl(lIIlII->lIIlII->lIIlII);IlIllI::IlIlIl((lIIlII->lIIlII)->lIIlII->[lIIlII]);IIIllI::IlIlIl((lIIlII->lllIII)->[lIIlII]->[lllIII]);IIIIII::(Integral lIIlII,Num lllIII)=>IlIlIl(lIIlII->lllIII);IlllIl::IlIlIl(Char->Int)};data IlIlII llIIII where{IlIlII::[Word8]->IlIlII llIIII;};class IIIlII llIIII llIIlI|llIIII->llIIlI where{llIlII::IlIlII llIIII->IlIlII llIIlI;};instance IIIlII IIlIll(IIlIlI IIlIll)where{llIlII(IlIlII lIIIll)=IlIlII$lIllll IlIIll. lIllll IllllI(\lIIIll llIIII->lIllll IIlIIl(lIllll IIIlIl llIIII)(lIllll IIIIlI lIIIll((\lIIIll->let llIIII=lIIIll++llIIII in llIIII)llIIII)))[0..]$(let llIIll _ []=[];llIIll lllIIl llIIII=lIllll IIlIIl lllIIl llIIII:llIIll lllIIl(lIllll IIIIlI lllIIl llIIII)in llIIll 4)lIIIll;};instance IIIlII(IIlIlI IIlIll)(IIlIlI(IIlIlI IIlIll))where{llIlII(IlIlII lIIIll)=IlIlII$lIllll IIIllI(\lIIIll->6*lIIIll^6+2*lIIIll^3+lIIIll)lIIIll;};instance IIIlII(IIlIlI(IIlIlI IIlIll))(IIlIlI(IIlIlI(IIlIlI IIlIll)))where{llIlII(IlIlII lIIIll)=IlIlII$lIllll IIllII(\llIlIl lllllI@(lIIIII:_)->lIllll IIIlll lIIIII llIlIl:lllllI)[head lIIIll](tail lIIIll);};instance IIIlII(IIlIlI(IIlIlI(IIlIlI IIlIll)))IIlIll where{llIlII(IlIlII lIIIll)=IlIlII$lIllll IlIllI(\lIIIll->tail lIIIll++[lIllll IIllII(lIllll IIIlll)0 lIIIll])lIIIll!!3;};main=putStr"Flag: ">>hFlush stdout>>getLine>>= \lIIlII->putStrLn$(if(2205967053642207131367982253372196254666549571698892523008302353266425115464942068759663110459718064363978392428938015071==).lIllll IIlIll(\lllllI llIlIl->lllllI*256+llIlIl).lIllll IIIllI(lIllll IIIIII).(\(IlIlII lIIIll)->lIIIll)$(lIllll IlIllI(llIlII.llIlII.llIlII.llIlII)(IlIlII$lIllll IIIllI(lIllll IIIIII. lIllll IlllIl)lIIlII::IlIlII IIlIll)!!13)then"That's the flag!"else"Nope!")}

Our first course of action will be to get this looking like a "normal" Haskell program. We'll remove any braces and brackets, roughly place statements on their respective lines and add back some whitespace to get this:

back to text

{-# LANGUAGE GADTs, FlexibleInstances, FunctionalDependencies, EmptyDataDeriving #-}

module Main (main) where

import Data.Char (ord)
import Data.Bits (xor, Bits)
import Data.Word (Word8)
import System.IO

data IIlIll
data IIlIlI llIIII

lIllll::IlIlIl lIIlII->lIIlII
lIllll IlIIll = concat
lIllll IllllI = zipWith
lIllll IIlIIl = take
lIllll IIIIlI = drop
lIllll IIIlIl = length
lIllll IIllII = foldr
lIllll IIlIll = foldl1
lIllll IIIlll = xor
lIllll IlIllI = iterate
lIllll IIIllI = map
lIllll IIIIII = fromIntegral
lIllll IlllIl = ord

data IlIlIl llIIII where
    IlIIll :: Foldable llIllI => IlIlIl (llIllI [lIIlII] -> [lIIlII])
    IllllI :: IlIlIl ((lIIlII -> lllIII -> lIlIlI) -> [lIIlII] -> [lllIII] -> [lIlIlI])
    IIlIIl :: IlIlIl (Int -> [lIIlII] -> [lIIlII])
    IIIIlI :: IlIlIl (Int -> [lIIlII] -> [lIIlII])
    IIIlIl :: Foldable llIllI => IlIlIl (llIllI lIIlII -> Int)
    IIllII :: Foldable llIllI => IlIlIl ((lIIlII -> lllIII -> lllIII) -> lllIII -> llIllI lIIlII -> lllIII)
    IIlIll :: Foldable llIllI => IlIlIl ((lIIlII -> lIIlII -> lIIlII) -> llIllI lIIlII -> lIIlII)
    IIIlll :: Bits lIIlII => IlIlIl (lIIlII -> lIIlII -> lIIlII)
    IlIllI :: IlIlIl ((lIIlII -> lIIlII) -> lIIlII -> [lIIlII])
    IIIllI :: IlIlIl ((lIIlII -> lllIII) -> [lIIlII] -> [lllIII])
    IIIIII :: (Integral lIIlII, Num lllIII) => IlIlIl (lIIlII -> lllIII)
    IlllIl :: IlIlIl (Char -> Int)

data IlIlII llIIII where
    IlIlII :: [Word8] -> IlIlII llIIII
    
class IIIlII llIIII llIIlI | llIIII -> llIIlI where
    llIlII :: IlIlII llIIII -> IlIlII llIIlI
    
instance IIIlII IIlIll (IIlIlI IIlIll) where
    llIlII (IlIlII lIIIll) = IlIlII $ lIllll IlIIll . lIllll IllllI fn1 [0..] $ fn3 lIIIll
        where
            fn1 = (\lIIIll llIIII -> lIllll IIlIIl (lIllll IIIlIl llIIII) (lIllll IIIIlI lIIIll (fn2 llIIII)))
            fn2 = (\lIIIll -> let llIIII = lIIIll ++ llIIII in llIIII)
            fn3 = (let llIIll _ [] = [];
                       llIIll lllIIl llIIII = lIllll IIlIIl lllIIl llIIII:llIIll lllIIl (lIllll IIIIlI lllIIl llIIII)
                   in llIIll 4)
    
instance IIIlII (IIlIlI IIlIll) (IIlIlI (IIlIlI IIlIll)) where
    llIlII (IlIlII lIIIll) = IlIlII $ lIllll IIIllI (\lIIIll -> 6*lIIIll^6+2*lIIIll^3+lIIIll) lIIIll
    
instance IIIlII (IIlIlI (IIlIlI IIlIll)) (IIlIlI (IIlIlI (IIlIlI IIlIll))) where
    llIlII (IlIlII lIIIll) = IlIlII $ lIllll IIllII (\llIlIl lllllI@(lIIIII:_) -> lIllll IIIlll lIIIII llIlIl:lllllI) [head lIIIll] (tail lIIIll)
    
instance IIIlII (IIlIlI (IIlIlI (IIlIlI IIlIll))) IIlIll where
    llIlII (IlIlII lIIIll) = IlIlII $ lIllll IlIllI (\lIIIll->tail lIIIll++[lIllll IIllII (lIllll IIIlll) 0 lIIIll]) lIIIll !! 3
    
main = do
    putStr "Flag: "
    hFlush stdout
    lIIlII <- getLine
    putStrLn $ (
        if 2205967053642207131367982253372196254666549571698892523008302353266425115464942068759663110459718064363978392428938015071 == (
            lIllll IIlIll (\lllllI llIlIl -> lllllI*256+llIlIl)
                . lIllll IIIllI (lIllll IIIIII)
                . (\(IlIlII lIIIll) -> lIIIll)
                $ (lIllll IlIllI (llIlII.llIlII.llIlII.llIlII) (IlIlII $ lIllll IIIllI (lIllll IIIIII. lIllll IlllIl) lIIlII :: IlIlII IIlIll) !! 13)
            )
            then "That's the flag!"
            else "Nope!"
        )

We also extracted some methods out to make it slightly more readable. [

extracted functions highlightedhighlight extracted functions

]

Next, we'll check out the lIllll method and IlIlIl data type:

lIllll::IlIlIl lIIlII->lIIlII
lIllll IlIIll = concat
lIllll IllllI = zipWith
lIllll IIlIIl = take
lIllll IIIIlI = drop
lIllll IIIlIl = length
lIllll IIllII = foldr
lIllll IIlIll = foldl1
lIllll IIIlll = xor
lIllll IlIllI = iterate
lIllll IIIllI = map
lIllll IIIIII = fromIntegral
lIllll IlllIl = ord

data IlIlIl llIIII where
    IlIIll :: Foldable llIllI => IlIlIl (llIllI [lIIlII] -> [lIIlII])
    IllllI :: IlIlIl ((lIIlII -> lllIII -> lIlIlI) -> [lIIlII] -> [lllIII] -> [lIlIlI])
    IIlIIl :: IlIlIl (Int -> [lIIlII] -> [lIIlII])
    IIIIlI :: IlIlIl (Int -> [lIIlII] -> [lIIlII])
    IIIlIl :: Foldable llIllI => IlIlIl (llIllI lIIlII -> Int)
    IIllII :: Foldable llIllI => IlIlIl ((lIIlII -> lllIII -> lllIII) -> lllIII -> llIllI lIIlII -> lllIII)
    IIlIll :: Foldable llIllI => IlIlIl ((lIIlII -> lIIlII -> lIIlII) -> llIllI lIIlII -> lIIlII)
    IIIlll :: Bits lIIlII => IlIlIl (lIIlII -> lIIlII -> lIIlII)
    IlIllI :: IlIlIl ((lIIlII -> lIIlII) -> lIIlII -> [lIIlII])
    IIIllI :: IlIlIl ((lIIlII -> lllIII) -> [lIIlII] -> [lllIII])
    IIIIII :: (Integral lIIlII, Num lllIII) => IlIlIl (lIIlII -> lllIII)
    IlllIl :: IlIlIl (Char -> Int)

It seems that the lIllll method simply takes a single argument and returns a function based on that argument.
We can simply search and replace all instances of this in the code with their respective functions.
[see code with

instances highlightedinstances not highlighted

]

What's up with the data declaration? (aka. what is a GADT?)

Haskell is incredibly strict about its types. This allows for incredible things, even algebra on the type level, but complicates things for cursed rev challenges.
This stricness means that a function which returns a function must have the return type of the returned function in its own return type. (terrible phrasing, sorry.)
This is fine if all possible return values have the same type, but as soon as it has two possible return values, things become more complicated.

Of course, there is a GHC extension that gives us a solution, that being GADTs. A GADT is an algebraic data type with a more locked-down type.
I think this is easiest to demonstrate by example.

Note: assume all examples here are compiled with the top-level comment {-# LANGUAGE GADTs #-} or the command-line flag -XGADTs

Let's try to make a function which returns values of different types based on the first integer argument.

fn :: Int -> a
fn 1 = "hello"
fn 2 = Nothing

This will fail to compile. Haskell does not like the fact that the return type of a function is determined by a value, not its type.
If we passed some value which we do not know at compile time (e.g. user input) to fn, the compiler cannot infer the return type, thus violating type safety.

We could try to define a data type which simply wraps a value, then pattern matching on its type, like this:

data BoxT a = Box a

fn :: BoxT a -> a
fn (Box 1) = 33
fn (Box "a") = "hello"

Not only is this cumbersome by having to define placeholder values in the pattern matches, this still won't compile! Try it for yourself!
The problem is, that the `a` type variable is rigidly defined only by the return value. The type inside the pattern match is "ignored" for type refinement. So, when the compiler comes to the second pattern match, its return type differs, causing an error.

Here's where GADTs come along. Instead of letting the type of a data constructor be generic (i.e. BoxT a), we "lock" the type variable in the return type to a specific type.

data GADT a where
    CharT :: GADT Char
    IntT  :: GADT Int

fn :: GADT a -> a
fn CharT = 'x'
fn IntT  = 3

When fn matches against a CharT, the `a` type variable gets refined to a Char [

refinement highlightedrefinement not highlighted

]. The exact same thing happens for the IntT pattern match.
Because our type variable in the function signature is refined based on the arguemnt of the function, not its return value, varying arguments can lead to different result types - you just have to bake the type into the argument.

Doing so, we get this:

back to text

{-# LANGUAGE GADTs, FlexibleInstances, FunctionalDependencies, EmptyDataDeriving #-}

module Main (main) where

import Data.Char (ord)
import Data.Bits (xor, Bits)
import Data.Word (Word8)
import System.IO

data IIlIll
data IIlIlI llIIII

data IlIlII llIIII where
    IlIlII :: [Word8] -> IlIlII llIIII
    
class IIIlII llIIII llIIlI | llIIII -> llIIlI where
    llIlII :: IlIlII llIIII -> IlIlII llIIlI
    
instance IIIlII IIlIll (IIlIlI IIlIll) where
    llIlII (IlIlII lIIIll) = IlIlII $ concat . zipWith fn1 [0..] $ fn3 lIIIll
        where
            fn1 = (\lIIIll llIIII -> take (length llIIII) (drop lIIIll (fn2 llIIII)))
            fn2 = (\lIIIll -> let llIIII = lIIIll ++ llIIII in llIIII)
            fn3 = (let llIIll _ [] = [];
                       llIIll lllIIl llIIII = take lllIIl llIIII:llIIll lllIIl (drop lllIIl llIIII)
                   in llIIll 4)
    
instance IIIlII (IIlIlI IIlIll) (IIlIlI (IIlIlI IIlIll)) where
    llIlII (IlIlII lIIIll) = IlIlII $ map (\lIIIll -> 6*lIIIll^6+2*lIIIll^3+lIIIll) lIIIll
    
instance IIIlII (IIlIlI (IIlIlI IIlIll)) (IIlIlI (IIlIlI (IIlIlI IIlIll))) where
    llIlII (IlIlII lIIIll) = IlIlII $ foldr (\llIlIl lllllI@(lIIIII:_) -> xor lIIIII llIlIl:lllllI) [head lIIIll] (tail lIIIll)
    
instance IIIlII (IIlIlI (IIlIlI (IIlIlI IIlIll))) IIlIll where
    llIlII (IlIlII lIIIll) = IlIlII $ iterate (\lIIIll->tail lIIIll++[foldr xor 0 lIIIll]) lIIIll !! 3
    
main = do
    putStr "Flag: "
    hFlush stdout
    lIIlII <- getLine
    putStrLn $ (
        if 2205967053642207131367982253372196254666549571698892523008302353266425115464942068759663110459718064363978392428938015071 == (
            foldl1 (\lllllI llIlIl -> lllllI*256+llIlIl)
                . map fromIntegral
                . (\(IlIlII lIIIll) -> lIIIll)
                $ (iterate (llIlII.llIlII.llIlII.llIlII) (IlIlII $ map (fromIntegral . ord) lIIlII :: IlIlII IIlIll) !! 13)
            )
            then "That's the flag!"
            else "Nope!"
        )

We'll take a look at two interesting data declarations that are closely linked and pop up at specific places in the code: the IIlIll and IIlIlI data types.
[see relevant code with

occurences highlightedoccurences not highlighted

]

These two datatypes represent Peano numbers. This is a way of representing natural numbers at the type level. A number is defined as either zero, or a successor of a peano number.

data Zero
data Next a

-- for example:
type Two = Next (Next Zero)

Taking a look at the two types in our code, this and its uses line up exactly with Peano numbers!
Lets rename them to match, and make type aliases for numbers 1-3. Then, we replace any uses of these numbers with their type aliases.

{-# LANGUAGE GADTs, FlexibleInstances, FunctionalDependencies, EmptyDataDeriving #-}

module Main (main) where

import Data.Char (ord)
import Data.Bits (xor, Bits)
import Data.Word (Word8)
import System.IO

data Zero
data Next num

type One = Next Zero
type Two = Next One
type Three = Next Two

data IlIlII llIIII where
    IlIlII :: [Word8] -> IlIlII llIIII
    
class IIIlII s1 s2 | s1 -> s2 where
    llIlII :: IlIlII s1 -> IlIlII s2
    
instance IIIlII Zero One where
    llIlII (IlIlII lIIIll) = IlIlII $ concat . zipWith fn1 [0..] $ fn3 lIIIll
        where
            fn1 = (\lIIIll llIIII -> take (length llIIII) (drop lIIIll (fn2 llIIII)))
            fn2 = (\lIIIll -> let llIIII = lIIIll ++ llIIII in llIIII)
            fn3 = (let llIIll _ [] = [];
                       llIIll lllIIl llIIII = take lllIIl llIIII:llIIll lllIIl (drop lllIIl llIIII)
                   in llIIll 4)
    
instance IIIlII One Two where
    llIlII (IlIlII lIIIll) = IlIlII $ map (\lIIIll -> 6*lIIIll^6+2*lIIIll^3+lIIIll) lIIIll
    
instance IIIlII Two Three where
    llIlII (IlIlII lIIIll) = IlIlII $ foldr (\llIlIl lllllI@(lIIIII:_) -> xor lIIIII llIlIl:lllllI) [head lIIIll] (tail lIIIll)
    
instance IIIlII Three Zero where
    llIlII (IlIlII lIIIll) = IlIlII $ iterate (\lIIIll->tail lIIIll++[foldr xor 0 lIIIll]) lIIIll !! 3
    
main = do
    putStr "Flag: "
    hFlush stdout
    lIIlII <- getLine
    putStrLn $ (
        if 2205967053642207131367982253372196254666549571698892523008302353266425115464942068759663110459718064363978392428938015071 == (
            foldl1 (\lllllI llIlIl -> lllllI*256+llIlIl)
                . map fromIntegral
                . (\(IlIlII lIIIll) -> lIIIll)
                $ (iterate (llIlII.llIlII.llIlII.llIlII) (IlIlII $ map (fromIntegral . ord) lIIlII :: IlIlII Zero) !! 13)
            )
            then "That's the flag!"
            else "Nope!"
        )

And now for the fun part, removing any remaining name obfuscation. I'll be referencing the obfuscated names sparingly, using highlights in the above code instead.

This type

is a container for [Word8] data with a number state. We'll name it "descriptively", giving the type the name ContainerType and the constructor DataContainer.

This class

is a class (interface in OOP speak) with a single method. This method takes a DataContainer scrambles its contents in one of four ways, returning a DataContainer with scrambled data and its next scramble type. The method will be called scramble and the class Scrambler.

Really, that's most of the name obfuscation done now. All that's left to rename are some lambda arguments and pattern matches, but those are usually ultra-descriptive one-character names anyways.
When renaming these, we must not use a simple global search-and-replace, as many names are shadowed. Using a language server for this can help.

All that's left are the three functions we extracted earlier in the Zero One instance of Scrambler. Lets reanme some arguments, take them out of the lambda syntax if possible and take a look at them:

fn1 n l = take (length l) (drop n (fn2 l))
fn2 l = let l' = l ++ l' in l'
fn3 = (let int_fn _ [] = [];
           int_fn n l = take n l:int_fn n (drop n l)
       in int_fn 4)

fn2 looks an awful lot like the cycle builtin (defined here):

cycle    :: HasCallStack => [a] -> [a]
cycle [] = errorEmptyList "cycle"
cycle xs = xs' where xs' = xs ++ xs'

In fact, it is cycle, just without the empty list error condition and a let instead of a where. Let's just replace the fn2 call with cycle.
fn1 rotates a list by n to the left, and fn3 splits a list every four elements. We'll also include the split length in the updated function signature to get rid of that awkward let expression.

We are left with this:

{-# LANGUAGE GADTs, FlexibleInstances, FunctionalDependencies, EmptyDataDeriving #-}

module Main (main) where

import Data.Char (ord)
import Data.Bits (xor, Bits)
import Data.Word (Word8)
import System.IO

data Zero
data Next num

type One = Next Zero
type Two = Next One
type Three = Next Two

data ContainerType currentState where
    DataContainer :: [Word8] -> ContainerType currentState
    
class Scrambler s1 s2 | s1 -> s2 where
    scramble :: ContainerType s1 -> ContainerType s2
    
instance Scrambler Zero One where
    scramble (DataContainer str) = DataContainer $ concat . zipWith rotate [0..] $ splitEvery 4 str
        where
            rotate n str = take (length str) (drop n (cycle str))
            splitEvery _ [] = [];
            splitEvery n str = take n str:splitEvery n (drop n str)
    
instance Scrambler One Two where
    scramble (DataContainer str) = DataContainer $ map (\c -> 6*c^6+2*c^3+c) str
    
instance Scrambler Two Three where
    scramble (DataContainer str) = DataContainer $ foldr (\next acc@(hd:_) -> xor hd next:acc) [head str] (tail str)
    
instance Scrambler Three Zero where
    scramble (DataContainer str) = DataContainer $ iterate (\iterStr->tail iterStr++[foldr xor 0 iterStr]) str !! 3
    
main = do
    putStr "Flag: "
    hFlush stdout
    line <- getLine
    putStrLn $ (
        if 2205967053642207131367982253372196254666549571698892523008302353266425115464942068759663110459718064363978392428938015071 == (
            foldl1 (\num chr -> num*256+chr)
                . map fromIntegral
                . (\(DataContainer str) -> str)
                $ (iterate (scramble.scramble.scramble.scramble) (DataContainer $ map (fromIntegral . ord) line :: DataContainer Zero) !! 13)
            )
            then "That's the flag!"
            else "Nope!"
        )

What's up with the arrows after the class declaration? (aka. what are functional dependencies)

The first line of the class definition reads as follows:

class Scrambler s1 s2 | s1 -> s2 where
    scramble :: ContainerType s1 -> ContainerType s2

The highlighted part indicates that s2 is uniquely defined by s1
Without this, the compiler could not accurately infer the result state s2 after a scramble. Additionally, a scrambling from Zero to Zero would be perfectly valid in the eyes of the compiler, but an instance for that doesn't exist, so we'd get a compiler error.
We must specifically inform the compiler that this s1 defines the result state.

What's up with the currentState type specifier not being used in the DataContainer constructor? (aka. what are phantom types)

The ContainerType definition can be writen like this:

data ContainerType currentState = DataContainer [Word8]

The unused currentState type is what makes this type a phantom type.
It is useful to signify a change on the type level without actually changing any data inside. Here, this is used to carry scramble state information outside of the data.
The Haskell Wiki entry linked below has a good example of this being used in actual projects as a validation parameter.

A last, completely optional thing we'll do is to simplify out the Scrambler class and DataContainer constructor (which is in GADT syntax for no good reason [chall author note: completely intended™]) in favor of a simple function and a tuple with the data and state.
Finally, we have some remotely normal Haskell code:

module Main (main) where

import Data.Char (ord)
import Data.Bits (xor, Bits)
import Data.Word (Word8)
import System.IO

scramble :: (Int, [Word8]) -> (Int, [Word8])
scramble (0, str) = (1, res)
        where
            res = concat . zipWith rotate [0..] $ splitEvery 4 str
            rotate n str = take (length str) (drop n (cycle str))
            splitEvery _ [] = [];
            splitEvery n str = take n str:splitEvery n (drop n str)
scramble (1, str) = (2, map (\c -> 6*c^6+2*c^3+c) str)
scramble (2, str) = (3, foldr (\next acc@(hd:_) -> xor hd next:acc) [head str] (tail str))
scramble (3, str) = (0, (iterate (\iterStr->tail iterStr++[foldr xor 0 iterStr]) str) !! 3)
    
main = do
    putStr "Flag: "
    hFlush stdout
    line <- getLine
    putStrLn $ (
        if 2205967053642207131367982253372196254666549571698892523008302353266425115464942068759663110459718064363978392428938015071 == (
            foldl1 (\num chr -> num*256+chr)
                . map fromIntegral . snd
                $ (iterate scramble (0, map (fromIntegral . ord) line) !! (13*4))
            )
            then "That's the flag!"
            else "Nope!"
        )

Part 2: flag checker reversing

All the flag checker does is:

get user input and transform every character into an unsigned byte
send it through 13 cycles of scrambling with an initial scramble state of Zero
transform this list of bytes into a big integer
compare this to a static value

Every step of this is completely reversible.

Part 2.1: reversing every scramble operation

Scramble state 0 splits the input into rows of four, then rotates every row by its index, like so:

⇒

Scramble state 1 maps each element through a lookup table, given by the equation 6c⁶+2c³+c

Scramble state 2 goes element-by-element over the tail of the input, xoring it with the last value from this reduction and prepending it to the start of the list.

Scramble state 3 xors the entire list together to get a value, pops the last value of the list and prepends the xored value, doing this three times.

To reverse from the big int, we convert it back into a list of bytes and start at scramble state 3, going backwards.

All together in a solve script, the reversing looks like this:

from pwn import concat, xor

def doManyUnscrambleSteps(bs, i):
    t = bs
    for it in range(i):
        t = doUnscrambleStep(t)
    return t

def splitevery(line,n):
    return [line[i:i+n] for i in range(0, len(line), n)]
def doUnscrambleStep(bs):
    def s1step(c):
        def splitevery(line,n):
            return [line[i:i+n] for i in range(0, len(line), n)]
        def rotate(l, n):
            return l[(n%len(l)):] + l[:n%len(l)]

        return concat([rotate(ss,-i) for (i,ss) in enumerate(splitevery(c,4))])

    def s2step(c):
        f = lambda x: (6*x**6+2*x**3+x)%256
        l = [f(x) for x in range(0,256)]
        il = [l.index(x) for x in range(256)]
        return [il[x] for x in c]

    def s3step(c):
        rs4 = list(reversed(c))
        hs3 = [e ^ (rs4[i-1] if i != 0 else 0) for (i, e) in enumerate(rs4)]
        return [hs3[0]]+list(reversed(hs3[1:]))

    def s4Step(i):
        return [xor(*i)[0]] + i[:-1]
    s4 = s4Step(s4Step(s4Step(bs)))

    s3 = s3step(s4)

    s2 = s2step(s3)

    s1 = s1step(s2)
    return list(bytes(s1))

inp = 2205967053642207131367982253372196254666549571698892523008302353266425115464942068759663110459718064363978392428938015071
iters = 13
inpArray = [int(x,16) for x in splitevery(hex(inp),2)[1:]]
print(bytes(doManyUnscrambleSteps(inpArray, iters)).decode("ascii"))

Finally, running it gives us our flag: MVM{::333:3:/::33::33/w0w_g4d75_n_ph4n70m5_y1pp33}
Reversing the meaning of flag bytes [4:21] is left as an exercise to the reader.

Part 3: Conclusion

Thanks for reading through my first writeup! I had a lot of fun making those highlights and buttons with only CSS - inspired of course by Rebane's incredible writeups and css crimes. Most of this writeup was focused on the obfuscation of the flag checker, not the logic of the flag checker. Personally, the focus of this writeup was more on exploring what the Haskell type system gives us, rather than on my amateur improvised flag checking.

I was the author of this challenge, and making this challenge was also a lot of fun. It was crazy seeing it get first blooded in 40 minutes, when I didn't even write my own solve script that fast.

If you have any questions, just ask! I'll be there to answer anything as discord user with ID 559841721106694146, whether that be questions about the challenge or the css involved in making this writeup.

/root/blog/oh-my-gadt slight haskell type system tomfoolery

Part 1: deobfuscation

Part 2: flag checker reversing

Part 2.1: reversing every scramble operation

Part 3: Conclusion

/root/blog/oh-my-gadt
slight haskell type system tomfoolery