diff --git a/aeson.cabal b/aeson.cabal
--- a/aeson.cabal
+++ b/aeson.cabal
@@ -1,5 +1,5 @@
 name:               aeson
-version:            2.2.0.0
+version:            2.2.1.0
 license:            BSD3
 license-file:       LICENSE
 category:           Text, Web, JSON
@@ -18,8 +18,9 @@
    || ==8.10.7
    || ==9.0.2
    || ==9.2.8
-   || ==9.4.5
-   || ==9.6.2
+   || ==9.4.7
+   || ==9.6.3
+   || ==9.8.1
 
 synopsis:           Fast JSON parsing and encoding
 cabal-version:      1.12
@@ -59,12 +60,14 @@
     Data.Aeson.Decoding
     Data.Aeson.Decoding.ByteString
     Data.Aeson.Decoding.ByteString.Lazy
+    Data.Aeson.Decoding.Text
     Data.Aeson.Decoding.Tokens
     Data.Aeson.Encoding
     Data.Aeson.Encoding.Internal
     Data.Aeson.Key
     Data.Aeson.KeyMap
     Data.Aeson.QQ.Simple
+    Data.Aeson.RFC8785
     Data.Aeson.Text
     Data.Aeson.TH
     Data.Aeson.Types
@@ -80,7 +83,9 @@
     Data.Aeson.Internal.Text
     Data.Aeson.Internal.TH
     Data.Aeson.Internal.Unescape
+    Data.Aeson.Internal.UnescapeFromText
     Data.Aeson.Internal.Word8
+    Data.Aeson.Internal.Word16
     Data.Aeson.Parser.Time
     Data.Aeson.Types.Class
     Data.Aeson.Types.FromJSON
@@ -91,13 +96,13 @@
   -- GHC bundled libs
   build-depends:
       base              >=4.10.0.0 && <5
-    , bytestring        >=0.10.8.2 && <0.12
+    , bytestring        >=0.10.8.2 && <0.13
     , containers        >=0.5.10.2 && <0.7
-    , deepseq           >=1.4.3.0  && <1.5
+    , deepseq           >=1.4.3.0  && <1.6
     , exceptions        >=0.10.4   && <0.11
-    , ghc-prim          >=0.5.0.0  && <0.11
-    , template-haskell  >=2.12.0.0 && <2.21
-    , text              >=1.2.3.0  && <1.3  || >=2.0 && <2.1
+    , ghc-prim          >=0.5.0.0  && <0.12
+    , template-haskell  >=2.12.0.0 && <2.22
+    , text              >=1.2.3.0  && <1.3  || >=2.0 && <2.2
     , time              >=1.8.0.2  && <1.13
 
   -- Compat
@@ -108,6 +113,9 @@
   if !impl(ghc >=8.6)
     build-depends: contravariant >=1.4.1 && <1.6
 
+  if !impl(ghc >=9.0)
+    build-depends: integer-gmp
+
   -- Other dependencies
   build-depends:
       data-fix              >=0.3.2    && <0.4
@@ -115,6 +123,7 @@
     , hashable              >=1.4.2.0  && <1.5
     , indexed-traversable   >=0.1.2    && <0.2
     , integer-conversion    >=0.1      && <0.2
+    , integer-logarithms    >=1.0.3.1  && <1.1
     , network-uri           >=2.6.4.1  && <2.7
     , OneTuple              >=0.4.1.1  && <0.5
     , primitive             >=0.8.0.0  && <0.9
@@ -125,7 +134,7 @@
     , tagged                >=0.8.7    && <0.9
     , text-iso8601          >=0.1      && <0.2
     , text-short            >=0.1.5    && <0.2
-    , th-abstraction        >=0.5.0.0  && <0.6
+    , th-abstraction        >=0.5.0.0  && <0.7
     , these                 >=1.2      && <1.3
     , unordered-containers  >=0.2.10.0 && <0.3
     , uuid-types            >=1.0.5    && <1.1
@@ -146,10 +155,12 @@
   main-is:          Tests.hs
   ghc-options:      -Wall -threaded -rtsopts
   other-modules:
+    CastFloat
     DataFamilies.Encoders
     DataFamilies.Instances
     DataFamilies.Properties
     DataFamilies.Types
+    DoubleToScientific
     Encoders
     ErrorMessages
     Functions
@@ -168,6 +179,7 @@
     Regression.Issue571
     Regression.Issue687
     Regression.Issue967
+    RFC8785
     SerializationFormatSpec
     Types
     UnitTests
@@ -175,6 +187,7 @@
     UnitTests.Hashable
     UnitTests.KeyMapInsertWith
     UnitTests.MonadFix
+    UnitTests.NoThunks
     UnitTests.NullaryConstructors
     UnitTests.OmitNothingFieldsNote
     UnitTests.OptionalFields
@@ -183,18 +196,17 @@
     UnitTests.OptionalFields.Manual
     UnitTests.OptionalFields.TH
     UnitTests.UTCTime
-    UnitTests.NoThunks
 
   build-depends:
       aeson
     , base
     , base-compat
-    , deepseq
     , base-orphans          >=0.5.3  && <0.10
     , base16-bytestring
     , bytestring
     , containers
     , data-fix
+    , deepseq
     , Diff                  >=0.4    && <0.5
     , directory
     , dlist
@@ -226,6 +238,9 @@
     , unordered-containers
     , uuid-types
     , vector
+
+  if !impl(ghc >=9.0)
+    build-depends: integer-gmp
 
   if impl(ghc >=9.2 && <9.7)
     build-depends: nothunks >=0.1.4 && <0.2
diff --git a/changelog.md b/changelog.md
--- a/changelog.md
+++ b/changelog.md
@@ -1,5 +1,22 @@
 For the latest version of this document, please see [https://github.com/haskell/aeson/blob/master/changelog.md](https://github.com/haskell/aeson/blob/master/changelog.md).
 
+### 2.2.1.0
+
+* Add `Data.Aeson.RFC8785`, a JSON Canonicalization Scheme implementation
+  https://datatracker.ietf.org/doc/html/rfc8785
+* Add Data.Aeson.Decoding.Text, decodeStrictText :: Text -> ...
+
+  We avoid intermediate `ByteString` copy by not doing
+  `decode .  TE.encodeUtf8`, but instead working on `Text` value directly.
+  As we know that the stream is valid Unicode (UTF8 or UTF16),
+  we can also take some shortcuts.
+
+  One gotcha is that internal `Text` values (in `Key`s or `Value` `String`s)
+  will most likely retain the original input `Text` value (its underlying `Array`).
+  It shouldn't be an issue if the `Value` is then decoded to something else so these
+  `Text` values disapper, but if not (e.g. `Object` keys survive)
+  then users might want to use `Data.Text.copy`.
+
 ### 2.2.0.0
 
 * Rework how `omitNothingFields` works. Add `allowOmittedFields` as a parsing counterpart.
@@ -38,6 +55,7 @@
   - The space between time and timezone offset (in `UTCTime` and `ZonedTime`) is disallowed. ISO8601 explictly forbidds it.
   - The timezone offsets can be in range -23:59..23:59. This is how Python, joda-time etc seems to do. (Previously the range was -12..+14)
 
+* Remove internal `Data.Aeson.Internal` and `Data.Aeson.Internal.Time` modules. Everything from the former is exported elsewhere (`Data.Aeson.Types`), the latter was truly internal.
 * Remove `cffi` flag. Toggling the flag made `aeson` use a C implementation for string unescaping (used for `text <2` versions).
   The new native Haskell implementation (introduced in version 2.0.3.0) is at least as fast.
 * Drop instances for `Number` from `attoparsec` package.
diff --git a/src/Data/Aeson.hs b/src/Data/Aeson.hs
--- a/src/Data/Aeson.hs
+++ b/src/Data/Aeson.hs
@@ -55,10 +55,14 @@
     , eitherDecodeFileStrict
     , eitherDecodeStrict'
     , eitherDecodeFileStrict'
+    -- ** Variants for strict text
+    , decodeStrictText
+    , eitherDecodeStrictText
     -- ** Exception throwing variants
     , AesonException (..)
     , throwDecode
     , throwDecodeStrict
+    , throwDecodeStrictText
     , throwDecode'
     , throwDecodeStrict'
     -- * Core JSON types
@@ -171,6 +175,7 @@
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
 import Data.Aeson.Decoding (decode, eitherDecode, throwDecode, decodeStrict, eitherDecodeStrict, throwDecodeStrict)
+import Data.Aeson.Decoding (decodeStrictText, eitherDecodeStrictText, throwDecodeStrictText)
 
 -- $setup
 -- >>> :set -XOverloadedStrings
@@ -281,7 +286,7 @@
 --
 -- The most common way to use the library is to define a data type,
 -- corresponding to some JSON data you want to work with, and then
--- write either a 'FromJSON' instance, a to 'ToJSON' instance, or both
+-- write either a 'FromJSON' instance, a 'ToJSON' instance, or both
 -- for that type.
 --
 -- For example, given this JSON data:
diff --git a/src/Data/Aeson/Decoding.hs b/src/Data/Aeson/Decoding.hs
--- a/src/Data/Aeson/Decoding.hs
+++ b/src/Data/Aeson/Decoding.hs
@@ -9,6 +9,9 @@
     decodeStrict,
     eitherDecodeStrict,
     throwDecodeStrict,
+    decodeStrictText,
+    eitherDecodeStrictText,
+    throwDecodeStrictText,
     toEitherValue,
     unescapeText,
 ) where
@@ -17,11 +20,13 @@
 import           Data.Aeson.Types.Internal           (AesonException (..), formatError)
 
 import qualified Data.Aeson.Types                    as A
-import qualified Data.ByteString                     as B
-import qualified Data.ByteString.Lazy                as L
+import qualified Data.ByteString                     as BS
+import qualified Data.ByteString.Lazy                as LBS
+import qualified Data.Text                           as T
 
 import           Data.Aeson.Decoding.ByteString
 import           Data.Aeson.Decoding.ByteString.Lazy
+import           Data.Aeson.Decoding.Text
 import           Data.Aeson.Decoding.Conversion
 import           Data.Aeson.Internal.Unescape        (unescapeText)
 
@@ -32,7 +37,7 @@
 -- | Efficiently deserialize a JSON value from a strict 'B.ByteString'.
 -- If this fails due to incomplete or invalid input, 'Nothing' is
 -- returned.
-decodeStrict :: (A.FromJSON a) => B.ByteString -> Maybe a
+decodeStrict :: (A.FromJSON a) => BS.ByteString -> Maybe a
 decodeStrict bs = unResult (toResultValue (bsToTokens bs)) (\_ -> Nothing) $ \v bs' -> case A.ifromJSON v of
     A.ISuccess x
         | bsSpace bs' -> Just x
@@ -40,7 +45,7 @@
     A.IError _ _      -> Nothing
 
 -- | Like 'decodeStrict' but returns an error message when decoding fails.
-eitherDecodeStrict :: (A.FromJSON a) => B.ByteString -> Either String a
+eitherDecodeStrict :: (A.FromJSON a) => BS.ByteString -> Either String a
 eitherDecodeStrict bs = unResult (toResultValue (bsToTokens bs)) Left $ \v bs' -> case A.ifromJSON v of
     A.ISuccess x
         | bsSpace bs' -> Right x
@@ -48,7 +53,7 @@
     A.IError path msg -> Left $ formatError path msg
 
 -- | Like 'decodeStrict' but throws an 'AesonException' when decoding fails.
-throwDecodeStrict :: forall a m. (A.FromJSON a, MonadThrow m) => B.ByteString -> m a
+throwDecodeStrict :: forall a m. (A.FromJSON a, MonadThrow m) => BS.ByteString -> m a
 throwDecodeStrict bs = unResult (toResultValue (bsToTokens bs)) (throwM . AesonException) $ \v bs' -> case A.ifromJSON v of
     A.ISuccess x
         | bsSpace bs' -> pure x
@@ -59,18 +64,18 @@
 -- Decoding: lazy bytestring
 -------------------------------------------------------------------------------
 
--- | Efficiently deserialize a JSON value from a strict 'B.ByteString'.
+-- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'.
 -- If this fails due to incomplete or invalid input, 'Nothing' is
 -- returned.
-decode :: (A.FromJSON a) => L.ByteString -> Maybe a
+decode :: (A.FromJSON a) => LBS.ByteString -> Maybe a
 decode bs = unResult (toResultValue (lbsToTokens bs)) (\_ -> Nothing) $ \v bs' -> case A.ifromJSON v of
     A.ISuccess x
         | lbsSpace bs' -> Just x
         | otherwise    -> Nothing
     A.IError _ _       -> Nothing
 
--- | Like 'decodeStrict' but returns an error message when decoding fails.
-eitherDecode :: (A.FromJSON a) => L.ByteString -> Either String a
+-- | Like 'decode' but returns an error message when decoding fails.
+eitherDecode :: (A.FromJSON a) => LBS.ByteString -> Either String a
 eitherDecode bs = unResult (toResultValue (lbsToTokens bs)) Left $ \v bs' -> case A.ifromJSON v of
     A.ISuccess x
         | lbsSpace bs' -> Right x
@@ -80,9 +85,45 @@
 -- | Like 'decode' but throws an 'AesonException' when decoding fails.
 --
 -- 'throwDecode' is in @aeson@ since 2.1.2.0, but this variant is added later.
-throwDecode :: forall a m. (A.FromJSON a, MonadThrow m) => L.ByteString -> m a
+throwDecode :: forall a m. (A.FromJSON a, MonadThrow m) => LBS.ByteString -> m a
 throwDecode bs = unResult (toResultValue (lbsToTokens bs)) (throwM . AesonException) $ \v bs' -> case A.ifromJSON v of
     A.ISuccess x
         | lbsSpace bs'  -> pure x
         | otherwise    -> throwM $ AesonException "Trailing garbage"
     A.IError path msg  -> throwM $ AesonException $ formatError path msg
+
+-------------------------------------------------------------------------------
+-- Decoding: strict text
+-------------------------------------------------------------------------------
+
+-- | Efficiently deserialize a JSON value from a strict 'B.ByteString'.
+-- If this fails due to incomplete or invalid input, 'Nothing' is
+-- returned.
+--
+-- @since 2.2.1.0
+decodeStrictText :: (A.FromJSON a) => T.Text -> Maybe a
+decodeStrictText bs = unResult (toResultValue (textToTokens bs)) (\_ -> Nothing) $ \v bs' -> case A.ifromJSON v of
+    A.ISuccess x
+        | textSpace bs' -> Just x
+        | otherwise     -> Nothing
+    A.IError _ _        -> Nothing
+
+-- | Like 'decodeStrictText' but returns an error message when decoding fails.
+--
+-- @since 2.2.1.0
+eitherDecodeStrictText :: (A.FromJSON a) => T.Text -> Either String a
+eitherDecodeStrictText bs = unResult (toResultValue (textToTokens bs)) Left $ \v bs' -> case A.ifromJSON v of
+    A.ISuccess x
+        | textSpace bs' -> Right x
+        | otherwise     -> Left "Trailing garbage"
+    A.IError path msg   -> Left $ formatError path msg
+
+-- | Like 'decodeStrictText' but throws an 'AesonException' when decoding fails.
+--
+-- @since 2.2.1.0
+throwDecodeStrictText :: forall a m. (A.FromJSON a, MonadThrow m) => T.Text -> m a
+throwDecodeStrictText bs = unResult (toResultValue (textToTokens bs)) (throwM . AesonException) $ \v bs' -> case A.ifromJSON v of
+    A.ISuccess x
+        | textSpace bs' -> pure x
+        | otherwise     -> throwM $ AesonException "Trailing garbage"
+    A.IError path msg   -> throwM $ AesonException $ formatError path msg
diff --git a/src/Data/Aeson/Decoding/Conversion.hs b/src/Data/Aeson/Decoding/Conversion.hs
--- a/src/Data/Aeson/Decoding/Conversion.hs
+++ b/src/Data/Aeson/Decoding/Conversion.hs
@@ -3,6 +3,8 @@
 module Data.Aeson.Decoding.Conversion (
     bsSpace,
     lbsSpace,
+    textSpace,
+    ltextSpace,
     toEitherValue,
     toResultValue,
     Result (..),
@@ -16,6 +18,8 @@
 import qualified Data.ByteString            as B
 import qualified Data.ByteString.Lazy       as L
 import qualified Data.Vector                as V
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
 
 import           Data.Aeson.Decoding.Tokens
 
@@ -24,6 +28,12 @@
 
 lbsSpace :: L.ByteString -> Bool
 lbsSpace = L.all (\w -> w == 0x20 || w == 0x0a || w == 0x0d || w == 0x09)
+
+textSpace :: T.Text -> Bool
+textSpace = T.all (\c -> c == ' ' || c == '\r' || c == '\n' || c == '\t')
+
+ltextSpace :: LT.Text -> Bool
+ltextSpace = LT.all (\c -> c == ' ' || c == '\r' || c == '\n' || c == '\t')
 
 -- | Convert 'Tokens' to 'A.Value'.
 --
diff --git a/src/Data/Aeson/Decoding/Text.hs b/src/Data/Aeson/Decoding/Text.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Aeson/Decoding/Text.hs
@@ -0,0 +1,304 @@
+{-# LANGUAGE BangPatterns        #-}
+{-# LANGUAGE CPP                 #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ViewPatterns        #-}
+{-# OPTIONS_GHC -O2 #-}
+-- | Parser from strict 'Text' to 'Tokens'.
+module Data.Aeson.Decoding.Text (
+    textToTokens,
+) where
+
+import           Data.Char                            (chr)
+import           Data.Integer.Conversion              (textToInteger)
+import           Data.Text.Internal                   (Text (..))
+
+import qualified Data.Aeson.Key                       as Key
+import qualified Data.Scientific                      as Sci
+import qualified Data.Text                            as T
+import qualified Data.Text.Array                      as A
+
+import           Data.Aeson.Decoding.Internal
+import           Data.Aeson.Decoding.Tokens
+import           Data.Aeson.Internal.Prelude
+import           Data.Aeson.Internal.UnescapeFromText (unescapeFromText)
+
+#if MIN_VERSION_text(2,0,0)
+import           Data.Aeson.Internal.Word8
+#else
+import           Data.Aeson.Internal.Word16
+#endif
+
+#if MIN_VERSION_text(2,0,0)
+type Point = Word8
+#else
+type Point = Word16
+#endif
+
+
+-- | Lex (and parse) strict 'ByteString' into 'Tokens' stream.
+--
+-- @since 2.2.1.0
+--
+textToTokens :: Text -> Tokens Text String
+textToTokens bs0 = goT bs0 id where
+    goT :: Parser Tokens k
+    goT (skipSpace -> bs) k = case unconsPoint bs of
+        Nothing         -> tkErr "Unexpected end-of-input, expecting JSON value"
+        Just (!w, !bs1) -> tokenCase w bs1 bs k
+
+    tokenCase
+        :: Point              -- head
+        -> Text               -- tail
+        -> Text               -- whole input, needed for number parsing
+        -> (Text -> k)        -- continuation
+        -> Tokens k String
+    tokenCase W8_OPEN_CURLY   !bs !_   k      = TkRecordOpen (goR bs k)
+    tokenCase W8_OPEN_SQUARE   bs  _   k      = TkArrayOpen (goA bs k)
+    tokenCase W8_DOUBLE_QUOTE  bs  _   k      = scanStringLiteral (\t bs' -> TkText t (k bs')) tkErr bs
+    tokenCase W8_MINUS         bs  _   k      = scanNumberLiteral (\n bs' -> TkNumber (negateNumber n) (k bs')) tkErr bs
+    tokenCase w                _   wbs k
+        | W8_0 <= w, w <= W8_9                = scanNumberLiteral (\n bs' -> TkNumber n (k bs')) tkErr wbs
+    tokenCase W8_n             bs  _   k
+        | Just bs1 <- stripPrefix "ull" 3 bs  = TkLit LitNull (k bs1)
+    tokenCase W8_t             bs  _   k
+        | Just bs1 <- stripPrefix "rue" 3 bs  = TkLit LitTrue (k bs1)
+    tokenCase W8_f             bs  _   k
+        | Just bs1 <- stripPrefix "alse" 4 bs = TkLit LitFalse (k bs1)
+    tokenCase _                _   wbs _      = tkErr $ "Unexpected " ++ showBeginning wbs ++ ", expecting JSON value"
+
+    -- Array
+    goA :: Parser TkArray k
+    goA (skipSpace -> bs) k = case unconsPoint bs of
+        Nothing         -> tkErrEOF "JSON value or ]"
+        Just (W8_CLOSE_SQUARE, !bs1) -> TkArrayEnd (k bs1)
+        Just (w,  !bs1) -> TkItem $ tokenCase w bs1 bs $ \bs2 -> goA1 bs2 k
+
+    goA1 :: Parser TkArray k
+    goA1 (skipSpace -> bs) k = case unconsPoint bs of
+        Nothing                      -> tkErrEOF ", or ]"
+        Just (W8_CLOSE_SQUARE, !bs1) -> TkArrayEnd (k bs1)
+        Just (W8_COMMA, !bs1)        -> TkItem $ goT bs1 $ \bs2 -> goA1 bs2 k
+        _                            -> tkErrBS bs ", or ]"
+
+    -- Record
+    goR :: Parser TkRecord k
+    goR (skipSpace -> bs) k = case unconsPoint bs of
+        Nothing                       -> tkErrEOF "record key literal or }"
+        Just (W8_DOUBLE_QUOTE,  !bs1) -> goRK bs1 k           -- "
+        Just (W8_CLOSE_CURLY, !bs1)   -> TkRecordEnd (k bs1)  -- }
+        Just _                        -> tkErrBS bs "record key literal or }"
+
+    -- after record pair, expecting ," or }
+    goR1 :: Parser TkRecord k
+    goR1 (skipSpace -> bs) k = case unconsPoint bs of
+        Nothing                           -> tkErr "Unexpected end-of-input, expecting , or }"
+        Just (W8_COMMA, !bs1) -> case unconsPoint (skipSpace bs1) of
+            Nothing                      -> tkErrEOF "key literal"
+            Just (W8_DOUBLE_QUOTE, !bs2) -> goRK bs2 k
+            Just _                       -> tkErrBS bs "key literal"
+        Just (W8_CLOSE_CURLY, !bs1)       -> TkRecordEnd (k bs1)
+        _                                 -> tkErr $ "Unexpected " ++ showBeginning bs ++ ", expecting , or }"
+
+    -- key of record (after double quote)
+    goRK :: Parser TkRecord k
+    goRK bs1 k = scanStringLiteral (\t bs -> goRK' t bs k) tkErr bs1
+
+    -- after key of a record, expecting :
+    goRK' :: Text -> Parser TkRecord k
+    goRK' t (skipSpace -> bs) k = case T.uncons bs of
+        Nothing          -> tkErrEOF ":"
+        Just (':', !bs3) -> TkPair (Key.fromText t) $ goT bs3 $ \bs4 -> goR1 bs4 k
+        Just _           -> tkErrBS bs ":"
+
+stripPrefix :: Text -> Int -> Text -> Maybe Text
+stripPrefix pfx _ bs = T.stripPrefix pfx bs
+{-# INLINE stripPrefix #-}
+
+type Parser tk k = Text -> (Text -> k) -> tk k String
+
+showBeginning :: Text -> String
+showBeginning = show . T.take 30
+
+-- | Strip leading (ASCII) space
+skipSpace :: Text -> Text
+skipSpace = T.dropWhile $ \w -> w == '\x20' || w == '\x0a' || w == '\x0d' || w == '\x09'
+{-# INLINE skipSpace #-}
+
+tkErrEOF :: AsError t => String ->  t k String
+tkErrEOF expected = tkErr $
+    "Unexpected end-of-input, expecting " ++ expected
+{-# INLINE tkErrEOF #-}
+
+tkErrBS :: AsError t => Text -> String ->  t k String
+tkErrBS bs expected = tkErr $
+    "Unexpected " ++ showBeginning bs ++ ", expecting " ++ expected
+{-# INLINE tkErrBS #-}
+
+-------------------------------------------------------------------------------
+-- Text
+-------------------------------------------------------------------------------
+
+scanStringLiteral
+    :: forall r. (Text -> Text -> r)
+    -> (String -> r)
+    -> Text
+    -> r
+scanStringLiteral ok err bs0 = go 0 bs0 where
+    -- the length is counted in bytes.
+    go :: Int -> Text -> r
+    go !n !bs = case unconsPoint bs of
+        Nothing          -> errEnd
+        Just (34, _)     -> ok (unsafeTakePoints n bs0) (unsafeDropPoints (n + 1) bs0)
+        Just (92, bs')   -> goSlash (n + 1) bs'
+        Just (w8, bs')
+            | w8 < 0x20  -> errCC
+            -- we don't need to check for @>= 0x80@ chars, as text is valid unicode.
+            | otherwise  -> go (n + 1) bs'
+
+    -- in goEsc and goSlash we don't need to check for control characters as unescapeText verifies that.
+    goEsc :: Int -> Text -> r
+    goEsc !n !bs = case unconsPoint bs of
+        Nothing        -> errEnd
+        Just (34, _)   -> case unescapeFromText (unsafeTakePoints n bs0) of
+            Right t -> ok t (unsafeDropPoints (n + 1) bs0)
+            Left e  -> err (show e)
+        Just (92, bs') -> goSlash (n + 1) bs'
+        Just (_,  bs') -> goEsc (n + 1) bs'
+
+    goSlash :: Int -> Text -> r
+    goSlash !n !bs = case unconsPoint bs of
+        Nothing       -> errEnd
+        Just (_, bs') -> goEsc (n + 1) bs'
+
+    errEnd = err "Unexpected end-of-input while parsing string literal"
+    errCC  = err "Unespected control character while parsing string literal"
+
+-------------------------------------------------------------------------------
+-- Number
+-------------------------------------------------------------------------------
+
+--
+-- number   := integer fraction exponent
+-- integer  := 0 | [1-9][0-9]* | -0 | -[1-9][0-9]*
+-- fraction := "" | . [0-9]+
+-- exponent := "" | E sign [0-9]+ | e sign [0-9]+
+-- sign     := "" | - | +
+--
+-- This scanner doesn't recognize the leading minus sign, we recognize only integer := 0 | [1-9][0-9]*,
+-- as the minus sign is recognized by outer scanner already.
+--
+scanNumberLiteral
+    :: forall r. (Number -> Text -> r)
+    -> (String -> r)
+    -> Text
+    -> r
+scanNumberLiteral kont err bs0 = state_start bs0 where
+    state_start :: Text -> r
+    state_start !bs = case unconsPoint bs of
+        Nothing                      -> errEnd
+        Just (w8, bs')
+            | W8_0 < w8, w8 <= W8_9  -> state_i1 1 bs'
+            | W8_0 == w8             -> state_after0 bs'
+            | otherwise              -> errUnx w8
+
+    state_after0 :: Text -> r
+    state_after0 !bs = case unconsPoint bs of
+        Nothing                         -> kont (NumInteger 0) bs
+        Just (w8, bs')
+            | W8_0 <= w8, w8 <= W8_9    -> err "Number literal with leading zero"
+            | W8_DOT == w8              -> go_dec 0 bs'
+            | W8_e == w8 || W8_E == w8  -> go_sci 0 0 bs'
+            | otherwise                 -> kont (NumInteger 0) bs
+
+    state_i1 :: Int -> Text -> r
+    state_i1 !n !bs = case unconsPoint bs of
+        Nothing                         -> kont (NumInteger int) bs
+        Just (w8, bs')
+            | W8_0 <= w8, w8 <= W8_9    -> state_i1 (n + 1) bs'
+            | W8_DOT == w8              -> go_dec int bs'
+            | W8_e == w8 || W8_E == w8  -> go_sci int 0 bs'
+            | otherwise                 -> kont (NumInteger int) bs
+      where
+        int = textToInteger (unsafeTakePoints n bs0)
+
+    go_dec :: Integer -> Text -> r
+    go_dec !int !bs1 = case unconsPoint bs1 of
+        Nothing                       -> errEnd
+        Just (w8, bs')
+            | W8_0 <= w8, w8 <= W8_9  -> state_dec 1 bs'
+            | otherwise               -> errUnx w8
+      where
+        state_dec :: Int -> Text -> r
+        state_dec !n !bs = case unconsPoint bs of
+            Nothing                         -> kont (NumDecimal dec) bs
+            Just (w8, bs')
+                | W8_0 <= w8, w8 <= W8_9    -> state_dec (n + 1) bs'
+                | W8_e == w8 || W8_E == w8  -> go_sci coef (negate n) bs'
+                | otherwise                 -> kont (NumDecimal dec) bs
+          where
+            frac = textToInteger (unsafeTakePoints n bs1)
+            coef = int * 10 ^ n + frac
+            dec  = Sci.scientific coef (negate n)
+
+    go_sci :: Integer -> Int -> Text -> r
+    go_sci !coef !exp10 !bs2 = case unconsPoint bs2 of
+        Nothing                       -> errEnd
+        Just (w8, bs')
+            | W8_0 <= w8, w8 <= W8_9  -> go_sci_pos coef exp10 bs2 1 bs'
+            | W8_PLUS == w8           -> case unconsPoint bs' of
+                Nothing               -> errEnd
+                Just (w8', bs'')
+                    | W8_0 <= w8', w8' <= W8_9  -> go_sci_pos coef exp10 bs' 1 bs''
+                    | otherwise       ->  errUnx w8'
+            | W8_MINUS == w8          -> case unconsPoint bs' of
+                Nothing               -> errEnd
+                Just (w8', bs'')
+                    | W8_0 <= w8', w8' <= W8_9  -> go_sci_neg coef exp10 bs' 1 bs''
+                    | otherwise       ->  errUnx w8'
+            | otherwise               -> errUnx w8
+
+    go_sci_pos :: Integer -> Int -> Text -> Int -> Text -> r
+    go_sci_pos !coef !exp10 !bs2 !n !bs = case unconsPoint bs of
+        Nothing                       -> kont (NumScientific sci) bs
+        Just (w8, bs')
+            | W8_0 <= w8, w8 <= W8_9  -> go_sci_pos coef exp10 bs2 (n + 1) bs'
+            | otherwise               -> kont (NumScientific sci) bs
+      where
+        exp10' = fromInteger (textToInteger (unsafeTakePoints n bs2))
+        sci = Sci.scientific coef (exp10 + exp10')
+
+    go_sci_neg :: Integer -> Int -> Text -> Int -> Text -> r
+    go_sci_neg !coef !exp10 !bs2 !n !bs = case unconsPoint bs of
+        Nothing                       -> kont (NumScientific sci) bs
+        Just (w8, bs')
+            | W8_0 <= w8, w8 <= W8_9  -> go_sci_neg coef exp10 bs2 (n + 1) bs'
+            | otherwise               -> kont (NumScientific sci) bs
+      where
+        exp10' = fromInteger (textToInteger (unsafeTakePoints n bs2))
+        sci = Sci.scientific coef (exp10 - exp10')
+
+    errEnd    = err "Unexpected end-of-input while parsing number literal"
+    errUnx w8 = err $ "Unexpected " ++ show (chr (fromIntegral w8)) ++ " while parsing number literal"
+
+-------------------------------------------------------------------------------
+-- Unsafe primitives
+-------------------------------------------------------------------------------
+
+{-# INLINE unconsPoint #-}
+-- Uncons a primitive unit of storage from text.
+-- The left-over 'Text' value may be invalid.
+unconsPoint :: Text -> Maybe (Point, Text)
+unconsPoint (Text arr off len)
+    | len <= 0  = Nothing
+    | otherwise = Just (w8, Text arr (off + 1) (len - 1))
+  where
+    w8 = A.unsafeIndex arr off
+
+unsafeTakePoints :: Int -> Text -> Text
+unsafeTakePoints n (Text arr off _len) = Text arr off n
+{-# INLINE unsafeTakePoints #-}
+
+unsafeDropPoints :: Int -> Text -> Text
+unsafeDropPoints n (Text arr off len) = Text arr (off + n) (len - n)
+{-# INLINE unsafeDropPoints #-}
diff --git a/src/Data/Aeson/Internal/Text.hs b/src/Data/Aeson/Internal/Text.hs
--- a/src/Data/Aeson/Internal/Text.hs
+++ b/src/Data/Aeson/Internal/Text.hs
@@ -8,7 +8,7 @@
 import qualified Data.Text                      as T
 
 #if MIN_VERSION_text(2,0,0)
-import           Data.Text.Array                (Array (..))
+import qualified Data.Text.Array                as A
 import qualified Data.Text.Internal             as T (Text (..))
 
 import qualified Data.ByteString.Short.Internal as SBS
@@ -27,7 +27,7 @@
 
 #if MIN_VERSION_text(2,0,0)
 unsafeDecodeASCII bs = withBS bs $ \_fp len -> if len == 0 then T.empty else
-  let !(SBS.SBS arr) = SBS.toShort bs in T.Text (ByteArray arr) 0 len
+  let !(SBS.SBS arr) = SBS.toShort bs in T.Text (A.ByteArray arr) 0 len
 
 #else
 unsafeDecodeASCII = TE.decodeLatin1
diff --git a/src/Data/Aeson/Internal/UnescapeFromText.hs b/src/Data/Aeson/Internal/UnescapeFromText.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Aeson/Internal/UnescapeFromText.hs
@@ -0,0 +1,532 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP          #-}
+{-# LANGUAGE MultiWayIf   #-}
+
+module Data.Aeson.Internal.UnescapeFromText
+  ( unescapeFromText
+  ) where
+
+import           Control.Exception           (throwIO, try)
+import           Data.Bits                   (shiftL, shiftR, (.&.), (.|.))
+import           Data.Text.Encoding.Error    (UnicodeException (..))
+import           Data.Text.Internal          (Text (..))
+import           Data.Text.Unsafe            (unsafeDupablePerformIO)
+
+import           Data.Aeson.Internal.Prelude
+
+import qualified Data.Primitive              as P
+import qualified Data.Text.Array             as A
+import qualified Data.Text.Internal          as T
+
+#if !MIN_VERSION_text(2,0,0)
+import           Data.Word                   (Word16)
+#endif
+
+-- | Unescape JSON text literal.
+--
+-- This function is exporeted mostly for testing and benchmarking purposes.
+unescapeFromText :: Text -> Either UnicodeException Text
+unescapeFromText = unsafeDupablePerformIO . try . unescapeFromTextIO
+
+throwDecodeError :: IO a
+throwDecodeError =
+  let desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"
+   in throwIO (DecodeError desc Nothing)
+
+-------------------------------------------------------------------------------
+-- unescapeTextIO
+-------------------------------------------------------------------------------
+
+type Offset = Int
+
+unescapeFromTextIO :: Text -> IO Text
+
+#if MIN_VERSION_text(2,0,0)
+
+unescapeFromTextIO (Text src begin len) = do
+    let end :: Offset
+        end = begin + len
+
+    arr <- P.newPrimArray len
+
+    let write3bytes :: Int -> Word8 -> Word8 -> Word8 -> Offset -> IO Text
+        write3bytes !out !b1 !b2 !b3 !inp = do
+          P.writePrimArray arr out b1
+          write2bytes (out + 1) b2 b3 inp
+
+        write2bytes :: Int -> Word8 -> Word8 -> Offset -> IO Text
+        write2bytes !out !b1 !b2 !inp = do
+          P.writePrimArray arr out b1
+          write1byte (out + 1) b2 inp
+
+        write1byte :: Int -> Word8 -> Offset -> IO Text
+        write1byte !out !b1 !inp = do
+          P.writePrimArray arr out b1
+          state_start (out + 1) inp
+
+        writeCodePoint :: Int -> Offset -> Word32 -> IO Text
+        writeCodePoint !out !inp !acc
+          | acc <= 127 = do
+            P.writePrimArray arr out (fromIntegral acc :: Word8)
+            state_start (out + 1) (inp + 1)
+
+          | acc <= 2047 = do
+            let b1 = fromIntegral (shiftR acc 6 .|. 192) :: Word8
+            let b2 = fromIntegral ((acc .&. 63) .|. 128) :: Word8
+            P.writePrimArray arr out b1
+            write1byte (out + 1) b2 (inp + 1)
+
+          | acc <= 65535 = do
+            let b1 = fromIntegral (shiftR acc 12 .|. 224) :: Word8
+            let b2 = fromIntegral ((shiftR acc 6 .&. 63) .|.  128) :: Word8
+            let b3 = fromIntegral ((acc .&. 63) .|. 128) :: Word8
+            P.writePrimArray arr out b1
+            write2bytes (out + 1) b2 b3 (inp + 1)
+
+          | otherwise = do
+            let b1 = fromIntegral (shiftR acc 18 .|. 240) :: Word8
+            let b2 = fromIntegral ((shiftR acc 12 .&. 63) .|. 128) :: Word8
+            let b3 = fromIntegral ((shiftR acc 6 .&. 63) .|. 128) :: Word8
+            let b4 = fromIntegral ((acc .&. 63) .|. 128) :: Word8
+            P.writePrimArray arr out b1
+            write3bytes (out + 1) b2 b3 b4 (inp + 1)
+
+        state_sudone :: Int -> Offset -> Word32 -> Word32 -> IO Text
+        state_sudone !out !inp !hi !lo
+          | 56320 <= lo, lo <= 57343
+          = writeCodePoint out inp (65536 + (shiftL (hi - 55296) 10 .|.  (lo - 56320)))
+
+          | otherwise
+          = throwDecodeError
+
+        state_su4 :: Int -> Offset -> Word32 -> Word32 -> IO Text
+        state_su4 !out !inp !hi !acc
+          | inp == end = throwDecodeError
+          | otherwise = do
+            let !w8 = A.unsafeIndex src inp
+            if | 48 <= w8, w8 <= 57 ->
+                 state_sudone out inp hi (shiftL acc 4 .|. fromIntegral (w8 - 48))
+               | 65 <= w8, w8 <= 70 ->
+                 state_sudone out inp hi (shiftL acc 4 .|. fromIntegral (w8 - 55))
+               | 97 <= w8, w8 <= 102 ->
+                 state_sudone out inp hi (shiftL acc 4 .|. fromIntegral (w8 - 87))
+               | otherwise ->
+                 throwDecodeError
+
+        state_su3 :: Int -> Offset -> Word32 -> Word32 -> IO Text
+        state_su3 !out !inp !hi !acc
+          | inp == end = throwDecodeError
+          | otherwise = do
+            let !w8 = A.unsafeIndex src inp
+            if | 48 <= w8, w8 <= 57 ->
+                 state_su4 out (inp + 1) hi (shiftL acc 4 .|. fromIntegral (w8 - 48))
+               | 65 <= w8, w8 <= 70 ->
+                 state_su4 out (inp + 1) hi (shiftL acc 4 .|. fromIntegral (w8 - 55))
+               | 97 <= w8, w8 <= 102 ->
+                 state_su4 out (inp + 1) hi (shiftL acc 4 .|. fromIntegral (w8 - 87))
+               | otherwise ->
+                 throwDecodeError
+
+        state_su2 :: Int -> Offset -> Word32 -> Word32 -> IO Text
+        state_su2 !out !inp !hi !acc
+          | inp == end = throwDecodeError
+          | otherwise = do
+            let !w8 = A.unsafeIndex src inp
+            if | 48 <= w8, w8 <= 57 ->
+                 state_su3 out (inp + 1) hi (shiftL acc 4 .|. fromIntegral (w8 - 48))
+               | 65 <= w8, w8 <= 70 ->
+                 state_su3 out (inp + 1) hi (shiftL acc 4 .|. fromIntegral (w8 - 55))
+               | 97 <= w8, w8 <= 102 ->
+                 state_su3 out (inp + 1) hi (shiftL acc 4 .|. fromIntegral (w8 - 87))
+               | otherwise ->
+                 throwDecodeError
+
+        state_su1 :: Int -> Offset -> Word32 -> IO Text
+        state_su1 !out !inp !hi
+          | inp == end = throwDecodeError
+          | otherwise = do
+            let !w8 = A.unsafeIndex src inp
+            if | 48 <= w8, w8 <= 57 ->
+                 state_su2 out (inp + 1) hi (fromIntegral (w8 - 48))
+               | 65 <= w8, w8 <= 70 ->
+                 state_su2 out (inp + 1) hi (fromIntegral (w8 - 55))
+               | 97 <= w8, w8 <= 102 ->
+                 state_su2 out (inp + 1) hi (fromIntegral (w8 - 87))
+               | otherwise ->
+                 throwDecodeError
+
+        state_su :: Int -> Offset -> Word32 -> IO Text
+        state_su !out !inp !hi
+          | inp == end = throwDecodeError
+          | otherwise = do
+            let !w8 = A.unsafeIndex src inp
+            case w8 of
+              117 -> state_su1 out (inp + 1) hi
+              _   -> throwDecodeError
+
+        state_ss :: Int -> Offset -> Word32 -> IO Text
+        state_ss !out !inp !hi
+          | inp == end = throwDecodeError
+          | otherwise = do
+            let !w8 = A.unsafeIndex src inp
+            case w8 of
+              92 -> state_su out (inp + 1) hi
+              _  -> throwDecodeError
+
+        state_udone :: Int -> Offset -> Word32 -> IO Text
+        state_udone !out !inp !acc
+          | acc < 55296 || acc > 57343 =
+            writeCodePoint out inp acc
+
+          | acc < 56320 =
+            state_ss out (inp + 1) acc
+
+          | otherwise =
+            throwDecodeError
+
+        state_u4 :: Int -> Offset -> Word32 -> IO Text
+        state_u4 !out !inp !acc
+          | inp == end = throwDecodeError
+          | otherwise = do
+            let !w8 = A.unsafeIndex src inp
+            if | 48 <= w8, w8 <= 57 ->
+                 state_udone out inp (shiftL acc 4 .|. fromIntegral (w8 - 48))
+               | 65 <= w8, w8 <= 70 ->
+                 state_udone out inp (shiftL acc 4 .|. fromIntegral (w8 - 55))
+               | 97 <= w8, w8 <= 102 ->
+                 state_udone out inp (shiftL acc 4 .|. fromIntegral (w8 - 87))
+               | otherwise ->
+                 throwDecodeError
+
+        state_u3 :: Int -> Offset -> Word32 -> IO Text
+        state_u3 !out !inp !acc
+          | inp == end = throwDecodeError
+          | otherwise = do
+            let !w8 = A.unsafeIndex src inp
+            if | 48 <= w8, w8 <= 57 ->
+                 state_u4 out (inp + 1) (shiftL acc 4 .|. fromIntegral (w8 - 48))
+               | 65 <= w8, w8 <= 70 ->
+                 state_u4 out (inp + 1) (shiftL acc 4 .|. fromIntegral (w8 - 55))
+               | 97 <= w8, w8 <= 102 ->
+                 state_u4 out (inp + 1) (shiftL acc 4 .|. fromIntegral (w8 - 87))
+               | otherwise ->
+                 throwDecodeError
+
+        state_u2 :: Int -> Offset -> Word32 -> IO Text
+        state_u2 !out !inp !acc
+          | inp == end = throwDecodeError
+          | otherwise = do
+            let !w8 = A.unsafeIndex src inp
+            if | 48 <= w8, w8 <= 57 ->
+                 state_u3 out (inp + 1) (shiftL acc 4 .|. fromIntegral (w8 - 48))
+               | 65 <= w8, w8 <= 70 ->
+                 state_u3 out (inp + 1) (shiftL acc 4 .|. fromIntegral (w8 - 55))
+               | 97 <= w8, w8 <= 102 ->
+                 state_u3 out (inp + 1) (shiftL acc 4 .|. fromIntegral (w8 - 87))
+               | otherwise ->
+                 throwDecodeError
+
+        state_u1 :: Int -> Offset -> IO Text
+        state_u1 !out !inp
+          | inp == end = throwDecodeError
+          | otherwise = do
+            let !w8 = A.unsafeIndex src inp
+            if | 48 <= w8, w8 <= 57 ->
+                 state_u2 out (inp + 1) (fromIntegral (w8 - 48))
+               | 65 <= w8, w8 <= 70 ->
+                 state_u2 out (inp + 1) (fromIntegral (w8 - 55))
+               | 97 <= w8, w8 <= 102 ->
+                 state_u2 out (inp + 1) (fromIntegral (w8 - 87))
+               | otherwise ->
+                 throwDecodeError
+
+        state_escape :: Int -> Offset -> IO Text
+        state_escape !out !inp
+          | inp == end = throwDecodeError
+          | otherwise  = do
+            let !w8 = A.unsafeIndex src inp
+            case w8 of
+              34 -> do
+                P.writePrimArray arr out 34
+                state_start (out + 1) (inp + 1)
+
+              92 -> do
+                P.writePrimArray arr out 92
+                state_start (out + 1) (inp + 1)
+
+              47 -> do
+                P.writePrimArray arr out 47
+                state_start (out + 1) (inp + 1)
+
+              98 -> do
+                P.writePrimArray arr out 8
+                state_start (out + 1) (inp + 1)
+
+              102 -> do
+                P.writePrimArray arr out 12
+                state_start (out + 1) (inp + 1)
+
+              110 -> do
+                P.writePrimArray arr out 10
+                state_start (out + 1) (inp + 1)
+
+              114 -> do
+                P.writePrimArray arr out 13
+                state_start (out + 1) (inp + 1)
+
+              116 -> do
+                P.writePrimArray arr out 9
+                state_start (out + 1) (inp + 1)
+
+              117 ->
+                state_u1 out (inp + 1)
+
+              _ -> throwDecodeError
+
+        state_start :: Int -> Offset -> IO Text
+        state_start !out !inp
+          | inp == end = do
+            P.shrinkMutablePrimArray arr out
+            frozenArr <- P.unsafeFreezePrimArray arr
+            return $ case frozenArr of
+              P.PrimArray ba -> T.Text (A.ByteArray ba) 0 out
+
+          | otherwise = do
+            let !w8 = A.unsafeIndex src inp
+            if | w8 == 92  -> state_escape out (inp + 1)
+            -- because we are deserialising __valid__ text,
+            -- we can simply copy everything else.
+               | otherwise -> do
+                 P.writePrimArray arr out w8
+                 state_start (out + 1) (inp + 1)
+
+    -- start the state machine
+    state_start (0 :: Int) begin
+#else
+
+unescapeFromTextIO (Text src begin len) = do
+    let end :: Offset
+        end = begin + len
+
+    arr <- P.newPrimArray len
+
+    let state_sudone :: Int -> Offset -> Word32 -> IO Text
+        state_sudone !out !inp !lo
+          | 56320 <= lo, lo <= 57343 = do
+            P.writePrimArray arr out (fromIntegral lo)
+            state_start (out + 1) (inp + 1)
+
+          | otherwise =
+            throwDecodeError
+
+        state_su4 :: Int -> Offset -> Word32 -> IO Text
+        state_su4 !out !inp !acc
+          | inp == end = throwDecodeError
+          | otherwise = do
+            let !w8 = A.unsafeIndex src inp
+            if | 48 <= w8, w8 <= 57 ->
+                 state_sudone out inp (shiftL acc 4 .|. fromIntegral (w8 - 48))
+               | 65 <= w8, w8 <= 70 ->
+                 state_sudone out inp (shiftL acc 4 .|. fromIntegral (w8 - 55))
+               | 97 <= w8, w8 <= 102 ->
+                 state_sudone out inp (shiftL acc 4 .|. fromIntegral (w8 - 87))
+               | otherwise ->
+                 throwDecodeError
+
+        state_su3 :: Int -> Offset -> Word32 -> IO Text
+        state_su3 !out !inp  !acc
+          | inp == end = throwDecodeError
+          | otherwise = do
+            let !w8 = A.unsafeIndex src inp
+            if | 48 <= w8, w8 <= 57 ->
+                 state_su4 out (inp + 1) (shiftL acc 4 .|. fromIntegral (w8 - 48))
+               | 65 <= w8, w8 <= 70 ->
+                 state_su4 out (inp + 1) (shiftL acc 4 .|. fromIntegral (w8 - 55))
+               | 97 <= w8, w8 <= 102 ->
+                 state_su4 out (inp + 1) (shiftL acc 4 .|. fromIntegral (w8 - 87))
+               | otherwise -> throwDecodeError
+
+        state_su2 :: Int -> Offset -> Word32 -> IO Text
+        state_su2 !out !inp !acc
+          | inp == end = throwDecodeError
+          | otherwise = do
+            let !w8 = A.unsafeIndex src inp
+            if | 48 <= w8, w8 <= 57 ->
+                 state_su3 out (inp + 1) (shiftL acc 4 .|. fromIntegral (w8 - 48))
+               | 65 <= w8, w8 <= 70 ->
+                 state_su3 out (inp + 1) (shiftL acc 4 .|. fromIntegral (w8 - 55))
+               | 97 <= w8, w8 <= 102 ->
+                 state_su3 out (inp + 1) (shiftL acc 4 .|. fromIntegral (w8 - 87))
+               | otherwise ->
+                 throwDecodeError
+
+        state_su1 :: Int -> Offset -> IO Text
+        state_su1 !out !inp
+          | inp == end = throwDecodeError
+          | otherwise = do
+            let !w8 = A.unsafeIndex src inp
+            if | 48 <= w8, w8 <= 57 ->
+                 state_su2 out (inp + 1) (fromIntegral (w8 - 48))
+               | 65 <= w8, w8 <= 70 ->
+                 state_su2 out (inp + 1) (fromIntegral (w8 - 55))
+               | 97 <= w8, w8 <= 102 ->
+                 state_su2 out (inp + 1) (fromIntegral (w8 - 87))
+               | otherwise ->
+                 throwDecodeError
+
+        -- high surrogate u
+        state_su :: Int -> Offset -> IO Text
+        state_su !out !inp
+          | inp == end = throwDecodeError
+          | otherwise = do
+            let !w8 = A.unsafeIndex src inp
+            case w8 of
+              117 -> state_su1 out (inp + 1)
+              _   -> throwDecodeError
+
+        -- high surrogate slash
+        state_ss :: Int -> Offset -> IO Text
+        state_ss !out !inp
+          | inp == end = throwDecodeError
+          | otherwise = do
+            let !w8 = A.unsafeIndex src inp
+            case w8 of
+              92 -> state_su out (inp + 1)
+              _  -> throwDecodeError
+
+        state_udone :: Int -> Offset -> Word32 -> IO Text
+        state_udone !out !inp !acc
+          -- we know that codepoint in acc is in BMP
+          | acc < 55296 || acc > 57343 = do
+            P.writePrimArray arr out (fromIntegral acc)
+            state_start (out + 1) (inp + 1)
+
+          -- hi surrogate,
+          -- we write it immediately (UTF16 as an output!)
+          | acc < 56320 = do
+            P.writePrimArray arr out (fromIntegral acc)
+            state_ss (out + 1) (inp + 1)
+
+          | otherwise =
+            throwDecodeError
+
+        state_u4 :: Int -> Offset -> Word32 -> IO Text
+        state_u4 !out !inp !acc
+          | inp == end = throwDecodeError
+          | otherwise = do
+            let !w8 = A.unsafeIndex src inp
+            if | 48 <= w8, w8 <= 57 ->
+                 state_udone out inp (shiftL acc 4 .|. fromIntegral (w8 - 48))
+               | 65 <= w8, w8 <= 70 ->
+                 state_udone out inp (shiftL acc 4 .|. fromIntegral (w8 - 55))
+               | 97 <= w8, w8 <= 102 ->
+                 state_udone out inp (shiftL acc 4 .|. fromIntegral (w8 - 87))
+               | otherwise ->
+                 throwDecodeError
+
+        state_u3 :: Int -> Offset -> Word32 -> IO Text
+        state_u3 !out !inp !acc
+          | inp == end = throwDecodeError
+          | otherwise = do
+            let !w8 = A.unsafeIndex src inp
+            if | 48 <= w8, w8 <= 57 ->
+                 state_u4 out (inp + 1) (shiftL acc 4 .|. fromIntegral (w8 - 48))
+               | 65 <= w8, w8 <= 70 ->
+                 state_u4 out (inp + 1) (shiftL acc 4 .|. fromIntegral (w8 - 55))
+               | 97 <= w8, w8 <= 102 ->
+                 state_u4 out (inp + 1) (shiftL acc 4 .|. fromIntegral (w8 - 87))
+               | otherwise ->
+                 throwDecodeError
+
+        state_u2 :: Int -> Offset -> Word32 -> IO Text
+        state_u2 !out !inp !acc
+          | inp == end = throwDecodeError
+          | otherwise = do
+            let !w8 = A.unsafeIndex src inp
+            if | 48 <= w8, w8 <= 57 ->
+                 state_u3 out (inp + 1) (shiftL acc 4 .|. fromIntegral (w8 - 48))
+               | 65 <= w8, w8 <= 70 ->
+                 state_u3 out (inp + 1) (shiftL acc 4 .|. fromIntegral (w8 - 55))
+               | 97 <= w8, w8 <= 102 ->
+                 state_u3 out (inp + 1) (shiftL acc 4 .|. fromIntegral (w8 - 87))
+               | otherwise ->
+                 throwDecodeError
+
+        state_u1 :: Int -> Offset -> IO Text
+        state_u1 !out !inp
+          | inp == end = throwDecodeError
+          | otherwise = do
+            let !w8 = A.unsafeIndex src inp
+            if | 48 <= w8, w8 <= 57 ->
+                 state_u2 out (inp + 1) (fromIntegral (w8 - 48))
+               | 65 <= w8, w8 <= 70 ->
+                 state_u2 out (inp + 1) (fromIntegral (w8 - 55))
+               | 97 <= w8, w8 <= 102 ->
+                 state_u2 out (inp + 1) (fromIntegral (w8 - 87))
+               | otherwise ->
+                 throwDecodeError
+
+        state_escape :: Int -> Offset -> IO Text
+        state_escape out inp
+          | inp == end = throwDecodeError
+          | otherwise = do
+            let !w8 = A.unsafeIndex src inp
+            case w8 of
+              34 -> do
+                P.writePrimArray arr out 34
+                state_start (out + 1) (inp + 1)
+
+              92 -> do
+                P.writePrimArray arr out 92
+                state_start (out + 1) (inp + 1)
+
+              47 -> do
+                P.writePrimArray arr out 47
+                state_start (out + 1) (inp + 1)
+
+              98 -> do
+                P.writePrimArray arr out 8
+                state_start (out + 1) (inp + 1)
+
+              102 -> do
+                P.writePrimArray arr out 12
+                state_start (out + 1) (inp + 1)
+
+              110 -> do
+                P.writePrimArray arr out 10
+                state_start (out + 1) (inp + 1)
+
+              114 -> do
+                P.writePrimArray arr out 13
+                state_start (out + 1) (inp + 1)
+
+              116 -> do
+                P.writePrimArray arr out 9
+                state_start (out + 1) (inp + 1)
+
+              117 ->
+                state_u1 out (inp + 1)
+
+              _ -> throwDecodeError
+
+        state_start :: Int -> Offset -> IO Text
+        state_start !out !inp
+          | inp == end = do
+            P.shrinkMutablePrimArray arr out
+            frozenArr <- P.unsafeFreezePrimArray arr
+            return $ case frozenArr of
+              P.PrimArray ba -> T.Text (A.Array ba) 0 out
+
+          | otherwise = do
+            let !w8 = A.unsafeIndex src inp
+            if | w8 == 92 -> state_escape out (inp + 1)
+            -- because we are deserialising __valid__ text,
+            -- we can simply copy everything else.
+               | otherwise -> do
+                  P.writePrimArray arr out (fromIntegral w8 :: Word16)
+                  state_start (out + 1) (inp + 1)
+
+    -- start the state machine
+    state_start (0 :: Int) begin
+
+#endif
diff --git a/src/Data/Aeson/Internal/Word16.hs b/src/Data/Aeson/Internal/Word16.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Aeson/Internal/Word16.hs
@@ -0,0 +1,76 @@
+{-# LANGUAGE PatternSynonyms #-}
+-- | This is s/Word8/Word16/g copy of .Word8 module.
+-- This module is used for low-bit working with text <2 (UTF-16)
+module Data.Aeson.Internal.Word16 where
+
+import Data.Word (Word16)
+
+-------------------------------------------------------------------------------
+-- Word16 ASCII codes as patterns
+-------------------------------------------------------------------------------
+
+-- GHC-8.0 doesn't support giving multiple pattern synonyms type signature at once
+
+-- spaces
+pattern W8_SPACE :: Word16
+pattern W8_NL    :: Word16
+pattern W8_CR    :: Word16
+pattern W8_TAB   :: Word16
+
+pattern W8_SPACE = 0x20
+pattern W8_NL    = 0x0a
+pattern W8_CR    = 0x0d
+pattern W8_TAB   = 0x09
+
+-- punctuation
+pattern W8_BACKSLASH    :: Word16
+pattern W8_DOUBLE_QUOTE :: Word16
+pattern W8_DOT          :: Word16
+pattern W8_COMMA        :: Word16
+pattern W8_COLON        :: Word16
+
+pattern W8_BACKSLASH    = 92
+pattern W8_COMMA        = 44
+pattern W8_DOT          = 46
+pattern W8_DOUBLE_QUOTE = 34
+pattern W8_COLON        = 58
+
+-- parentheses
+pattern W8_CLOSE_CURLY  :: Word16
+pattern W8_CLOSE_SQUARE :: Word16
+pattern W8_OPEN_SQUARE  :: Word16
+pattern W8_OPEN_CURLY   :: Word16
+
+pattern W8_OPEN_CURLY   = 123
+pattern W8_OPEN_SQUARE  = 91
+pattern W8_CLOSE_CURLY  = 125
+pattern W8_CLOSE_SQUARE = 93
+
+-- operators
+pattern W8_MINUS :: Word16
+pattern W8_PLUS  :: Word16
+
+pattern W8_PLUS  = 43
+pattern W8_MINUS = 45
+
+-- digits
+pattern W8_0 :: Word16
+pattern W8_9 :: Word16
+
+pattern W8_0 = 48
+pattern W8_9 = 57
+
+-- lower case
+pattern W8_e :: Word16
+pattern W8_f :: Word16
+pattern W8_n :: Word16
+pattern W8_t :: Word16
+
+pattern W8_e = 101
+pattern W8_f = 102
+pattern W8_n = 110
+pattern W8_t = 116
+
+-- upper case
+pattern W8_E :: Word16
+pattern W8_E = 69
diff --git a/src/Data/Aeson/KeyMap.hs b/src/Data/Aeson/KeyMap.hs
--- a/src/Data/Aeson/KeyMap.hs
+++ b/src/Data/Aeson/KeyMap.hs
@@ -268,7 +268,7 @@
 difference :: KeyMap v -> KeyMap v' -> KeyMap v
 difference tm1 tm2 = KeyMap (M.difference (unKeyMap tm1) (unKeyMap tm2))
 
--- The (left-biased) union of two maps. It prefers the first map when duplicate
+-- | The (left-biased) union of two maps. It prefers the first map when duplicate
 -- keys are encountered, i.e. ('union' == 'unionWith' 'const').
 union :: KeyMap v -> KeyMap v -> KeyMap v
 union (KeyMap x) (KeyMap y) = KeyMap (M.union x y)
@@ -477,7 +477,7 @@
 difference :: KeyMap v -> KeyMap v' -> KeyMap v
 difference tm1 tm2 = KeyMap (H.difference (unKeyMap tm1) (unKeyMap tm2))
 
--- The (left-biased) union of two maps. It prefers the first map when duplicate
+-- | The (left-biased) union of two maps. It prefers the first map when duplicate
 -- keys are encountered, i.e. ('union' == 'unionWith' 'const').
 union :: KeyMap v -> KeyMap v -> KeyMap v
 union (KeyMap x) (KeyMap y) = KeyMap (H.union x y)
diff --git a/src/Data/Aeson/RFC8785.hs b/src/Data/Aeson/RFC8785.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Aeson/RFC8785.hs
@@ -0,0 +1,169 @@
+{-# LANGUAGE UnboxedTuples, BangPatterns #-}
+-- | JSON Canonicalization Scheme https://datatracker.ietf.org/doc/html/rfc8785
+module Data.Aeson.RFC8785 (
+    encodeCanonical,
+) where
+
+import Data.List (sortBy)
+import Data.Ord (comparing)
+import GHC.Integer (quotRemInteger)
+import Math.NumberTheory.Logarithms (integerLog10)
+
+import Data.Aeson
+import Data.Aeson.Encoding
+import Data.Aeson.Encoding.Internal
+import Data.Aeson.Internal.Prelude
+import Data.Aeson.Internal.Word8
+
+import qualified Data.Aeson.Key as Key
+import qualified Data.Aeson.KeyMap as KM
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Builder as B
+import qualified Data.ByteString.Builder.Prim as BP
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Scientific as Sci
+import qualified Data.Text.Encoding as TE
+import qualified Data.Vector as V
+
+-- $setup
+-- >>> import Data.Aeson
+
+-- | Encode to JSON according to RFC 8785 canonicalization scheme.
+-- https://datatracker.ietf.org/doc/html/rfc8785
+--
+-- 'encodeCanonical' uses 'toJSON' to produce intermediate 'Value',
+-- as 'toEncoding' may (and most likely) produces non-canonical JSON.
+--
+-- Note: @decode (encodeCanonical v) === Just v@ for all @v :: Value@,
+-- i.e. 'encodeCanonical' doesn't lose any information.
+--
+-- However, the example in RFC8785 /loses/ information as the intermediate
+-- number representation is 'Double', also current @toJSON :: Double -> Value@
+-- sometimes produces too precise values. For example
+--
+-- >>> toJSON (1e23 :: Double)
+-- Number 9.999999999999999e22
+--
+-- 'show' also behaves the same:
+--
+-- >>> 1e23 :: Double
+-- 9.999999999999999e22
+--
+-- Note: RFC8785 is __not the same scheme__ as used in
+-- [canonical-json](https://hackage.haskell.org/package/canonical-json) package
+-- (https://wiki.laptop.org/go/Canonical_JSON).
+-- That scheme produces /invalid/ JSON (e.g. control characters encoded as is, not escaped)
+-- and cannot encode non-integral numbers.
+--
+-- @since 2.2.1.0
+--
+encodeCanonical :: ToJSON a => a -> LBS.ByteString
+encodeCanonical = encodingToLazyByteString . toCanonical . toJSON
+
+toCanonical :: Value -> Encoding
+toCanonical Null       = null_
+toCanonical (Bool b)   = bool b
+toCanonical (Number n) = canonicalNumber n
+toCanonical (String s) = canonicalString s
+toCanonical (Array v)  = list toCanonical (V.toList v)
+toCanonical (Object m) = dict (canonicalString . Key.toText) toCanonical ifr $
+    sortBy (\(k1, _) (k2, _) -> propertyCmp k1 k2) (KM.toList m)
+
+ifr :: (k -> v -> a -> a) -> a -> [(k, v)] -> a
+ifr f z = foldr (\(k, v) -> f k v) z
+{-# INLINE ifr #-}
+
+-- Property name strings to be sorted are formatted as arrays of UTF-16 code units.
+propertyCmp :: Key -> Key -> Ordering
+propertyCmp = comparing f where
+    -- this is slow implementation, but it's obviously not wrong.
+    f :: Key -> BS.ByteString
+    f = TE.encodeUtf16BE . Key.toText
+
+-- strings are already serialized canonically.
+canonicalString :: Text -> Encoding' a
+canonicalString = text
+
+-- RFC 8785 is outsourcing number format to ECMA-262.
+-- 10th edition, 7.1.12.1 NumberToString
+-- https://262.ecma-international.org/10.0/#sec-tostring-applied-to-the-number-type
+--
+-- Note: this specification is not lossy
+-- Given 'Scientific' we can choose n,k,s uniquely: 'nks'.
+--
+-- RFC8785 Appendix D says "don't use bignums".
+canonicalNumber :: Scientific -> Encoding
+canonicalNumber m = case compare m 0 of
+    EQ -> Encoding (B.word8 W8_0)
+    LT -> Encoding (B.word8 W8_MINUS <> fromEncoding (canonicalNumber' (negate m)))
+    GT -> canonicalNumber' m
+
+-- input: Positive number
+canonicalNumber' :: Scientific -> Encoding
+canonicalNumber' m
+    | k <= n, n <= 21
+    = Encoding $
+        BP.primMapListFixed BP.word8 ds <>
+        BP.primMapListFixed BP.word8 (replicate (n - k) W8_0)
+
+    | 0 < n, n <= 21
+    , let (pfx, sfx) = splitAt n ds
+    = Encoding $
+        BP.primMapListFixed BP.word8 pfx <>
+        B.word8 W8_DOT <>
+        BP.primMapListFixed BP.word8 sfx
+
+    | -6 < n, n <= 0
+    = Encoding $
+        B.word8 W8_0 <>
+        B.word8 W8_DOT <>
+        BP.primMapListFixed BP.word8 (replicate (negate n) W8_0) <>
+        BP.primMapListFixed BP.word8 ds
+
+    | k == 1, [d] <- ds
+    = Encoding $
+        B.word8 d <>
+        B.word8 W8_e <>
+        B.word8 (if (n - 1) >= 0 then W8_PLUS else W8_MINUS) <>
+        BP.primMapListFixed BP.word8 (integerToDecimalDigits (abs (toInteger n - 1)))
+
+    | (d:ds') <- ds
+    = Encoding $
+        B.word8 d <>
+        B.word8 W8_DOT <>
+        BP.primMapListFixed BP.word8 ds' <>
+        B.word8 W8_e <>
+        B.word8 (if (n - 1) >= 0 then W8_PLUS else W8_MINUS) <>
+        BP.primMapListFixed BP.word8 (integerToDecimalDigits (abs (toInteger n - 1)))
+
+    | otherwise
+    = string "0" -- shouldn't happen, but we need a default case.
+
+  where
+    -- 5. Otherwise, let n, k, and s be integers such that
+    -- k ≥ 1, 10k - 1 ≤ s < 10k, the Number value for s × 10n - k is m,
+    -- and k is as small as possible.
+    -- Note that k is the number of digits in the decimal representation of s,
+    -- that s is not divisible by 10, and that the least significant digit of s
+    -- is not necessarily uniquely determined by these criteria.
+    (n, k, s) = nks m
+    ds = integerToDecimalDigits s
+
+-- 5. Otherwise, let n, k, and s be integers such that k ≥ 1, 10^(k - 1) ≤ s < 10^k,
+-- the Number value for s × 10^(n - k) is m, and k is as small as possible.
+-- Note that k is the number of digits in the decimal representation of s,
+-- that s is not divisible by 10, and that the least significant digit of s
+-- is not necessarily uniquely determined by these criteria.
+nks :: Scientific -> (Int, Int, Integer)
+nks m = (e + k, k, c)
+  where
+    m' = Sci.normalize m
+    c = Sci.coefficient m'
+    e = Sci.base10Exponent m'
+    k = integerLog10 c + 1
+
+integerToDecimalDigits :: Integer -> [Word8]
+integerToDecimalDigits = go [] where
+    go acc 0 = acc
+    go acc i = case quotRemInteger i 10 of
+        (# q, r #) -> go (d:acc) q where !d = fromIntegral r + W8_0
diff --git a/tests/CastFloat.hs b/tests/CastFloat.hs
new file mode 100644
--- /dev/null
+++ b/tests/CastFloat.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE CPP #-}
+module CastFloat (
+    castDoubleToWord64,
+    castWord64ToDouble,
+    castFloatTests,
+) where
+
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (testCase, (@?=))
+import Test.Tasty.QuickCheck (testProperty, (===))
+
+import Types (UniformWord64 (..))
+
+#if MIN_VERSION_base(4,11,0)
+import GHC.Float (castDoubleToWord64, castWord64ToDouble)
+#else
+
+import Data.Word (Word64)
+import Foreign.Storable (Storable (peek, poke))
+import Foreign.Ptr (castPtr)
+import Foreign.Marshal (alloca)
+import System.IO.Unsafe (unsafeDupablePerformIO)
+
+castDoubleToWord64 :: Double -> Word64
+castDoubleToWord64 = reinterpretCast
+
+castWord64ToDouble :: Word64 -> Double
+castWord64ToDouble = reinterpretCast
+
+reinterpretCast :: (Storable a, Storable b) => a -> b
+reinterpretCast x = unsafeDupablePerformIO $ alloca $ \ptr -> do
+    poke ptr x
+    peek (castPtr ptr)
+
+#endif
+
+castFloatTests :: TestTree
+castFloatTests = testGroup "castDoubleToWord64"
+    [ testCase "5e-324" $ castDoubleToWord64 5e-324 @?= 1
+    , testProperty "roundtrip1" $ \d       -> castWord64ToDouble (castDoubleToWord64 d) === d
+    , testProperty "roundtrip2" $ \(U64 w) -> castDoubleToWord64 (castWord64ToDouble w) === w
+    ]
diff --git a/tests/DoubleToScientific.hs b/tests/DoubleToScientific.hs
new file mode 100644
--- /dev/null
+++ b/tests/DoubleToScientific.hs
@@ -0,0 +1,223 @@
+{-# LANGUAGE UnboxedTuples, BangPatterns, MultiWayIf #-}
+module DoubleToScientific (
+    doubleToScientific,
+    doubleToScientificTests,
+) where
+
+-- import Debug.Trace
+-- import Data.Ratio ((%))
+
+import Data.Bits
+import Data.Foldable (foldl')
+import Data.Word (Word64)
+import Data.Scientific (Scientific)
+import GHC.Integer (quotRemInteger)
+
+import qualified Data.Scientific as Sci
+
+import CastFloat
+import Types (UniformWord64 (..))
+
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.QuickCheck (testProperty, counterexample, (===), (==>))
+
+-------------------------------------------------------------------------------
+-- tests
+-------------------------------------------------------------------------------
+
+-- note: RFC8785 has some special cases.
+doubleToScientificTests :: TestTree
+doubleToScientificTests = testGroup "doubleToScientific"
+    [ testProperty "roundtrip1" $ \d ->
+        Sci.toRealFloat (doubleToScientific d) === d
+    , testProperty "roundtrip2" $ \(U64 w) ->
+        let d = castWord64ToDouble w
+        in counterexample (show d) $
+            not (isInfinite d || isNaN d) ==>
+            Sci.toRealFloat (doubleToScientific d) === d
+    ]
+
+-------------------------------------------------------------------------------
+-- doubleToScientific
+-------------------------------------------------------------------------------
+
+{- Convert 'Double' to 'Scientific'
+
+Based on double-conversion implementation
+https://github.com/google/double-conversion
+
+Copyright 2006-2011, the V8 project authors. All rights reserved.
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+    * Neither the name of Google Inc. nor the names of its
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+-}
+doubleToScientific :: Double -> Scientific
+doubleToScientific v = case compare v 0 of
+    EQ -> 0
+    LT -> negate (doubleToScientific' (negate v))
+    GT -> doubleToScientific' v
+
+-------------------------------------------------------------------------------
+-- doubleToScientific implementation
+-------------------------------------------------------------------------------
+
+data S = S
+    { num     :: !Integer
+    , den     :: !Integer
+    , delta_m :: !Integer
+    , delta_p :: !Integer
+    , is_even :: !Bool
+    }
+  deriving Show
+
+-- preconditions: v > 0
+doubleToScientific' :: Double -> Scientific
+doubleToScientific' v =
+    let s1          = initialStartValues v
+        (s2, pow10) = fixupMultiply10 s1
+        ds          = generateShortestDigits s2
+        k           = length ds
+    in Sci.scientific (foldl' (\acc d -> 10 * acc + d) 0 ds) (pow10 - k + 1)
+       -- error $ show (s1, s2, pow10, fromRational (num s2 % den s2), ds)
+
+initialStartValues :: Double -> S
+initialStartValues v = lowerBoundaryCloser' $ applyExponent e S
+    { num     = shiftL s 1
+    , den     = 2
+    , delta_m = 1
+    , delta_p = 1
+    , is_even = evenInteger s
+    }
+  where
+    (s, e, lower_boundary_is_closer) = decodeFloat' v
+    lowerBoundaryCloser' = if lower_boundary_is_closer then lowerBoundaryCloser else id
+
+-- | return significant, exponent and whether lower boundery is closer.
+--
+-- GHC's decodeFloat does "weird" stuff to denormal doubles,
+-- that messes up our delta calculation.
+decodeFloat' :: Double -> (Integer, Int, Bool)
+decodeFloat' d
+    | denormal   = (toInteger s,                  kDenormalExponent,              False)
+    | otherwise  = (toInteger (s .|. kHiddenBit), fromIntegral e - kExponentBias, w64 .&. kSignificandMask == 0)
+  where
+    denormal = w64 .&. kExponentMask == 0
+
+    s = w64 .&. kSignificandMask
+    e = shiftR (w64 .&. kExponentMask) kPhysicalSignificandSize
+
+    w64 = castDoubleToWord64 d
+
+    kExponentMask    = 0x7FF0000000000000 :: Word64
+    kSignificandMask = 0x000FFFFFFFFFFFFF :: Word64
+    kHiddenBit       = 0x0010000000000000 :: Word64
+
+    kPhysicalSignificandSize = 52 :: Int
+    kExponentBias            = 0x3FF + kPhysicalSignificandSize :: Int
+    kDenormalExponent        = -kExponentBias + 1 :: Int
+
+lowerBoundaryCloser :: S -> S
+lowerBoundaryCloser s = s
+    { num     = shiftL (num s) 1
+    , den     = shiftL (den s) 1
+    , delta_p = shiftL (delta_p s) 1
+    }
+
+applyExponent :: Int -> S -> S
+applyExponent e s = case compare e 0 of
+    EQ -> s
+    GT -> S
+        { num     = shiftL (num s) e
+        , den     = den s
+        , delta_m = shiftL (delta_m s) e
+        , delta_p = shiftL (delta_m s) e
+        , is_even = is_even s
+        }
+    LT -> S
+        { num     = num s
+        , den     = shiftL (den s) (negate e)
+        , delta_m = delta_m s
+        , delta_p = delta_m s
+        , is_even = is_even s
+        }
+
+-- This routine multiplies numerator/denominator so that its values lies in the
+-- range 1-10. That is after a call to this function we have:
+-- 1 <= (numerator + delta_plus) / denominator < 10.
+fixupMultiply10 :: S -> (S, Int)
+fixupMultiply10 = go 0 where
+    go p s = case compare (den s) (num s + delta_p s) of
+        GT -> go (p - 1) (times10 s)
+        EQ -> (s, p) -- TODO: is_even check?
+        LT -> case compare (num s + delta_p s) (10 * den s) of
+            LT -> (s, p)
+            _  -> go (p + 1) (div10 s)
+
+times10 :: S -> S
+times10 s = s { num = 10 * num s, delta_p = 10 * delta_p s, delta_m = 10 * delta_m s }
+
+div10 :: S -> S
+div10 s = s { den = 10 * den s }
+
+generateShortestDigits :: S -> [Integer]
+generateShortestDigits = go where
+    go s = case quotRemInteger (num s) (den s) of
+        (# d, r #) -> if
+            | not in_delta_room_minus
+            , not in_delta_room_plus
+            -> d : go (times10 s { num = r })
+
+            | in_delta_room_minus
+            , in_delta_room_plus
+            -- Let's see if 2*numerator < denominator.
+            -- If yes, then the next digit would be < 5 and we can round down.
+            -> case compare (2 * r) (den s) of
+                -- Remaining digits are less than .5. -> Round down (== do nothing).
+                LT -> [d]
+                -- Remaining digits are more than .5 of denominator. -> Round up.
+                GT -> [d+1]
+                -- Halfway case.
+                -- round towards even
+                EQ -> if evenInteger d then [d] else [d+1]
+
+            | in_delta_room_minus
+            -- round down
+            -> [d]
+
+            | otherwise
+            -- Round up.
+            -> [d + 1]
+
+          where
+            in_delta_room_minus
+                | is_even s = r <= delta_m s
+                | otherwise = r <  delta_m s
+
+            in_delta_room_plus
+                | is_even s = r + delta_p s >= den s
+                | otherwise = r + delta_p s >  den s
+
+evenInteger :: Integer -> Bool
+evenInteger i = not (testBit i 0)
diff --git a/tests/JSONTestSuite.hs b/tests/JSONTestSuite.hs
--- a/tests/JSONTestSuite.hs
+++ b/tests/JSONTestSuite.hs
@@ -13,12 +13,14 @@
 import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Lazy.Char8 as LBS8
 import qualified Data.HashSet as HashSet
+import qualified Data.Text.Encoding as TE
 
 import Data.Aeson
 import qualified Data.Aeson.Decoding as D
 import Data.Aeson.Decoding.Tokens
 import qualified Data.Aeson.Decoding.ByteString as D
 import qualified Data.Aeson.Decoding.ByteString.Lazy as D
+import qualified Data.Aeson.Decoding.Text as D
 
 
 jsonTestSuiteTest :: FilePath -> TestTree
@@ -57,6 +59,13 @@
             let result = D.lbsToTokens payload
             return (LBS8.pack (unlines (showTokens (const []) result)))
 
+        , goldenVsStringDiff "tokens text" diff ("tests" </>  "JSONTestSuite" </> "results" </> fileName -<.> "tok") $ do
+            payload' <- B.readFile path
+            case TE.decodeUtf8' payload' of
+                Left exc -> fail $ show exc -- successful test shouldn't fail.
+                Right payload -> do 
+                    let result = D.textToTokens payload
+                    return (LBS8.pack (unlines (showTokens (const []) result)))
         ]
 
     negative = testGroup fileName
@@ -74,6 +83,12 @@
             let result3 = D.eitherDecode payloadL :: Either String Value
             assertBool ("lazy:" ++ show result3) (isLeft result3)
 
+            case TE.decodeUtf8' payload of
+                Left _exc -> return ()
+                Right payloadT -> do
+                    let result4 = D.eitherDecodeStrictText payloadT :: Either String Value
+                    assertBool ("text:" ++ show result4) (isLeft result4)
+
         , goldenVsStringDiff "tokens bs" diff ("tests" </>  "JSONTestSuite" </> "results" </> fileName -<.> "tok") $ do
             payload <- B.readFile path
             let result = D.bsToTokens payload
@@ -84,6 +99,15 @@
             let result = D.lbsToTokens payload
             return (LBS8.pack (unlines (showTokens (const []) result)))
 
+        , goldenVsStringDiff "tokens text" diff ("tests" </>  "JSONTestSuite" </> "results" </> fileName -<.> "ttok") $ do
+            payload' <- B.readFile path
+            case TE.decodeUtf8' payload' of
+                Left _exc -> do
+                    -- some failing cases are invalid UTF8
+                    return (LBS8.pack "Invalid UTF8")
+                Right payload -> do 
+                    let result = D.textToTokens payload
+                    return (LBS8.pack (unlines (showTokens (const []) result)))
         ]
 
 showTokens :: Show e => (k -> [String]) -> Tokens k e -> [String]
diff --git a/tests/RFC8785.hs b/tests/RFC8785.hs
new file mode 100644
--- /dev/null
+++ b/tests/RFC8785.hs
@@ -0,0 +1,144 @@
+{-# LANGUAGE QuasiQuotes, OverloadedStrings #-}
+module RFC8785 (rfc8785Tests) where
+
+import Data.Text (Text)
+import Data.Word (Word64)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit ((@?=), testCase)
+import Test.Tasty.QuickCheck (testProperty, (===))
+
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Lazy.Char8 as LBS8
+import qualified Data.Scientific as Sci
+
+import Data.Aeson
+import Data.Aeson.Decoding.ByteString.Lazy
+import Data.Aeson.Decoding.Tokens
+import Data.Aeson.QQ.Simple
+import Data.Aeson.RFC8785
+
+import CastFloat
+import DoubleToScientific
+
+rfc8785Tests :: TestTree
+rfc8785Tests = testGroup "RFC8785"
+    [ testCase "example" $ do
+        encodeCanonical exampleValue @?= exampleBS
+
+    , testCase "key-sort" $ do
+        recordTextValues (encodeCanonical sortingValue) @?= sortingStrings
+
+    , numberCases
+
+    , testProperty "roundtrip" $ \v ->
+        decode (encodeCanonical v) === Just (v :: Value)
+
+    , castFloatTests
+    , doubleToScientificTests
+    ]
+
+-------------------------------------------------------------------------------
+-- Example
+-------------------------------------------------------------------------------
+
+exampleValue :: Value
+exampleValue = mapNumbers (doubleToScientific . Sci.toRealFloat) [aesonQQ| {
+    "numbers": [333333333.33333329, 1E30, 4.50,
+                2e-3, 0.000000000000000000000000001],
+    "string": "\u20ac$\u000F\u000aA'\u0042\u0022\u005c\\\"\/",
+    "literals": [null, true, false]
+  } |]
+
+mapNumbers :: (Sci.Scientific -> Sci.Scientific) -> Value -> Value
+mapNumbers _ v@Null        = v
+mapNumbers _ v@(String _)  = v
+mapNumbers _ v@(Bool _)    = v
+mapNumbers f   (Number x)  = Number (f x)
+mapNumbers f   (Object xs) = Object (fmap (mapNumbers f) xs)
+mapNumbers f   (Array xs)  = Array (fmap (mapNumbers f) xs)
+
+
+exampleBS :: LBS.ByteString
+exampleBS = LBS.pack
+    [ 0x7b, 0x22, 0x6c, 0x69, 0x74, 0x65, 0x72, 0x61, 0x6c, 0x73, 0x22, 0x3a, 0x5b, 0x6e, 0x75, 0x6c, 0x6c, 0x2c, 0x74, 0x72
+    , 0x75, 0x65, 0x2c, 0x66, 0x61, 0x6c, 0x73, 0x65, 0x5d, 0x2c, 0x22, 0x6e, 0x75, 0x6d, 0x62, 0x65, 0x72, 0x73, 0x22, 0x3a
+    , 0x5b, 0x33, 0x33, 0x33, 0x33, 0x33, 0x33, 0x33, 0x33, 0x33, 0x2e, 0x33, 0x33, 0x33, 0x33, 0x33, 0x33, 0x33, 0x2c, 0x31
+    , 0x65, 0x2b, 0x33, 0x30, 0x2c, 0x34, 0x2e, 0x35, 0x2c, 0x30, 0x2e, 0x30, 0x30, 0x32, 0x2c, 0x31, 0x65, 0x2d, 0x32, 0x37
+    , 0x5d, 0x2c, 0x22, 0x73, 0x74, 0x72, 0x69, 0x6e, 0x67, 0x22, 0x3a, 0x22, 0xe2, 0x82, 0xac, 0x24, 0x5c, 0x75, 0x30, 0x30
+    , 0x30, 0x66, 0x5c, 0x6e, 0x41, 0x27, 0x42, 0x5c, 0x22, 0x5c, 0x5c, 0x5c, 0x5c, 0x5c, 0x22, 0x2f, 0x22, 0x7d
+    ]
+
+-------------------------------------------------------------------------------
+-- Key sorting
+-------------------------------------------------------------------------------
+
+sortingValue :: Value
+sortingValue = [aesonQQ| {
+    "\u20ac": "Euro Sign",
+    "\r": "Carriage Return",
+    "\ufb33": "Hebrew Letter Dalet With Dagesh",
+    "1": "One",
+    "\ud83d\ude00": "Emoji: Grinning Face",
+    "\u0080": "Control",
+    "\u00f6": "Latin Small Letter O With Diaeresis"
+  } |]
+
+sortingStrings :: [Text]
+sortingStrings =
+    [ "Carriage Return"
+    , "One"
+    , "Control"
+    , "Latin Small Letter O With Diaeresis"
+    , "Euro Sign"
+    , "Emoji: Grinning Face"
+    , "Hebrew Letter Dalet With Dagesh"
+    ]
+
+recordTextValues :: LBS.ByteString -> [Text]
+recordTextValues lbs = case lbsToTokens lbs of
+    TkRecordOpen r -> go r
+    _              -> []
+  where
+    go (TkPair _ (TkText s ts)) = s : go ts
+    go _                        = []
+
+-------------------------------------------------------------------------------
+-- Numbers
+-------------------------------------------------------------------------------
+
+-- Appendix B. Number Serialization Samples
+numbers :: [(Word64, LBS.ByteString)]
+numbers =
+    [ (0x0000000000000000, "0") -- Zero
+    , (0x8000000000000000, "0") -- Minus zero
+    , (0x0000000000000001, "5e-324") -- Min pos number
+    , (0x8000000000000001, "-5e-324") -- Min neg number
+    , (0x7fefffffffffffff, "1.7976931348623157e+308") -- Max pos number
+    , (0xffefffffffffffff, "-1.7976931348623157e+308") -- Max neg number
+    , (0x4340000000000000, "9007199254740992") -- Max pos int (1)
+    , (0xc340000000000000, "-9007199254740992") -- Max neg int (1)
+    , (0x4430000000000000, "295147905179352830000") -- ~2**68 (2)
+    , (0x44b52d02c7e14af5, "9.999999999999997e+22")
+    , (0x44b52d02c7e14af6, "1e+23")
+    , (0x44b52d02c7e14af7, "1.0000000000000001e+23")
+    , (0x444b1ae4d6e2ef4e, "999999999999999700000")
+    , (0x444b1ae4d6e2ef4f, "999999999999999900000")
+    , (0x444b1ae4d6e2ef50, "1e+21")
+    , (0x3eb0c6f7a0b5ed8c, "9.999999999999997e-7")
+    , (0x3eb0c6f7a0b5ed8d, "0.000001")
+    , (0x41b3de4355555553, "333333333.3333332")
+    , (0x41b3de4355555554, "333333333.33333325")
+    , (0x41b3de4355555555, "333333333.3333333")
+    , (0x41b3de4355555556, "333333333.3333334")
+    , (0x41b3de4355555557, "333333333.33333343")
+    , (0xbecbf647612f3696, "-0.0000033333333333333333")
+    , (0x43143ff3c1cb0959, "1424953923781206.2") -- Round to even (4)
+    ]
+
+numberCases :: TestTree
+numberCases = testGroup "numbers"
+    [ testCase (LBS8.unpack lbs) $ do
+        encodeCanonical (doubleToScientific d) @?= lbs
+    | (w64, lbs) <- numbers
+    , let d = castWord64ToDouble w64 :: Double
+    ]
diff --git a/tests/Tests.hs b/tests/Tests.hs
--- a/tests/Tests.hs
+++ b/tests/Tests.hs
@@ -9,10 +9,11 @@
 import qualified Properties
 import qualified UnitTests
 import qualified JSONTestSuite
+import RFC8785
 
 main :: IO ()
 main = do
     ioTests <- UnitTests.ioTests
     jsTests <- JSONTestSuite.tests
-    let allTests = DF.tests : Properties.tests : UnitTests.tests : jsTests : ioTests
+    let allTests = DF.tests : rfc8785Tests : Properties.tests : UnitTests.tests : jsTests : ioTests
     defaultMain (testGroup "tests" allTests)
diff --git a/tests/Types.hs b/tests/Types.hs
--- a/tests/Types.hs
+++ b/tests/Types.hs
@@ -20,13 +20,15 @@
 #if !MIN_VERSION_base(4,16,0)
 import Data.Semigroup (Option)
 #endif
-import Data.Text
+import Data.Text (Text)
 import Data.Time (Day (..), fromGregorian)
 import GHC.Generics
 import Test.QuickCheck (Arbitrary (..), Property, counterexample, scale)
+import Test.QuickCheck.Gen (chooseUpTo)
 import qualified Data.Map as Map
 import Data.Aeson
 import Data.Aeson.Types
+import Data.Word (Word64)
 
 type I = Identity
 type Compose3  f g h = Compose (Compose f g) h
@@ -164,3 +166,13 @@
 instance (FromJSONKey a) => FromJSONKey (LogScaled a) where
     fromJSONKey = fmap LogScaled fromJSONKey
     fromJSONKeyList = coerceFromJSONKeyFunction (fromJSONKeyList :: FromJSONKeyFunction [a])
+
+newtype UniformWord64 = U64 Word64
+  deriving (Eq, Ord)
+
+instance Show UniformWord64 where
+    showsPrec d (U64 w) = showsPrec d w
+
+instance Arbitrary UniformWord64 where
+    arbitrary = U64 <$> chooseUpTo maxBound
+    shrink (U64 w) = map U64 (shrink w)