Vendor the flat package

plutus-benchmark/common/PlutusBenchmark/Common.hs

@@ -50,8 +50,8 @@ import Criterion.Main
 import Criterion.Types (Config (..))
 import Data.ByteString qualified as BS
 import Data.SatInt (fromSatInt)
-import Flat qualified
 import GHC.IO.Encoding (setLocaleEncoding)
+import PlutusCore.Flat qualified as Flat
 import System.Directory
 import System.FilePath
 import System.IO

plutus-benchmark/coop/exe/Main.hs

@@ -13,7 +13,7 @@ import PlutusTx
 
 import Data.ByteString.Lazy qualified as BSL
 import Data.Foldable (traverse_)
-import Flat (flat, unflat)
+import PlutusCore.Flat (flat, unflat)
 import System.Directory (doesFileExist)
 import System.FilePath ((<.>), (</>))
 

plutus-benchmark/nofib/exe/Main.hs

@@ -15,8 +15,8 @@ import Data.Char (isSpace)
 import Data.Foldable (traverse_)
 import Data.SatInt
 import Data.String (fromString)
-import Flat qualified
 import Options.Applicative as Opt hiding (action)
+import PlutusCore.Flat qualified as Flat
 import Prettyprinter (Doc, indent, line, vsep)
 import System.Exit (exitFailure)
 import System.IO

plutus-benchmark/plutus-benchmark.cabal

@@ -93,8 +93,8 @@ library plutus-benchmark-common
     , deepseq
     , directory
     , filepath
-    , flat                         ^>=0.6
     , plutus-core                  ^>=1.53
+    , plutus-core:flat
     , plutus-ledger-api            ^>=1.53
     , plutus-tx:plutus-tx-testlib
     , tasty
@@ -133,12 +133,12 @@ executable nofib-exe
   build-depends:
     , base                     >=4.9   && <5
     , bytestring
-    , flat                     ^>=0.6
     , lens
     , nofib-internal
     , optparse-applicative
     , plutus-benchmark-common
     , plutus-core              ^>=1.53
+    , plutus-core:flat
     , plutus-tx                ^>=1.53
     , prettyprinter
     , transformers
@@ -289,10 +289,10 @@ library validation-internal
     , criterion                >=1.5.9.0
     , directory
     , filepath
-    , flat                     ^>=0.6
     , optparse-applicative
     , plutus-benchmark-common
     , plutus-core              ^>=1.53
+    , plutus-core:flat
 
 benchmark validation
   import:         lang, os-support
@@ -317,9 +317,9 @@ test-suite validation-tests
     , bytestring
     , directory
     , filepath
-    , flat                             ^>=0.6
     , plutus-benchmark-common
     , plutus-core                      ^>=1.53
+    , plutus-core:flat
     , plutus-core:plutus-core-testlib
     , plutus-tx                        ^>=1.53
     , plutus-tx:plutus-tx-testlib
@@ -780,9 +780,9 @@ executable gen-coop-flat
     , coop
     , directory
     , filepath
-    , flat
     , plutus-benchmark-common
     , plutus-core
+    , plutus-core:flat
     , plutus-ledger-api
     , plutus-tx                    ^>=1.53
     , plutus-tx:plutus-tx-testlib

plutus-benchmark/validation/src/PlutusBenchmark/Validation/Common.hs

@@ -24,7 +24,7 @@ import Options.Applicative
 
 import Data.ByteString qualified as BS
 import Data.List (isPrefixOf)
-import Flat
+import PlutusCore.Flat
 import System.Directory (listDirectory)
 import System.FilePath
 

plutus-benchmark/validation/test/Spec.hs

@@ -14,7 +14,7 @@ import PlutusTx.Test qualified as Tx
 import UntypedPlutusCore qualified as UPLC
 
 import Data.ByteString qualified as BS
-import Flat
+import PlutusCore.Flat
 import System.Directory (listDirectory)
 import System.FilePath
 

plutus-core/executables/plutus/AnyProgram/IO.hs

@@ -23,7 +23,7 @@ import Data.ByteString.Lazy qualified as BSL
 import Data.Maybe
 import Data.Singletons.Decide
 import Data.Text.Encoding qualified as T
-import Flat
+import PlutusCore.Flat
 import Prettyprinter
 import Prettyprinter.Render.Text
 import System.IO

plutus-core/executables/src/PlutusCore/Executable/AstIO.hs

@@ -32,7 +32,7 @@ import UntypedPlutusCore qualified as UPLC
 
 import Control.Lens (traverseOf)
 import Data.ByteString.Lazy qualified as BSL
-import Flat (Flat, flat, unflat)
+import PlutusCore.Flat (Flat, flat, unflat)
 
 type UplcProgDB ann = UPLC.Program PLC.DeBruijn PLC.DefaultUni PLC.DefaultFun ann
 type UplcProgNDB ann = UPLC.Program PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun ann

plutus-core/executables/src/PlutusCore/Executable/Common.hs

@@ -80,8 +80,8 @@ import Data.Proxy (Proxy (..))
 import Data.SatInt
 import Data.Text qualified as T
 import Data.Text.IO qualified as T
-import Flat (Flat)
 import GHC.TypeLits (symbolVal)
+import PlutusCore.Flat (Flat)
 import Prettyprinter ((<+>))
 
 import Text.Megaparsec (errorBundlePretty)

plutus-core/flat/LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2016, Pasqualino `Titto` Assini 
+
+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 the copyright holder nor the names of other
+      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.

plutus-core/flat/README.md

@@ -0,0 +1,7 @@
+# `flat` (vendored)
+
+This is a vendored copy of the `flat` Haskell library, included for use within the Plutus repository. 
+
+It is not intended for standalone use or external distribution. Original source available at: https://github.com/Quid2/flat.
+
+Modifications (if any) from upstream should be documented below.

plutus-core/flat/src/PlutusCore/Flat.hs

@@ -0,0 +1,21 @@
+{-|
+Haskell implementation of <http://quid2.org/docs/Flat.pdf Flat>, a principled, portable and efficient binary data format.
+
+-}
+module PlutusCore.Flat
+  ( module PlutusCore.Flat.Class
+  , module PlutusCore.Flat.Filler
+  , module X
+  , Decoded
+  , DecodeException(..)
+  )
+where
+
+import PlutusCore.Flat.AsBin as X
+import PlutusCore.Flat.AsSize as X
+import PlutusCore.Flat.Class
+import PlutusCore.Flat.Decoder
+import PlutusCore.Flat.Filler
+import PlutusCore.Flat.Instances as X
+import PlutusCore.Flat.Run as X
+import PlutusCore.Flat.Types ()

plutus-core/flat/src/PlutusCore/Flat/AsBin.hs

@@ -0,0 +1,118 @@
+{-# LANGUAGE InstanceSigs              #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE ScopedTypeVariables       #-}
+
+{- | Wrapper type to decode a value to its flat serialisation.
+
+See <../test/Big.hs> for an example of use.
+
+See also 'Flat.Decoder.listTDecoder' and "Flat.AsSize" for other ways to handle large decoded values.
+
+In 0.5.X this type was called @Repr@.
+
+@since 0.6
+-}
+module PlutusCore.Flat.AsBin(AsBin,unbin) where
+
+import Data.ByteString qualified as B
+import Foreign (plusPtr)
+import PlutusCore.Flat.Bits (bits, fromBools, toBools)
+import PlutusCore.Flat.Class (Flat (..))
+import PlutusCore.Flat.Decoder.Prim (binOf)
+import PlutusCore.Flat.Decoder.Types (Get (Get, runGet), GetResult (GetResult),
+                                      S (S, currPtr, usedBits))
+import PlutusCore.Flat.Run (unflatRawWithOffset)
+import Text.PrettyPrint.HughesPJClass (Doc, Pretty (pPrint), prettyShow, text)
+
+-- $setup
+-- >>> :set -XScopedTypeVariables
+-- >>> import PlutusCore.Flat.Instances.Base
+-- >>> import PlutusCore.Flat.Instances.Text
+-- >>> import PlutusCore.Flat.Decoder.Types
+-- >>> import PlutusCore.Flat.Types
+-- >>> import PlutusCore.Flat.Run
+-- >>> import Data.Word
+-- >>> import qualified Data.Text as T
+-- >>> import Text.PrettyPrint.HughesPJClass
+
+{- |
+
+When the flat serialisation of a value takes a lot less memory than the value itself, it can be convenient to keep the value in its encoded representation and decode it on demand.
+
+To do so, just decode a value `a` as a `AsBin a`.
+
+Examples:
+
+Encode a list of Ints and then decode it to a list of AsBin Int:
+
+>>> unflat (flat [1::Int .. 3]) :: Decoded ([AsBin Int])
+Right [AsBin {repr = "\129A", offsetBits = 1},AsBin {repr = "A ", offsetBits = 2},AsBin {repr = " \193", offsetBits = 3}]
+
+To decode an `AsBin a` to an `a`, use `unbin`:
+
+>>> unbin <$> (unflat (flat 'a') :: Decoded (AsBin Char))
+Right 'a'
+
+Keep the values of a list of Ints encoded and decode just one on demand:
+
+>>> let Right l :: Decoded [AsBin Int] = unflat (flat [1..5]) in unbin (l  !! 2)
+3
+
+Show exactly how values are encoded:
+
+>>> let Right t :: Decoded (AsBin Bool,AsBin Word8,AsBin Bool) = unflat (flat (False,3:: Word64,True)) in prettyShow t
+"(0, _0000001 1, _1)"
+
+Ten bits in total spread over two bytes:
+
+@
+0
+_0000001 1
+         _1
+=
+00000001 11
+@
+
+Tests:
+
+>>> unflat (flat ()) :: Decoded (AsBin ())
+Right (AsBin {repr = "", offsetBits = 0})
+
+>>> unflat (flat (False,True)) :: Decoded (Bool,AsBin Bool)
+Right (False,AsBin {repr = "A", offsetBits = 1})
+
+>>> unflat (flat (False,False,255 :: Word8)) :: Decoded (Bool,Bool,AsBin Word8)
+Right (False,False,AsBin {repr = "?\193", offsetBits = 2})
+
+>>> let Right (b0,b1,rw,b3) :: Decoded (Bool,Bool,AsBin Word8,Bool) = unflat (flat (False,False,255 :: Word8,True)) in (b0,b1,unbin rw,b3)
+(False,False,255,True)
+-}
+
+data AsBin a = AsBin {
+    repr        :: B.ByteString -- ^ Flat encoding of the value (encoding starts after offset bits in the first byte and ends in an unspecified position in the last byte)
+    ,offsetBits :: Int -- ^ First byte offset: number of unused most significant bits in the first byte
+    } deriving Show
+
+instance Flat a => Pretty (AsBin a) where
+    pPrint :: AsBin a -> Doc
+    pPrint r = let n = replicate (offsetBits r) in text $ n '_' ++  (drop (offsetBits r) . prettyShow . fromBools . (n False ++) . toBools . bits $ unbin r)
+
+-- | Decode a value
+unbin :: Flat a => AsBin a -> a
+unbin a =
+    case unflatRawWithOffset dec (repr a) (offsetBits a) of
+        Right a -> a
+        Left e  -> error (show e) -- impossible, as it is a valid encoding
+    where
+        dec = Get $ \end s -> do
+          GetResult s' a <- runGet decode end s
+          let s'' = S (currPtr s' `plusPtr` if usedBits s' == 0 then 0 else 1) 0
+          return $ GetResult s'' a
+
+instance Flat a => Flat (AsBin a) where
+    size = error "unused"
+
+    encode = error "unused"
+
+    decode :: Flat a => Get (AsBin a)
+    decode = uncurry AsBin <$> binOf (decode :: Get a)

plutus-core/flat/src/PlutusCore/Flat/AsSize.hs

@@ -0,0 +1,65 @@
+{-# LANGUAGE InstanceSigs              #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE ScopedTypeVariables       #-}
+
+{- |
+Wrapper type to decode a value to its size in bits.
+
+See also "Flat.AsBin".
+
+In 0.5.X this type was called @SizeOf@.
+
+@since 0.6
+-}
+module PlutusCore.Flat.AsSize(AsSize(..)) where
+
+import PlutusCore.Flat.Class (Flat (..))
+import PlutusCore.Flat.Decoder.Prim (sizeOf)
+import PlutusCore.Flat.Decoder.Types (Get)
+import PlutusCore.Flat.Types (NumBits)
+
+-- $setup
+-- >>> :set -XScopedTypeVariables
+-- >>> import PlutusCore.Flat.Instances.Base
+-- >>> import PlutusCore.Flat.Instances.Text
+-- >>> import PlutusCore.Flat.Decoder.Types
+-- >>> import PlutusCore.Flat.Types
+-- >>> import PlutusCore.Flat.Run
+-- >>> import Data.Word
+-- >>> import qualified Data.Text as T
+
+{- |
+Useful to skip unnecessary values and to check encoding sizes.
+
+Examples:
+
+Ignore the second and fourth component of a tuple:
+
+>>> let v = flat ('a',"abc",'z',True) in unflat v :: Decoded (Char,AsSize String,Char,AsSize Bool)
+Right ('a',AsSize 28,'z',AsSize 1)
+
+Notice the variable size encoding of Words:
+
+>>> unflat (flat (1::Word16,1::Word64)) :: Decoded (AsSize Word16,AsSize Word64)
+Right (AsSize 8,AsSize 8)
+
+Text:
+
+>>> unflat (flat (T.pack "",T.pack "a",T.pack "主",UTF8Text $ T.pack "主",UTF16Text $ T.pack "主",UTF16Text $ T.pack "a")) :: Decoded (AsSize T.Text,AsSize T.Text,AsSize T.Text,AsSize UTF8Text,AsSize UTF16Text,AsSize UTF16Text)
+Right (AsSize 16,AsSize 32,AsSize 48,AsSize 48,AsSize 40,AsSize 40)
+
+Various encodings:
+
+>>> unflat (flat (False,[T.pack "",T.pack "a",T.pack "主"],'a')) :: Decoded (AsSize Bool,AsSize [T.Text],AsSize Char)
+Right (AsSize 1,AsSize 96,AsSize 8)
+-}
+newtype AsSize a = AsSize NumBits deriving (Eq,Ord,Show)
+
+instance Flat a => Flat (AsSize a) where
+    size :: Flat a => AsSize a -> NumBits -> NumBits
+    size = error "unused"
+
+    encode = error "unused"
+
+    decode :: Flat a => Get (AsSize a)
+    decode = AsSize <$> sizeOf (decode :: Get a)