diff --git a/double-x-encoding.cabal b/double-x-encoding.cabal
new file mode 100644
--- /dev/null
+++ b/double-x-encoding.cabal
@@ -0,0 +1,61 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.36.0.
+--
+-- see: https://github.com/sol/hpack
+
+name:           double-x-encoding
+version:        1.1.0.0
+synopsis:       Encoding scheme to encode any Unicode string with only [0-9a-zA-Z_]
+description:    Double-X-Encoding is an encoding scheme to encode any Unicode string
+                with only characters from [0-9a-zA-Z_].
+                Therefore it's quite similar to URL percent-encoding.
+                It's especially useful for GraphQL ID generation,
+                as it includes support for encoding leading digits and double underscores.
+category:       Codec, Codecs, GraphQL, ASCII, Unicode, Encoding, Decoding
+homepage:       https://github.com/Airsequel/double-x-encoding#readme
+bug-reports:    https://github.com/Airsequel/double-x-encoding/issues
+author:         Adrian Sieber
+maintainer:     adrian@feram.io
+license:        ISC
+build-type:     Simple
+
+source-repository head
+  type: git
+  location: https://github.com/Airsequel/double-x-encoding
+  subdir: Haskell
+
+library
+  exposed-modules:
+    DoubleXEncoding
+  other-modules:
+    Paths_double_x_encoding
+  hs-source-dirs:
+    source
+  default-extensions:
+    LambdaCase
+    MultiWayIf
+    OverloadedStrings
+  build-depends:
+    Cabal-syntax >=3.10 && <3.12,
+    base >=4.18 && <4.20,
+    text >=2.0 && <2.2
+  default-language: GHC2021
+
+test-suite double-x-encoding-test
+  type: exitcode-stdio-1.0
+  main-is: Main.hs
+  other-modules:
+    Paths_double_x_encoding
+  hs-source-dirs:
+    tests
+  default-extensions:
+    LambdaCase
+    MultiWayIf
+    OverloadedStrings
+  build-depends:
+    Cabal-syntax >=3.10 && <3.12,
+    base >=4.18 && <4.20,
+    double-x-encoding,
+    text >=2.0 && <2.2
+  default-language: GHC2021
diff --git a/source/DoubleXEncoding.hs b/source/DoubleXEncoding.hs
new file mode 100644
--- /dev/null
+++ b/source/DoubleXEncoding.hs
@@ -0,0 +1,313 @@
+-- | Implementation of double-X-encoder and -decoder in Haskell
+{- ORMOLU_DISABLE -}
+
+module DoubleXEncoding where
+
+import Data.Function ((&))
+import qualified Data.Text as T
+import Data.Text (replace, Text)
+import Data.Functor ((<&>))
+import Distribution.Utils.Generic (isAsciiAlphaNum)
+import Numeric (showHex, readHex)
+import Data.Char (ord, isDigit, chr)
+import Control.Monad (join)
+
+
+-- | charEncode mapping in Haskell
+charEncode :: Char -> Char
+charEncode = \case
+  ' ' -> '0'
+  '!' -> '1'
+  '"' -> '2'
+  '#' -> '3'
+  '$' -> '4'
+  '%' -> '5'
+  '&' -> '6'
+  '\'' -> '7'
+  '(' -> '8'
+  ')' -> '9'
+  '*' -> 'A'
+  '+' -> 'B'
+  ',' -> 'C'
+  '-' -> 'D'
+  '.' -> 'E'
+  '/' -> 'F'
+
+  ':' -> 'G'
+  ';' -> 'H'
+  '<' -> 'I'
+  '=' -> 'J'
+  '>' -> 'K'
+  '?' -> 'L'
+  '@' -> 'M'
+
+  '[' -> 'N'
+  '\\' -> 'O'
+  ']' -> 'P'
+  '^' -> 'Q'
+  '_' -> 'R'
+  '`' -> 'S'
+
+  '{' -> 'T'
+  '|' -> 'U'
+  '}' -> 'V'
+  '~' -> 'W'
+
+  -- TODO: Remove this parsing workaround. Should be "X": "X"
+  'X' -> 'x'
+
+  -- '': 'Z',  -- Reserved for encoding digits
+
+  _ -> '\0'
+
+
+charDecode :: Char -> Char
+charDecode = \case
+  '0' -> ' '
+  '1' -> '!'
+  '2' -> '"'
+  '3' -> '#'
+  '4' -> '$'
+  '5' -> '%'
+  '6' -> '&'
+  '7' -> '\''
+  '8' -> '('
+  '9' -> ')'
+  'A' -> '*'
+  'B' -> '+'
+  'C' -> ','
+  'D' -> '-'
+  'E' -> '.'
+  'F' -> '/'
+
+  'G' -> ':'
+  'H' -> ';'
+  'I' -> '<'
+  'J' -> '='
+  'K' -> '>'
+  'L' -> '?'
+  'M' -> '@'
+
+  'N' -> '['
+  'O' -> '\\'
+  'P' -> ']'
+  'Q' -> '^'
+  'R' -> '_'
+  'S' -> '`'
+
+  'T' -> '{'
+  'U' -> '|'
+  'V' -> '}'
+  'W' -> '~'
+
+  -- TODO: Remove this parsing workaround. Should be "X": "X"
+  'x' -> 'X'
+
+  _ -> '\0'
+
+
+hexShiftEncode :: Char -> Char
+hexShiftEncode = \case
+  '0' -> 'a'
+  '1' -> 'b'
+  '2' -> 'c'
+  '3' -> 'd'
+  '4' -> 'e'
+  '5' -> 'f'
+  '6' -> 'g'
+  '7' -> 'h'
+  '8' -> 'i'
+  '9' -> 'j'
+  'a' -> 'k'
+  'b' -> 'l'
+  'c' -> 'm'
+  'd' -> 'n'
+  'e' -> 'o'
+  'f' -> 'p'
+
+  _ -> '\0'
+
+
+hexShiftDecode :: Char -> Char
+hexShiftDecode = \case
+  'a' -> '0'
+  'b' -> '1'
+  'c' -> '2'
+  'd' -> '3'
+  'e' -> '4'
+  'f' -> '5'
+  'g' -> '6'
+  'h' -> '7'
+  'i' -> '8'
+  'j' -> '9'
+  'k' -> 'a'
+  'l' -> 'b'
+  'm' -> 'c'
+  'n' -> 'd'
+  'o' -> 'e'
+  'p' -> 'f'
+
+  _ -> '\0'
+
+
+data EncodeOptions = EncodeOptions
+  { encodeLeadingDigit :: Bool
+  , encodeDoubleUnderscore :: Bool
+  }
+
+
+doubleXEncodeWithOptions :: EncodeOptions -> Text -> Text
+doubleXEncodeWithOptions encodeOptions text =
+  let
+    encodeStandard text = text
+      & replace "XX" "XXXXXX"
+      & (\txt ->
+          if encodeOptions&encodeDoubleUnderscore
+          then txt & replace "__" "XXRXXR"
+          else txt
+        )
+      & T.unpack
+      <&> (\char ->
+            if isAsciiAlphaNum char || char == '_'
+            then [char]
+            else
+              if charEncode char /= '\0'
+              then ['X', 'X', charEncode char]
+              else
+                let
+                  charHex = showHex (ord char) ""
+                  charHexEncoded = charHex <&> hexShiftEncode
+                  padStart n txt = replicate (n - length txt) 'a' ++ txt
+                in
+                  if
+                    | length charHex <= 5 ->
+                        "XX" ++ padStart 5 charHexEncoded
+                    | length charHex == 6 ->
+                        "XXY" ++ padStart 6 charHexEncoded
+                    | otherwise ->
+                        error "ERROR: Hex encoding is too long"
+          )
+      & join
+      & T.pack
+
+    encodeDigit digit =
+      T.pack ['X', 'X', 'Z', digit]
+  in
+    if encodeOptions&encodeLeadingDigit
+    then
+      case T.unpack text of
+        [] -> ""
+
+        leadingChar : rest  ->
+          if not $ isDigit leadingChar
+          then encodeStandard text
+          else
+            if null rest
+            then encodeDigit leadingChar
+            else
+              encodeDigit leadingChar
+              <> doubleXEncodeWithOptions
+                    encodeOptions { encodeLeadingDigit = False }
+                    (T.pack rest)
+    else
+      encodeStandard text
+
+
+
+
+defaultOptions :: EncodeOptions
+defaultOptions = EncodeOptions
+    { encodeLeadingDigit = False
+    , encodeDoubleUnderscore = False
+    }
+
+
+doubleXEncode :: Text -> Text
+doubleXEncode =
+    doubleXEncodeWithOptions defaultOptions
+
+
+gqlOptions :: EncodeOptions
+gqlOptions = EncodeOptions
+    { encodeLeadingDigit = True
+    , encodeDoubleUnderscore = True
+    }
+
+
+doubleXEncodeGql :: Text -> Text
+doubleXEncodeGql =
+    doubleXEncodeWithOptions gqlOptions
+
+
+parseHex :: Text -> Int
+parseHex text =
+  case readHex (T.unpack text) of
+    [(int, "")] -> int
+    _ -> 0
+
+
+doubleXDecode :: Text -> Text
+doubleXDecode text =
+  let
+    decodeWord :: Text -> (Text, Text)
+    decodeWord word =
+      let
+        noXX = T.drop 2 word
+        first = T.take 1 noXX
+      in
+        if  | first >= "a" && first <= "p" ->
+                (T.pack [
+                    noXX
+                      & T.unpack
+                      & take 5
+                      <&> hexShiftDecode
+                      & T.pack
+                      & parseHex
+                      & chr
+                  ]
+                , T.drop 5 noXX
+                )
+
+            | first == "X" ->
+                if "XXXX" `T.isPrefixOf` noXX
+                then ("XX", T.drop 4 noXX)
+                else ("X", T.drop 1 word)
+
+            | first == "Y" ->
+                (T.pack [
+                    noXX
+                      & T.drop 1  -- Remove the "Y"
+                      & T.unpack
+                      & take 6
+                      <&> hexShiftDecode
+                      & T.pack
+                      & parseHex
+                      & chr
+                  ]
+                , T.drop 7 noXX
+                )
+
+            | first == "Z" ->
+                (noXX
+                    & T.drop 1
+                    & T.take 1
+                , T.drop 2 noXX
+                )
+
+            | otherwise ->
+              (noXX
+                & T.take 1
+                & T.unpack
+                <&> charDecode
+                & T.pack
+              , T.drop 1 noXX
+              )
+  in
+    text
+      & T.breakOn "XX"
+      & \case
+          ("", end) -> case decodeWord end of
+            (decoded, "") -> decoded
+            (decoded, rest) -> decoded <> doubleXDecode rest
+          (start, "") -> start
+          (start, end) -> start <> doubleXDecode end
diff --git a/tests/Main.hs b/tests/Main.hs
new file mode 100644
--- /dev/null
+++ b/tests/Main.hs
@@ -0,0 +1,109 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+{- ORMOLU_DISABLE -}
+
+module Main where
+
+import Data.Function ((&))
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import Data.Functor ((<&>))
+import Distribution.Utils.Generic (isAsciiAlphaNum)
+import Numeric (showHex)
+import Data.Char (ord, isDigit)
+import Control.Monad (join)
+
+import DoubleXEncoding
+  (EncodeOptions(..), doubleXEncode, doubleXEncodeGql, doubleXDecode)
+
+
+main :: IO ()
+main = do
+  let
+    getEncoderTest encoder a b = T.putStrLn $
+      if encoder a /= b
+      then
+        "❌ ENCODE ERROR: "
+        <> a <> " | " <> encoder a <> " /= " <> b
+      else
+        if doubleXDecode (encoder a) /= a
+        then
+          "❌ DECODE ERROR: "
+          <> a <> " | " <> doubleXDecode (encoder a) <> " /= " <> a
+        else
+          "✅ " <> a <> ": " <> encoder a <> " == " <> b
+
+
+    expectEncode a b =
+      getEncoderTest doubleXEncode a b
+
+    expectEncodeGql a b =
+      getEncoderTest doubleXEncodeGql a b
+
+    expectDecode a b = T.putStrLn $
+        if doubleXDecode a /= b
+        then
+            "❌ DECODE ERROR: "
+            <> a <> " | " <> doubleXDecode a <> " /= " <> b
+        else
+            "✅ " <> a <> ": " <> doubleXDecode a <> " == " <> b
+
+  expectEncode "camelCaseId" "camelCaseId"
+  expectEncode "snake_case_id" "snake_case_id"
+  expectEncode "__Schema" "__Schema"
+  expectEncode "0test" "0test"
+  expectEncode "doxxing" "doxxing"
+  expectEncode "DOXXING" "DOXXXXXXING"
+  expectEncode "XXX" "XXXXXXX"
+  expectEncode ">XXX<" "XXKXXXXXXXXXI"
+  expectEncode "id with spaces" "idXX0withXX0spaces"
+  expectEncode "%" "XX5"
+  expectEncode "id-with.special$chars!" "idXXDwithXXEspecialXX4charsXX1"
+  expectEncode "id_with_ümläutß" "id_with_XXaaapmmlXXaaaoeutXXaaanp"
+  expectEncode "Emoji: 😅" "EmojiXXGXX0XXbpgaf"
+  expectEncode "Multi Byte Emoji: \x1f468\x200D\x1f9b2"
+    "MultiXX0ByteXX0EmojiXXGXX0XXbpegiXXacaanXXbpjlc"
+  -- Support characters from the Supplementary Private Use Area-B
+  expectEncode "\x100000" "XXYbaaaaa"
+  expectEncode "\x10FFFF" "XXYbapppp"
+
+  expectEncodeGql "__Schema" "XXRXXRSchema"
+  expectEncodeGql "also__middle" "alsoXXRXXRmiddle"
+  expectEncodeGql "0test" "XXZ0test"
+  expectDecode "alsoXXZ0middle" "also0middle"
+
+  -- https://github.com/minimaxir/big-list-of-naughty-strings
+  txtFile <- readFile "./tests/blns.txt"
+
+  let
+    blns = T.lines $ T.pack txtFile
+    blnsFiltered = blns & filter
+      (\line -> not (T.null line) && not (T.isPrefixOf "#" line))
+
+    testEncodeDecode str =
+      if str /= doubleXDecode (doubleXEncode str)
+      then
+        "❌ \""
+        <> doubleXDecode (doubleXEncode str)
+        <> "\" /= \""
+        <> str
+        <> "\""
+      else "✅"
+
+    testEncodeGqlDecode str =
+      if str /= doubleXDecode (doubleXEncodeGql str)
+      then
+        "❌ \""
+        <> doubleXDecode (doubleXEncodeGql str)
+        <> "\" /= \""
+        <> str
+        <> "\""
+      else "✅"
+
+  T.putStrLn "\n\n============ ENCODE - DECODE ============"
+  blnsFiltered <&> testEncodeDecode <&> T.putStr & sequence_
+
+  T.putStrLn "\n\n========== ENCODE GQL - DECODE =========="
+  blnsFiltered <&> testEncodeGqlDecode <&> T.putStr & sequence_
+
+  pure ()