serokell-util (empty) → 0.1.1

raw patch · 41 files changed

+2248/−0 lines, 41 filesdep +QuickCheckdep +acid-statedep +aesonsetup-changed

Dependencies added: QuickCheck, acid-state, aeson, aeson-extra, base, base16-bytestring, base64-bytestring, binary, binary-orphans, bytestring, cereal, cereal-vector, clock, containers, data-msgpack, deepseq, directory, either, exceptions, extra, filepath, formatting, hashable, hspec, lens, mtl, optparse-applicative, parsec, quickcheck-instances, safecopy, scientific, semigroups, serokell-util, template-haskell, text, text-format, time-units, transformers, unordered-containers, vector, yaml

Files

• LICENSE +21/−0
• Setup.hs +2/−0
• serokell-util.cabal +131/−0
• src/Serokell/AcidState.hs +10/−0
• src/Serokell/AcidState/ExtendedState.hs +79/−0
• src/Serokell/AcidState/Instances.hs +31/−0
• src/Serokell/AcidState/Statistics.hs +36/−0
• src/Serokell/AcidState/Util.hs +56/−0
• src/Serokell/Aeson/Options.hs +59/−0
• src/Serokell/Arbitrary.hs +91/−0
• src/Serokell/Data/Memory/Units.hs +140/−0
• src/Serokell/Data/Variant.hs +14/−0
• src/Serokell/Data/Variant/Class.hs +31/−0
• src/Serokell/Data/Variant/Helpers.hs +21/−0
• src/Serokell/Data/Variant/Serialization.hs +148/−0
• src/Serokell/Data/Variant/Variant.hs +73/−0
• src/Serokell/Util.hs +17/−0
• src/Serokell/Util/Base16.hs +39/−0
• src/Serokell/Util/Base64.hs +74/−0
• src/Serokell/Util/Bench.hs +74/−0
• src/Serokell/Util/Binary.hs +17/−0
• src/Serokell/Util/Common.hs +72/−0
• src/Serokell/Util/Concurrent.hs +14/−0
• src/Serokell/Util/Exceptions.hs +56/−0
• src/Serokell/Util/I18N.hs +63/−0
• src/Serokell/Util/Lens.hs +27/−0
• src/Serokell/Util/OptParse.hs +30/−0
• src/Serokell/Util/Parse.hs +9/−0
• src/Serokell/Util/Parse/Base64.hs +27/−0
• src/Serokell/Util/Parse/Common.hs +54/−0
• src/Serokell/Util/Parse/Network.hs +117/−0
• src/Serokell/Util/StaticAssert.hs +14/−0
• src/Serokell/Util/Text.hs +244/−0
• src/Serokell/Util/Verify.hs +52/−0
• test/Spec.hs +1/−0
• test/Test.hs +5/−0
• test/Test/Serokell/Data/Memory/UnitsSpec.hs +31/−0
• test/Test/Serokell/Data/Variant/VariantSpec.hs +103/−0
• test/Test/Serokell/Util/ByteStringSpec.hs +44/−0
• test/Test/Serokell/Util/CommonSpec.hs +83/−0
• test/Test/Serokell/Util/TextSpec.hs +38/−0

@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2016 Serokell++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,131 @@+name:                serokell-util+version:             0.1.1+synopsis:            General-purpose functions by Serokell+homepage:            http://gitlab.serokell.io/serokell-team/serokell-util+license:             MIT+license-file:        LICENSE+category:            Utils+author:              Serokell+maintainer:          Serokell <hi@serokell.io>+copyright:           2016 Serokell+build-type:          Simple+description:         Serokell-util is a library consisting of functions, which+                     are not included in standard libraries, but are useful for+                     multiple projects. This library was created when it was+                     found that in new projects we need to use some utility+                     functions from existing projects and don't want to+                     copy-paste them.+-- extra-source-files:+cabal-version:       >=1.10++library+  exposed-modules:     Serokell.AcidState+                       Serokell.AcidState.ExtendedState+                       Serokell.AcidState.Instances+                       Serokell.AcidState.Statistics+                       Serokell.AcidState.Util+                       Serokell.Arbitrary+                       Serokell.Aeson.Options+                       Serokell.Data.Memory.Units+                       Serokell.Data.Variant+                       Serokell.Util+                       Serokell.Util.Base16+                       Serokell.Util.Base64+                       Serokell.Util.Bench+                       Serokell.Util.Binary+                       Serokell.Util.Common+                       Serokell.Util.Concurrent+                       Serokell.Util.I18N+                       Serokell.Util.Parse+                       Serokell.Util.OptParse+                       Serokell.Util.Exceptions+                       Serokell.Util.Lens+                       Serokell.Util.StaticAssert+                       Serokell.Util.Text+                       Serokell.Util.Verify+  other-modules:       Serokell.Data.Variant.Class+                       Serokell.Data.Variant.Helpers+                       Serokell.Data.Variant.Serialization+                       Serokell.Data.Variant.Variant+                       Serokell.Util.Parse.Base64+                       Serokell.Util.Parse.Common+                       Serokell.Util.Parse.Network+  build-depends:       QuickCheck >= 2.8.1+                     , acid-state+                     , aeson+                     , aeson-extra+                     , base >= 4.8 && < 5+                     , base16-bytestring+                     , base64-bytestring+                     , binary+                     , binary-orphans+                     , bytestring+                     , cereal+                     , cereal-vector+                     , containers+                     , clock+                     , data-msgpack >= 0.0.8+                     , deepseq+                     , directory+                     , either+                     , exceptions+                     , extra+                     , filepath+                     , formatting+                     , hashable >= 1.2.4.0+                     , lens+                     , mtl+                     , optparse-applicative+                     , parsec+                     , quickcheck-instances+                     , safecopy >= 0.9.0.1+                     , scientific+                     , semigroups+                     , template-haskell+                     , text+                     , text-format+                     , time-units+                     , transformers+                     , unordered-containers >= 0.2.7.0+                     , vector+                     , yaml+  hs-source-dirs:      src+  default-language:    Haskell2010+  ghc-options:         -Wall -fno-warn-orphans+  default-extensions:  OverloadedStrings+                     , RecordWildCards+                     , DeriveDataTypeable+                     , GeneralizedNewtypeDeriving++test-suite serokell-test+  main-is:             Test.hs+  other-modules:       Test.Serokell.Data.Memory.UnitsSpec+                       Test.Serokell.Data.Variant.VariantSpec+                       Test.Serokell.Util.CommonSpec+                       Test.Serokell.Util.ByteStringSpec+                       Test.Serokell.Util.TextSpec+                       Spec+  type:                exitcode-stdio-1.0+  build-depends:       aeson+                     , base >=4.8+                     , binary+                     , bytestring+                     , cereal+                     , hspec >= 2.1.10+                     , data-msgpack >= 0.0.8+                     , QuickCheck >= 2.8.1+                     , quickcheck-instances+                     , safecopy >= 0.9.0.1+                     , scientific+                     , serokell-util+                     , text+                     , text-format+                     , unordered-containers >= 0.2.7.0+                     , vector+  hs-source-dirs:      test+  default-language:    Haskell2010+  ghc-options:         -threaded -Wall -fno-warn-orphans+  default-extensions:  OverloadedStrings+                     , RecordWildCards+                     , DeriveDataTypeable+                     , GeneralizedNewtypeDeriving

@@ -0,0 +1,10 @@+-- | Re-export Serokell.AcidState.* modules.++module Serokell.AcidState+       (+         module Exports+       ) where++import           Serokell.AcidState.ExtendedState as Exports+import           Serokell.AcidState.Instances     ()+import           Serokell.AcidState.Util          as Exports

@@ -0,0 +1,79 @@+{-# LANGUAGE TypeFamilies #-}++-- | The idea of ExtendedState is to store information about location+-- of the state (either FilePath or memory).++module Serokell.AcidState.ExtendedState+       ( ExtendedState (..)+       , closeExtendedState+       , extendedStateToAcid+       , openLocalExtendedState+       , openMemoryExtendedState+       , queryExtended+       , tidyExtendedState+       , updateExtended+       ) where++import           Control.Monad.Extra     (whenM)+import           Control.Monad.Trans     (MonadIO (liftIO))+import           Data.Acid               (AcidState, EventResult, EventState, IsAcidic,+                                          QueryEvent, UpdateEvent, closeAcidState,+                                          openLocalStateFrom)+import           Data.Acid.Advanced      (query', update')+import           Data.Acid.Memory        (openMemoryState)+import           Data.Typeable           (Typeable)++import           System.Directory        (doesDirectoryExist, removeDirectoryRecursive)++import           Serokell.AcidState.Util (tidyLocalState)++-- | ExtendedState is like usual AcidState, but also stores+-- information about FilePath (unless it's in memory).+data ExtendedState st+    = ESLocal (AcidState st)+              FilePath+    | ESMemory (AcidState st)++-- | Convert ExtendedState to AcidState.+extendedStateToAcid :: ExtendedState st -> AcidState st+extendedStateToAcid (ESLocal s _) = s+extendedStateToAcid (ESMemory s)  = s++-- | Like query', but works on ExtendedState.+queryExtended+    :: (EventState event ~ st, QueryEvent event, MonadIO m)+    => ExtendedState st -> event -> m (EventResult event)+queryExtended st = query' (extendedStateToAcid st)++-- | Like update', but works on ExtendedState.+updateExtended+    :: (EventState event ~ st, UpdateEvent event, MonadIO m)+    => ExtendedState st -> event -> m (EventResult event)+updateExtended st = update' (extendedStateToAcid st)++-- | Like openLocalStateFrom, but returns ExtendedState and operates+-- in MonadIO.+openLocalExtendedState+    :: (IsAcidic st, Typeable st, MonadIO m)+    => Bool -> FilePath -> st -> m (ExtendedState st)+openLocalExtendedState deleteIfExists fp st = do+    whenM ((deleteIfExists &&) <$> liftIO (doesDirectoryExist fp)) $+        liftIO $ removeDirectoryRecursive fp+    liftIO $ flip ESLocal fp <$> openLocalStateFrom fp st++-- | Like openMemoryState, but returns ExtendedState and operates in+-- MonadIO.+openMemoryExtendedState+    :: (IsAcidic st, Typeable st, MonadIO m)+    => st -> m (ExtendedState st)+openMemoryExtendedState st = liftIO $ ESMemory <$> openMemoryState st++-- | Like closeAcidState, but operates on ExtendedState and in+-- MonadIO.+closeExtendedState :: MonadIO m => ExtendedState st -> m ()+closeExtendedState = liftIO . closeAcidState . extendedStateToAcid++-- | Like tidyLocalState, but operates on ExtendedState.+tidyExtendedState :: MonadIO m => ExtendedState st -> m ()+tidyExtendedState (ESLocal st fp) = tidyLocalState st fp+tidyExtendedState (ESMemory _)    = return ()

@@ -0,0 +1,31 @@+-- | Helper instances for Acid State to remove boilerplate and introduce+-- redundant instances for other data types.++module Serokell.AcidState.Instances where++import           Control.Exception   (throw)+import           Control.Monad.Catch (MonadThrow (throwM))++import           Data.Acid           (Query, Update)+import           Data.Hashable       (Hashable)+import           Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HM hiding (HashMap)+import           Data.HashSet        (HashSet)+import qualified Data.HashSet        as HS hiding (HashSet)+import           Data.SafeCopy       (SafeCopy (getCopy, putCopy), contain,+                                      safeGet, safePut)++-- | Usually Queries shouldn't throw anything. This is a dirty hack.+instance MonadThrow (Query s) where+    throwM = throw++instance MonadThrow (Update s) where+    throwM = throw++instance (Eq a, Hashable a, SafeCopy a) => SafeCopy (HashSet a) where+    putCopy = contain . safePut . HS.toList+    getCopy = contain $ HS.fromList <$> safeGet++instance (Eq a, Hashable a, SafeCopy a, SafeCopy b) => SafeCopy (HashMap a b) where+    putCopy = contain . safePut . HM.toList+    getCopy = contain $ HM.fromList <$> safeGet

@@ -0,0 +1,36 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE Rank2Types                #-}++-- | Collect statistics about acid-state database.++module Serokell.AcidState.Statistics+       ( StoragePart (..)++       , estimateMemoryUsage+       ) where++import           Control.Lens               (Getter, (^.))+import qualified Data.ByteString            as BS (length)+import           Data.SafeCopy              (SafeCopy, safePut)+import           Data.Serialize.Put         (runPut)+import           Data.Text                  (Text)++import           Serokell.Data.Memory.Units (MemoryUnit, fromBytes)++type PartName = Text++data StoragePart storage = forall part. SafeCopy part =>+                                        StoragePart+    { spName   :: PartName+    , spGetter :: Getter storage part+    }++estimateMemoryUsage+    :: MemoryUnit unit+    => [StoragePart s] -> s -> [(PartName, unit)]+estimateMemoryUsage parts storage = map processPart parts+  where+    processPart StoragePart{..} =+        ( spName+        , fromBytes . toInteger . BS.length . runPut . safePut . (storage ^.) $+          spGetter)

@@ -0,0 +1,56 @@+-- | Some useful functions to work with Data.Acid.++module Serokell.AcidState.Util+       (+         -- | Simple helpers+         exceptStateToUpdate+       , exceptStateToUpdateGeneric+       , readerToQuery+       , stateToUpdate++         -- | Utilities+       , createAndDiscardArchive+       , tidyLocalState+       ) where++import           Control.Exception    (Exception, throw)+import           Control.Monad.Except (ExceptT, runExceptT)+import           Control.Monad.Reader (Reader, asks, runReader)+import           Control.Monad.State  (State, runState, state)+import           Control.Monad.Trans  (MonadIO (liftIO))+import           Data.Acid            (AcidState, Query, Update, createArchive,+                                       createCheckpoint)+import           System.Directory     (removeDirectoryRecursive)+import           System.FilePath      ((</>))++readerToQuery :: Reader s a -> Query s a+readerToQuery = asks . runReader++stateToUpdate :: State s a -> Update s a+stateToUpdate = state . runState++exceptStateToUpdate+    :: (Exception e)+    => ExceptT e (State s) a -> Update s a+exceptStateToUpdate = exceptStateToUpdateGeneric id++exceptStateToUpdateGeneric+  :: (Exception exc)+  => (e -> exc) -> ExceptT e (State s) a -> Update s a+exceptStateToUpdateGeneric toException u =+    state $+    runState $+    do res <- runExceptT u+       either (throw . toException) return res++-- | Archive unnecessary data (see createArchive docs for details) and+-- discard it. Works for local state.+createAndDiscardArchive :: MonadIO m => AcidState st -> FilePath -> m ()+createAndDiscardArchive st path =+    liftIO $ createArchive st >> removeDirectoryRecursive (path </> "Archive")++-- | Apply all updates and remove all data from local state which is+-- unnecessary for state restoration.+tidyLocalState :: MonadIO m => AcidState st -> FilePath -> m ()+tidyLocalState st path =+    liftIO (createCheckpoint st) >> createAndDiscardArchive st path

@@ -0,0 +1,59 @@+-- | Options used to derive FromJSON/ToJSON instance. These options+-- generally comply to our style regarding names. Of course sometimes+-- they don't fit one's needs, so treat them as just sensible+-- defaults.++module Serokell.Aeson.Options+       ( defaultOptions+       , leaveTagOptions+       , defaultOptionsPS+       ) where++import qualified Data.Aeson.TH as A+import           Data.Char     (isLower, isPunctuation, isUpper, toLower)+import           Data.List     (findIndex)++headToLower :: String -> String+headToLower []     = undefined+headToLower (x:xs) = toLower x : xs++stripFieldPrefix :: String -> String+stripFieldPrefix = dropWhile (not . isUpper)++dropPunctuation :: String -> String+dropPunctuation = filter (not . isPunctuation)++stripConstructorPrefix :: String -> String+stripConstructorPrefix t =+    maybe t (flip drop t . decrementSafe) $ findIndex isLower t+  where+    decrementSafe 0 = 0+    decrementSafe i = i - 1++-- | These options do the following transformations:+-- 1. Names of field+-- records are assumed to be camelCased, `camel` part is removed,+-- `Cased` part is converted to `cased`. So `camelCased` becomes+-- `cased`. Also all punctuation symbols are dropped before doing it.+-- 2. Constructors are assumed to start with some capitalized prefix+-- (which finished right before the last capital letter). This prefix+-- is dropped and then the first letter is lowercased.+defaultOptions :: A.Options+defaultOptions =+    A.defaultOptions+    { A.fieldLabelModifier = headToLower . stripFieldPrefix . dropPunctuation+    , A.constructorTagModifier = headToLower . stripConstructorPrefix+    , A.sumEncoding = A.ObjectWithSingleField+    }++-- | These options are the same as `defaultOptions`, but they don't+-- modify constructor tags.+leaveTagOptions :: A.Options+leaveTagOptions = defaultOptions { A.constructorTagModifier = id }++-- | Options used for communication with PureScript by default.+defaultOptionsPS :: A.Options+defaultOptionsPS =+    A.defaultOptions+    { A.constructorTagModifier = headToLower . stripConstructorPrefix+    }

@@ -0,0 +1,91 @@+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell    #-}++-- | Arbitrary instances for Serokell datatypes+module Serokell.Arbitrary+       ( VariantNoBytes (..)+       , VariantOnlyBytes (..)+       ) where++import           Data.ByteString               as BS hiding (zip)+import qualified Data.HashMap.Lazy             as H (fromList)+import           Data.Vector                   (fromList)+import           GHC.Generics                  (Generic)+import           Test.QuickCheck               (Arbitrary (..), Gen, choose,+                                                genericShrink, frequency, oneof,+                                                sized)+import           Test.QuickCheck.Instances     ()++import           Serokell.Data.Variant.Variant (Variant (..))+import qualified Serokell.Util.Base64          as S++instance Arbitrary S.JsonByteString where+    arbitrary = S.JsonByteString <$> (arbitrary :: Gen BS.ByteString)++newtype VariantNoBytes = NoBytes+    { getVariant :: Variant+    } deriving (Show, Eq, Generic)++newtype VariantOnlyBytes = OnlyBytes+    { getVarBytes :: Variant+    } deriving (Show, Eq, Generic)++instance Arbitrary VariantOnlyBytes where+    arbitrary = OnlyBytes . VarBytes <$> arbitrary+    shrink = genericShrink++instance Arbitrary VariantNoBytes where+    arbitrary = NoBytes <$> (sized $ \n -> genVariant (n*50 + 1))+    shrink = genericShrink++instance Arbitrary Variant where+    arbitrary = sized $ \n -> genVariant (n*50 + 1)+    shrink = genericShrink++-- | Generate something with at most N constructors. Say how many constructors+-- actually are in the generated 'Variant'. Because encoding 'VarBytes' into+-- JSON and then decoding it presents a problem - it becomes a 'VarString',+-- and it is difficult to tell whether it was decoded from a 'VarBytes' or+-- another 'VarString' - this generating function won't generate this+-- constructor unless given a true boolean flag.+genVariant :: Int -> Gen Variant+genVariant 1 = genFlatVariant+genVariant n = do+    frequency+        -- No reason for “3”, it just works well.+        [ (3, genFlatVariant)+        -- The more constructors we have to generate, the more likely we are+        -- to choose something nested instead of something flat.+        , (truncate (logBase 2 (fromIntegral n) :: Double),+             oneof [genListVariant n, genMapVariant n])+        ]++genFlatVariant :: Gen Variant+genFlatVariant = oneof $+    [ pure VarNone+    , VarBool <$> arbitrary+    , VarInt <$> arbitrary+    , VarUInt <$> arbitrary+    , VarFloat <$> arbitrary+    , VarString <$> arbitrary+    ]++-- | Generate a list of variants, using at most N constructors in total.+genBoundedVariants :: Int -> Gen [Variant]+genBoundedVariants 0 = return []+genBoundedVariants n = do+    v_cons <- choose (1, n)+    (:) <$> genVariant v_cons+        <*> genBoundedVariants (n-v_cons)++genListVariant :: Int -> Gen Variant+genListVariant n = VarList . fromList <$> genBoundedVariants (n-1)++genMapVariant :: Int -> Gen Variant+genMapVariant n = do+    keys <- genBoundedVariants ((n-1) `div` 2)+    vals <- genBoundedVariants ((n-1) `div` 2)+    -- Lengths of keys and vals may not match and so we would get less+    -- constructors due to truncation, but we don't care.+    return $ VarMap $ H.fromList $ zip keys vals

@@ -0,0 +1,140 @@+{-# LANGUAGE DeriveGeneric       #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE Rank2Types          #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns        #-}++-- | Memory units.++module Serokell.Data.Memory.Units+       (+         -- | Type class+         MemoryUnit (..)++         -- | Concrete types+       , Byte+       , Kilobyte+       , Megabyte+       , Gigabyte+       , Terabyte++         -- | Pretty printing+       , unitBuilder+       , memory++         -- | Helpers+       , toBytes+       , fromBytes+       , convertUnit+       ) where++import           Data.Binary            (Binary)+import           Data.Proxy             (Proxy (Proxy))+import           Data.SafeCopy          (SafeCopy)+import           Data.Serialize         (Serialize)+import           Data.Text.Lazy.Builder (Builder)+import           Data.Typeable          (Typeable)+import           Formatting             (bprint, stext, (%))+import qualified Formatting             as Fmt+import           GHC.Generics           (Generic)++import           Serokell.Util.Text     (showFixedPretty')++import           Test.QuickCheck        (Arbitrary)++class Integral unit => MemoryUnit unit  where+    -- | This value is n iff (1 :: unit) is n bytes.+    bytesMultiplier :: Proxy unit -> Integer++-- | Convert given memory unit into integer representing bytes.+toBytes+    :: forall unit.+       MemoryUnit unit+    => unit -> Integer+toBytes mu = toInteger mu * bytesMultiplier proxy+  where+    proxy :: Proxy unit+    proxy = Proxy++-- | Convert given number of bytes into memory unit, flooring value if+-- necessary.+fromBytes+    :: forall unit.+       MemoryUnit unit+    => Integer -> unit+fromBytes bytes = fromInteger $ bytes `div` bytesMultiplier proxy+  where+    proxy :: Proxy unit+    proxy = Proxy++-- | Conversion between memory units.+convertUnit :: (MemoryUnit a, MemoryUnit b) => a -> b+convertUnit = fromBytes . toBytes++-- | Construct Text Builder.+unitBuilder :: MemoryUnit unit => unit -> Builder+unitBuilder n@(toBytes -> bytes)+  | bytes == 0 = "0"+  | bytes < 0 = mconcat ["-", unitBuilder n]+  | otherwise = bprint (stext % " " % stext) (showFixedPretty' 3 value) suffix+  where+    suffixes = ["B", "KiB", "MiB", "GiB", "TiB", "Pib", "EiB", "ZiB", "YiB"]+    bytesDouble :: Double+    bytesDouble = realToFrac bytes+    order = min (length suffixes - 1) (floor $ logBase 2 bytesDouble / 10)+    suffix = suffixes !! order+    value = bytesDouble / realToFrac ((2 :: Integer) ^ (order * 10))++-- | Formatter for `formatting` library.+memory :: MemoryUnit unit => Fmt.Format r (unit -> r)+memory = Fmt.later unitBuilder++pow10 :: Num n => Int -> n+pow10 = (10 ^)++newtype Byte =+    Byte Integer+    deriving (Show,Eq,Num,Typeable,Integral,Real,Enum,Ord,Generic,Serialize,Binary, Arbitrary)++instance SafeCopy Byte++instance MemoryUnit Byte where+    bytesMultiplier Proxy = pow10 0++newtype Kilobyte =+    Kilobyte Integer+    deriving (Show,Eq,Num,Typeable,Integral,Real,Enum,Ord,Generic,Serialize,Arbitrary)++instance SafeCopy Kilobyte++instance MemoryUnit Kilobyte where+    bytesMultiplier Proxy = pow10 3++-- P. S. Feel free to add more.++newtype Megabyte =+    Megabyte Integer+    deriving (Show,Eq,Num,Typeable,Integral,Real,Enum,Ord,Generic,Serialize,Arbitrary)++instance SafeCopy Megabyte++instance MemoryUnit Megabyte where+    bytesMultiplier Proxy = pow10 6++newtype Gigabyte =+    Gigabyte Integer+    deriving (Show,Eq,Num,Typeable,Integral,Real,Enum,Ord,Generic,Serialize,Arbitrary)++instance SafeCopy Gigabyte++instance MemoryUnit Gigabyte where+    bytesMultiplier Proxy = pow10 9++newtype Terabyte =+    Terabyte Integer+    deriving (Show,Eq,Num,Typeable,Integral,Real,Enum,Ord,Generic,Serialize,Arbitrary)++instance SafeCopy Terabyte++instance MemoryUnit Terabyte where+    bytesMultiplier Proxy = pow10 12

@@ -0,0 +1,14 @@+-- | Variant is a data type with dynamic structure. It's designed to+-- be very generic, but also efficient. You can choose whatever data+-- layout you want. This module re-exports modules relevant to this+-- type.++module Serokell.Data.Variant+       (+         module Export+       ) where++import           Serokell.Data.Variant.Class         as Export+import           Serokell.Data.Variant.Helpers       as Export+import           Serokell.Data.Variant.Serialization ()+import           Serokell.Data.Variant.Variant       as Export

@@ -0,0 +1,31 @@+-- | Type class for values which can be converted to/from Variant.+-- Also contains some instances.++module Serokell.Data.Variant.Class+       ( ToVariant (toVariant)+       , FromVariant (fromVariant)+       ) where++import           Control.Monad.Catch           (MonadThrow)+import           Formatting                    (build, sformat, (%))++import           Serokell.Data.Variant.Variant (Variant (..))+import           Serokell.Util.Exceptions      (throwText)++class ToVariant v where+    toVariant :: v -> Variant++class FromVariant v where+    -- TODO: it won't be used now, so I didn't think much about this type.+    -- Maybe it's not the best idea to use MonadThrow here.+    fromVariant :: MonadThrow m => Variant -> m v++instance ToVariant Bool where+    toVariant = VarBool++instance ToVariant Double where+    toVariant = VarFloat++instance FromVariant Double where+    fromVariant (VarFloat v) = pure v+    fromVariant v = throwText $ sformat ("value is not Double: " % build) v

@@ -0,0 +1,21 @@+-- | Helper functions for convenient work with Variant. Feel free to+-- add more if you need.++module Serokell.Data.Variant.Helpers+       ( none+       , varMap+       ) where++import           Data.Foldable                 (Foldable (toList))+import qualified Data.HashMap.Strict           as HM hiding (HashMap)++import           Serokell.Data.Variant.Variant (Variant (..))++-- | Shorter alias for VarNone.+none :: Variant+none = VarNone++-- | Create VarMap from Foldable containing pairs of Variants.+-- TODO: maybe use better approach like `a := b` to create KeyValuePair.+varMap :: Foldable t => t (Variant, Variant) -> Variant+varMap = VarMap . HM.fromList . toList

@@ -0,0 +1,148 @@+{-# LANGUAGE TupleSections #-}++-- | This module contains serialization logic for Variant type.+-- Feel free to add serialization to/from other formats if you need it.++module Serokell.Data.Variant.Serialization+       (+       ) where++import qualified Data.Aeson                    as Aeson+import           Data.Bifunctor                (bimap)+import           Data.Binary                   (Binary)+import           Data.Binary.Orphans           ()+import           Data.Hashable                 (Hashable)+import           Data.HashMap.Strict           (HashMap)+import qualified Data.HashMap.Strict           as HM hiding (HashMap)+import qualified Data.MessagePack              as MP+import           Data.SafeCopy                 (SafeCopy)+import           Data.Scientific               (floatingOrInteger)+import qualified Data.Serialize                as Cereal+import           Data.Text                     (Text)+import qualified Data.Text.Encoding            as TE+import qualified Data.Vector                   as V+import           Data.Vector.Serialize         ()++import           Serokell.Data.Variant.Variant (VarMap, Variant (..))+import           Serokell.Util.Base64          (JsonByteString (JsonByteString))+import           Serokell.Util.Text            (show')++--  —————————JSON serialization————————— --+-- Since there is no bijection between Variant and JSON Value, there are some+-- non-trivial things:+-- 1. decode . encode ≠ id. For example, (decode . encode) for VarBytes+--    will return VarString.+-- 2. Bytes are encoded in base64 encoding.+-- 3. If map contains key which is not a string, this key is converted to+--    string using Buildable instance. Usually you should avoid JSON+--    serialization for such maps.+-- 4. For numbers there is smart deserialization which tries to guess right+--    type (signed int/unsigned int/float).+--    If number is floating, VarFloat will be returned. For integer values+--    result type depends on sign (negative ⇒ Int, otherwise UInt).++varMapToObject :: VarMap -> Aeson.Object+varMapToObject = HM.fromList . map (bimap show' Aeson.toJSON) . HM.toList++instance Aeson.ToJSON Variant where+    toJSON VarNone       = Aeson.Null+    toJSON (VarBool v)   = Aeson.toJSON v+    toJSON (VarInt v)    = Aeson.toJSON v+    toJSON (VarUInt v)   = Aeson.toJSON v+    toJSON (VarFloat v)  = Aeson.toJSON v+    toJSON (VarBytes v)  = Aeson.toJSON . JsonByteString $ v+    toJSON (VarString v) = Aeson.toJSON v+    toJSON (VarList v)   = Aeson.toJSON v+    toJSON (VarMap v)    = Aeson.Object . varMapToObject $ v+    toEncoding VarNone       = Aeson.toEncoding Aeson.Null+    toEncoding (VarBool v)   = Aeson.toEncoding v+    toEncoding (VarInt v)    = Aeson.toEncoding v+    toEncoding (VarUInt v)   = Aeson.toEncoding v+    toEncoding (VarFloat v)  = Aeson.toEncoding v+    toEncoding (VarBytes v)  = Aeson.toEncoding . JsonByteString $ v+    toEncoding (VarString v) = Aeson.toEncoding v+    toEncoding (VarList v)   = Aeson.toEncoding v+    toEncoding (VarMap v)    = Aeson.toEncoding . varMapToObject $ v++instance Aeson.FromJSON Variant where+    parseJSON Aeson.Null = pure VarNone+    parseJSON (Aeson.Bool v) = pure . VarBool $ v+    parseJSON (Aeson.Number v) =+        pure . either VarFloat convertInt . floatingOrInteger $ v+      where+        convertInt :: Integer -> Variant+        convertInt i+          | i < 0 = VarInt $ fromIntegral i+          | otherwise = VarUInt $ fromIntegral i+    parseJSON (Aeson.String v) = pure . VarString $ v+    parseJSON (Aeson.Array v) = fmap VarList . mapM Aeson.parseJSON $ v+    parseJSON (Aeson.Object v) =+        fmap (VarMap . HM.fromList) .+        mapM+            (\(key,val) ->+                  (VarString key, ) <$> Aeson.parseJSON val) .+        HM.toList $+        v++--  —————————Cereal and SafeCopy serialization————————— --+-- This serialization is very simple: first byte is tag followed by actual value.+-- `decode . encode` should be `id`.++-- TODO: move it somewhere??+instance Cereal.Serialize Text where+    put = Cereal.put . TE.encodeUtf8+    get = TE.decodeUtf8 <$> Cereal.get++instance (Eq a, Hashable a, Cereal.Serialize a, Cereal.Serialize b) =>+         Cereal.Serialize (HashMap a b) where+    put = Cereal.put . HM.toList+    get = HM.fromList <$> Cereal.get++instance Cereal.Serialize Variant++instance SafeCopy Variant++--  —————————MessagePack serialization————————— --+-- MessagePack data structure is very close to Variant. However, note that:+-- 1. We are using strange library where Object type doesn't cover all+--    possible objects. For example, there is only `Int` for integers.+--    So every integer number is converted to `Int` (which may be imprecise).+--    Decoding checks sign of input (like JSON).+-- 2. MessagePack distinguishes between Float and Double while we don't.+-- 3. ObjectExt can't be decoded.++instance MP.MessagePack Variant where+    toObject VarNone = MP.ObjectNil+    toObject (VarBool v) = MP.ObjectBool v+    toObject (VarInt v) = MP.ObjectInt $ fromIntegral v+    toObject (VarUInt v) = MP.ObjectInt $ fromIntegral v+    toObject (VarFloat v) = MP.ObjectDouble v+    toObject (VarBytes v) = MP.ObjectBin v+    toObject (VarString v) = MP.ObjectStr v+    toObject (VarList v) = MP.ObjectArray . fmap MP.toObject . V.toList $ v+    toObject (VarMap v) =+        MP.ObjectMap .+        fmap (bimap MP.toObject MP.toObject) . HM.toList $+        v+    fromObject MP.ObjectNil = pure VarNone+    fromObject (MP.ObjectBool v) = pure . VarBool $ v+    fromObject (MP.ObjectInt v) | v < 0 = pure . VarInt . fromIntegral $ v+                                | otherwise = pure . VarUInt . fromIntegral $ v+    fromObject (MP.ObjectFloat v) = pure . VarFloat . realToFrac $ v+    fromObject (MP.ObjectDouble v) = pure . VarFloat $ v+    fromObject (MP.ObjectStr v) = pure . VarString $ v+    fromObject (MP.ObjectBin v) = pure . VarBytes $ v+    fromObject (MP.ObjectArray v) = fmap (VarList . V.fromList)+                                  . mapM MP.fromObject+                                  $ v+    fromObject (MP.ObjectMap v) =+        fmap (VarMap . HM.fromList) .+        mapM+            (\(a,b) ->+                  (,) <$> MP.fromObject a <*> MP.fromObject b) $+        v+    fromObject (MP.ObjectExt _ _) = fail "Can't deserialize ObjectExt"++--  —————————Binary serialization————————— --+-- Here we use Generic support, it should be good enough.+instance Binary Variant

@@ -0,0 +1,73 @@+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies      #-}++-- | Variant type.++module Serokell.Data.Variant.Variant+       ( Variant (..)+       , VarList+       , VarMap+       ) where++import           Control.DeepSeq      (NFData)+import           Data.ByteString      (ByteString)+import           Data.Hashable        (Hashable (hashWithSalt))+import           Data.HashMap.Strict  (HashMap)+import qualified Data.HashMap.Strict  as HM hiding (HashMap)+import           Data.Int             (Int64)+import           Data.String          (IsString (fromString))+import           Data.Text            (Text)+import           Data.Text.Buildable  (Buildable (build))+import           Data.Vector          (Vector)+import qualified Data.Vector          as V hiding (Vector)+import           Data.Word            (Word64)+import           GHC.Exts             (IsList (..))+import           GHC.Generics         (Generic)++import qualified Serokell.Util.Base16 as B16+import           Serokell.Util.Text   (listBuilderJSONIndent, mapBuilder)++type VarList = Vector Variant+type VarMap = HashMap Variant Variant++-- | Variant is intended to store arbitrary data in arbitrary+-- format. You are free to choose data layout.+data Variant+    = VarNone               -- ^ None, i. e. no value.+    | VarBool !Bool         -- ^ Boolean value.+    | VarInt !Int64         -- ^ Signed integer number.+    | VarUInt !Word64       -- ^ Unsigned integer number.+    | VarFloat !Double      -- ^ IEEE 754 double precision floating point number.+    | VarBytes !ByteString  -- ^ Raw bytes.+    | VarString !Text       -- ^ Unicode string.+    | VarList !VarList      -- ^ List of Variants.+    | VarMap !VarMap        -- ^ Map (with unique keys) from Variant to Variant.+    deriving (Show,Eq,Generic)++instance Buildable Variant where+    build VarNone       = "None"+    build (VarBool v)   = build v+    build (VarInt v)    = build v+    build (VarUInt v)   = build v+    build (VarFloat v)  = build v+    build (VarBytes v)  = build . B16.encode $ v+    build (VarString v) = build v+    build (VarList v)   = listBuilderJSONIndent 2 v+    build (VarMap v)    = mapBuilder . HM.toList $ v++instance Hashable (Vector Variant) where+    hashWithSalt salt = V.foldr' (flip hashWithSalt) (hashWithSalt salt ())++instance Hashable Variant++instance IsString Variant where+    fromString = VarString . fromString++instance IsList Variant where+    type Item Variant = Variant+    toList (VarList v) = toList v+    toList _           = error "toList: not a list"+    fromList = VarList . fromList++instance NFData Variant

@@ -0,0 +1,17 @@+-- | Re-export everything from Serokell.Util.*++module Serokell.Util+       (+         module Exports+       ) where++import           Serokell.Util.Bench        as Exports+import           Serokell.Util.Binary       as Exports+import           Serokell.Util.Common       as Exports+import           Serokell.Util.Concurrent   as Exports+import           Serokell.Util.Exceptions   as Exports+import           Serokell.Util.Lens         as Exports+import           Serokell.Util.OptParse     as Exports+import           Serokell.Util.StaticAssert as Exports+import           Serokell.Util.Text         as Exports+import           Serokell.Util.Verify       as Exports

@@ -0,0 +1,39 @@+-- | Base16 encoding/decoding.++module Serokell.Util.Base16+       ( encode+       , decode+       , formatBase16+       , base16F+       ) where++import qualified Data.ByteString        as BS+import qualified Data.ByteString.Base16 as B16+import qualified Data.Text              as T+import qualified Data.Text.Encoding     as TE+import           Data.Text.Lazy.Builder (Builder, fromText)+import           Formatting             (Format, later, sformat, stext, (%))++-- | Apply base16 encoding to strict ByteString.+encode :: BS.ByteString -> T.Text+encode = TE.decodeUtf8 . B16.encode++-- | Decode base16-encoded ByteString.+decode :: T.Text -> Either T.Text BS.ByteString+decode = handleError . B16.decode . TE.encodeUtf8+  where+    handleError (res,rest)+      | BS.null rest = pure res+      | otherwise =+          Left $+          sformat+              ("suffix is not in base-16 format: " % stext)+              (TE.decodeUtf8 rest)++-- | Construct Builder from bytestring formatting it in Base16.+formatBase16 :: BS.ByteString -> Builder+formatBase16 = fromText . encode++-- | Format which uses Base16 to print bytestring.+base16F :: Format r (BS.ByteString -> r)+base16F = later formatBase16

@@ -0,0 +1,74 @@+-- | Base64 encoding/decoding.++module Serokell.Util.Base64+       ( encode+       , decode+       , encodeUrl+       , decodeUrl+       , formatBase64+       , base64F+       , JsonByteString (..)+       , JsonByteStringDeprecated (..)+       ) where++import           Control.Monad              ((>=>))+import           Data.Aeson                 (FromJSON (parseJSON), ToJSON (toJSON))+import qualified Data.ByteString            as BS+import qualified Data.ByteString.Base64     as B64+import qualified Data.ByteString.Base64.URL as B64url+import           Data.Either.Combinators    (mapLeft)+import qualified Data.Text                  as T+import           Data.Text.Encoding         (decodeUtf8, encodeUtf8)+import           Data.Text.Lazy.Builder     (Builder, fromText)+import           Formatting                 (Format, later)++-- | Apply base64 encoding to strict ByteString.+encode :: BS.ByteString -> T.Text+encode = decodeUtf8 . B64.encode++-- | Decode base64-encoded ByteString.+decode :: T.Text -> Either T.Text BS.ByteString+decode = mapLeft T.pack . B64.decode . encodeUtf8++-- | Apply base64url encoding to strict ByteString.+encodeUrl :: BS.ByteString -> T.Text+encodeUrl = decodeUtf8 . B64url.encode++-- | Decode base64url-encoded ByteString.+decodeUrl :: T.Text -> Either T.Text BS.ByteString+decodeUrl = mapLeft T.pack . B64url.decode . encodeUtf8++-- | Construct Builder from bytestring formatting it in Base64.+formatBase64 :: BS.ByteString -> Builder+formatBase64 = fromText . encode++-- | Format which uses Base64 to print bytestring.+base64F :: Format r (BS.ByteString -> r)+base64F = later formatBase64++-- | Wrapper on top of ByteString with JSON serialization (in base64+-- encoding).+newtype JsonByteString = JsonByteString+    { getJsonByteString :: BS.ByteString+    }++instance ToJSON JsonByteString where+    toJSON = toJSON . encode . getJsonByteString++instance FromJSON JsonByteString where+    parseJSON =+        parseJSON >=>+        either (fail . T.unpack) (pure . JsonByteString) . decode++------------ Deprecated--------------+newtype JsonByteStringDeprecated = JsonByteStringDeprecated+    { getJsonByteStringDeprecated :: BS.ByteString+    }++instance ToJSON JsonByteStringDeprecated where+    toJSON = toJSON . encodeUrl . getJsonByteStringDeprecated++instance FromJSON JsonByteStringDeprecated where+    parseJSON =+        parseJSON >=>+        either (fail . T.unpack) (pure . JsonByteStringDeprecated) . decodeUrl

@@ -0,0 +1,74 @@+-- | Benchmark related utils.++module Serokell.Util.Bench+       ( getWallTime+       , getCpuTime+       , ElapsedTime (..)+       , measureTime+       , measureTime_+       , perSecond+       ) where++import           Control.Monad.Trans (MonadIO (liftIO))+import           Data.Text.Buildable (Buildable (build))+import           Data.Time.Units     (Nanosecond, TimeUnit, convertUnit)+import           Formatting          (bprint, shown, (%))+import           System.Clock        (Clock (..), TimeSpec, diffTimeSpec,+                                      getTime, toNanoSecs)++-- | Get current wall-clock time as any time unit.+getWallTime :: (MonadIO m, TimeUnit a) => m a+getWallTime = timeSpecToUnit <$> getTime' Realtime++-- | Get current CPU time as any time unit.+getCpuTime :: (MonadIO m, TimeUnit a) => m a+getCpuTime = timeSpecToUnit <$> getTime' ProcessCPUTime++timeSpecToUnit+    :: TimeUnit a+    => TimeSpec -> a+timeSpecToUnit =+    convertUnit . (fromIntegral :: Integer -> Nanosecond) . toNanoSecs++-- | Data type describing time passed during execution of something.+data ElapsedTime = ElapsedTime+    { elapsedCpuTime  :: TimeSpec+    , elapsedWallTime :: TimeSpec+    } deriving (Show)++instance Buildable ElapsedTime where+    build ElapsedTime{..} =+        bprint+            ("(CPU time = " % shown % ", wall time = " % shown % ")")+            elapsedCpuTime+            elapsedWallTime++getTime' :: MonadIO m => Clock -> m TimeSpec+getTime' = liftIO . getTime++-- | Run given action and measure how much time it took.+measureTime :: MonadIO m => m a -> m (ElapsedTime, a)+measureTime action = do+    cpuTimeBefore <- getTime' ProcessCPUTime+    wallTimeBefore <- getTime' Realtime+    res <- action+    wallTimeAfter <- getTime' Realtime+    cpuTimeAfter <- getTime' ProcessCPUTime+    return+        ( ElapsedTime+          { elapsedCpuTime = cpuTimeAfter `diffTimeSpec` cpuTimeBefore+          , elapsedWallTime = wallTimeAfter `diffTimeSpec` wallTimeBefore+          }+        , res)++-- | Run given action and measure how much time it took, discarding+-- result of action.+measureTime_ :: MonadIO m => m a -> m ElapsedTime+measureTime_ = fmap fst . measureTime++-- | Given number of actions executed during some time, this function+-- calculates how much actions were executed per second (on average).+perSecond :: (Real a, Fractional b) => a -> TimeSpec -> b+perSecond n time =+    fromRational $+    toRational n / (fromIntegral (max 1 $ toNanoSecs time) * 1.0e9)

@@ -0,0 +1,17 @@+-- | Utilities for @Data.Binary@.++module Serokell.Util.Binary+       ( decodeFull+       ) where++import           Data.Binary (Binary, decodeOrFail)+import qualified Data.ByteString.Lazy as BSL+import           Data.ByteString.Lazy (ByteString)++-- | Like 'decode', but ensures that the whole input has been consumed.+decodeFull :: Binary a => ByteString -> Either String a+decodeFull bs = case decodeOrFail bs of+    Left (_, _, err) -> Left ("decodeFull: " ++ err)+    Right (unconsumed, _, a)+        | BSL.null unconsumed -> Right a+        | otherwise -> Left "decodeFull: unconsumed input"

@@ -0,0 +1,72 @@+-- | Common utilities.++module Serokell.Util.Common+       ( enumerate+       , indexModulo+       , indexModuloMay+       , indexedSubList+       , subList+       ) where++import           Control.Monad.State (evalState, get, modify)+import           Data.List           (genericDrop, genericIndex, genericLength,+                                      genericTake)+import           Data.Maybe          (fromMaybe)++-- | Enumerate function is analogous to python's enumerate. It+-- takes sequences of values and returns sequence of pairs where the+-- first element is index and the second one is corresponding value.+-- It's roughly equivalent to `zip [0..]`.+-- > enumerate "Hello" = [(0,'H'),(1,'e'),(2,'l'),(3,'l'),(4,'o')]+enumerate+    :: (Num i, Enum i, Traversable t)+    => t a -> t (i, a)+enumerate values = evalState action 0+  where+    action = mapM step values+    step v = do+        i <- get+        modify succ+        return (i, v)++-- | Returns element of a list with given index modulo length of+-- list. Raises error if list is empty.+-- Examples:+-- indexModulo [1, 2, 3] 10 = 2+-- indexModulo [1, 0] 2 = 1+-- indexModulo [] 199 = error+indexModulo :: Integral i => [a] -> i -> a+indexModulo xs =+    fromMaybe (error "Serokell.Util.Common.indexModulo: empty list") .+    indexModuloMay xs++-- | Behaves like `indexModulo` but uses Maybe to report error+-- (i. e. empty list).+indexModuloMay :: Integral i => [a] -> i -> Maybe a+indexModuloMay xs i = genericIndex xs <$> indexModuloIndex xs i++indexModuloIndex :: Integral i => [a] -> i -> Maybe i+indexModuloIndex [] _ = Nothing+indexModuloIndex xs i = Just $ i `mod` genericLength xs++-- | indexedSubList (lo, hi) returns sublist of given list with+-- indices in [max lo 0, hi). If the lower bound is negative,+-- 0 will in its place. If both indices are negative, the empty list+-- is returned.+-- Examples:+-- indexedSubList (2, 3) [0, 5, 10] = [(2, 10)]+-- indexedSubList (0, 2) [0, 5, 10] = [(0, 0), (1, 5)]+-- indexedSubList (0, 0) [0, 1, 11, 111] = []+-- indexedSubList (2000, 1000) [55, 47, 0, 1, 11, 111] = []+-- indexedSubList (-3, 3) [10, 11, 12, 13, 14] = [(0,10),(1,11),(2,12)]+-- indexedSubList (-6, -1) [1,2,3] = []+indexedSubList+    :: Integral i+    => (i, i) -> [a] -> [(i, a)]+indexedSubList (lo, hi)+    | hi <= lo = const []+    | otherwise = zip [max 0 lo .. hi - 1] . genericTake (hi - lo) . genericDrop lo++-- | Like indexedSubList, but not indexed :)+subList :: Integral i => (i, i) -> [a] -> [a]+subList range = map snd . indexedSubList range

@@ -0,0 +1,14 @@+-- | Convenient versions of some functions from `Control.Concurrent`++module Serokell.Util.Concurrent+       ( threadDelay+       ) where++import qualified Control.Concurrent  as Concurrent+import           Control.Monad.Trans (MonadIO (liftIO))+import           Data.Time.Units     (TimeUnit (toMicroseconds))++-- | Convenient version of Control.Concurrent.threadDelay which takes+-- any time-unit and operates in any MonadIO+threadDelay :: (MonadIO m, TimeUnit unit) => unit -> m ()+threadDelay = liftIO . Concurrent.threadDelay . fromIntegral . toMicroseconds

@@ -0,0 +1,56 @@+{-# LANGUAGE TypeFamilies  #-}+{-# LANGUAGE TypeOperators #-}++-- | Bitgram's general-purpose exceptions.+-- They may be useful when you need a simple instance of Exception (e. g. in MonadThrow context)++module Serokell.Util.Exceptions+       ( TextException (..)+       , throwText+       , EmptyException (..)+       , throwEmpty+       , eitherToFail+       ) where++import           Control.Exception      (Exception, SomeException,+                                         fromException)+import           Control.Monad.Catch    (MonadThrow, throwM)+import           Data.Text              (Text)+import           Data.Text.Buildable    (Buildable (build))+import qualified Data.Text.Format       as F+import           Data.Text.Lazy.Builder (Builder)+import           Data.Typeable          (Typeable)++instance Buildable SomeException where+    build e =+        maybe (build $ F.Shown e) (build :: TextException -> Builder) $+        fromException e++-- | Use this type if you are sure that text description is enough to represent error+newtype TextException = TextException+    { teMessage :: Text+    } deriving (Show,Typeable)++instance Exception TextException++instance Buildable TextException where+    build = F.build "TextException: {}" . F.Only . teMessage++throwText :: MonadThrow m+          => Text -> m a+throwText = throwM . TextException++-- | Use this type if you want to signal about error and there may be only one reason for it+data EmptyException = EmptyException+  deriving (Show, Typeable)++instance Exception EmptyException++throwEmpty :: MonadThrow m => m a+throwEmpty = throwM EmptyException++-- | Convert MonadThrow to arbitrary monad using `fail` to report+-- error Useful when you have `MonadThrow` and want to use it in+-- another monad context which uses `fail` for errors+eitherToFail :: (Monad m, e ~ SomeException) => Either e a -> m a+eitherToFail = either (fail . show) return

@@ -0,0 +1,63 @@+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE UndecidableInstances #-}++module Serokell.Util.I18N+       ( Translations+       , fromYaml+       , replaceTranslations+       , YamlMapKey+       , ToReplaceToken(..)+       ) where++import           Data.Aeson.Extra.Map   (FromJSONKey (..), getMap)+import           Data.Aeson.Types       (genericParseJSON, genericToJSON)+import qualified Data.Aeson.Types       as AT+import           Data.ByteString        as BS+import qualified Data.Map.Strict        as M+import           Data.Text              as T+import           Data.Yaml              (decodeEither)+import           Formatting             (build, sformat, (%))+import           GHC.Generics           (Generic, Rep)+import           Serokell.Aeson.Options (defaultOptions)++class (Eq a, Ord a, FromJSONKey a) => YamlMapKey a++instance (Generic a, AT.GFromJSON (Rep a)) =>+         FromJSONKey a where+    parseJSONKey l = genericParseJSON defaultOptions (AT.String l)++instance (Eq a, Ord a, Generic a, AT.GFromJSON (Rep a)) =>+         YamlMapKey a++type Translations lang token = M.Map lang (M.Map token T.Text)++fromYaml :: (YamlMapKey lang, YamlMapKey token)+         => BS.ByteString+         -> Translations lang token+fromYaml yamlStr =+    toLangMap $+    either+        (error .+         T.unpack . sformat ("Error during translation YAML parsing " % build))+        id $+    decodeEither yamlStr+  where+    toLangMap = fmap getMap . getMap+++class (Ord a, Eq a) => ToReplaceToken a where+  toReplaceToken :: a -> T.Text++instance (Ord a, Eq a, Generic a, AT.GToJSON (Rep a)) => ToReplaceToken a where+  toReplaceToken = (\(AT.String s) -> s) . genericToJSON defaultOptions++replaceTranslations+    :: (ToReplaceToken token, Eq lang, Ord lang)+    => Translations lang token -> lang -> T.Text -> Maybe T.Text+replaceTranslations translations lang text =+    M.foldrWithKey+        (\token ->+              T.replace $ "{{" `T.append` toReplaceToken token `T.append` "}}")+        text <$>+    lang `M.lookup` translations

@@ -0,0 +1,27 @@+{-# LANGUAGE Rank2Types #-}++-- | Extra operators on Lens+module Serokell.Util.Lens+       ( (%%=)+       , (%?=)+       ) where++import qualified Control.Lens               as L+import           Control.Monad.State        (State, get, runState)+import           Control.Monad.Trans.Except (ExceptT, mapExceptT)++-- I don't know how to call these operators++-- | Similar to %= operator, but takes State action instead of (a -> a)+infix 4 %%=+(%%=) :: L.Lens' s a -> State a b -> State s b+(%%=) l ma = do+    attr <- L.view l <$> get+    let (res,newAttr) = runState ma attr+    l L..= newAttr+    return res++-- | Like %%= but with possiblity of failure+infix 4 %?=+(%?=) :: L.Lens' s a -> ExceptT t (State a) b -> ExceptT t (State s) b+(%?=) l = mapExceptT (l %%=)

@@ -0,0 +1,30 @@+{-# LANGUAGE MultiParamTypeClasses #-}++-- | Some useful helper for optparse-applicative library++module Serokell.Util.OptParse+       ( fromStr+       , strArgument+       , strOption+       , fromParsec+       ) where++import           Data.String         (IsString (fromString))+import           Options.Applicative (ArgumentFields, Mod, OptionFields, Parser, ReadM,+                                      argument, eitherReader, option, str)+import           Text.Parsec         (Parsec, parse)++-- | Reader which uses IsString instance for parsing+fromStr :: IsString s => ReadM s+fromStr = fromString <$> str++-- | Parse argument using IsString instance+strArgument :: IsString s => Mod ArgumentFields s -> Parser s+strArgument = argument fromStr++-- | Parse option using IsString instance+strOption :: IsString s => Mod OptionFields s -> Parser s+strOption = option fromStr++fromParsec :: Parsec String () a -> ReadM a+fromParsec parser = eitherReader $ either (Left . show) Right . parse parser "<CLI options>"

@@ -0,0 +1,9 @@+-- | Some useful helpers for parsec library++module Serokell.Util.Parse+       ( module Export+       ) where++import           Serokell.Util.Parse.Base64  as Export+import           Serokell.Util.Parse.Common  as Export+import           Serokell.Util.Parse.Network as Export

@@ -0,0 +1,27 @@+-- | Parsing Base64++module Serokell.Util.Parse.Base64+       ( base64+       , base64Url+       ) where+import qualified Data.ByteString                    as BS+import           Data.Text                          (pack, unpack)+import           Serokell.Util.Base64               (decode, decodeUrl)+import           Serokell.Util.Parse.Common         (Parser, asciiAlphaNum)+import           Text.Parsec                        (many, many1, (<|>))+import           Text.ParserCombinators.Parsec.Char (char)++base64 :: Parser BS.ByteString+base64 = do+  str <- (++) <$> many1 (asciiAlphaNum <|> char '+' <|> char '/') <*> many (char '=')+  case decode $ pack str of+    Left e   -> fail $ unpack e+    Right bs -> return bs++base64Url :: Parser BS.ByteString+base64Url = do+  str <- (++) <$> many1 (asciiAlphaNum <|> char '_' <|> char '-') <*> many (char '=')+  case decodeUrl $ pack str of+    Left e   -> fail $ unpack e+    Right bs -> return bs+

@@ -0,0 +1,54 @@+{-# LANGUAGE MultiParamTypeClasses #-}++-- | Parsing common helpers++module Serokell.Util.Parse.Common+       ( Parser+       , countMinMax+       , limitedInt+       , byte+       , asciiAlphaNum+       ) where++import           Text.Parsec                        (Parsec, ParsecT, Stream, option,+                                                     satisfy)+import           Text.ParserCombinators.Parsec.Char (digit)++type Parser = Parsec String ()++isAsciiAlpha :: Char -> Bool+isAsciiAlpha c = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z')++isAsciiNum :: Char -> Bool+isAsciiNum c = (c >= '0' && c <= '9')++isAsciiAlphaNum :: Char -> Bool+isAsciiAlphaNum c = isAsciiAlpha c || isAsciiNum c++asciiAlphaNum :: Parser Char+asciiAlphaNum = satisfy isAsciiAlphaNum++countMinMax :: (Stream s m t) => Int -> Int -> ParsecT s u m a -> ParsecT s u m [a]+countMinMax m x p+    | m > 0 = do+        f <- p+        end <- countMinMax (m - 1) (x - 1) p+        return $ f : end+    | x <= 0 = return []+    | otherwise = option [] $ do+        f <- p+        end <- countMinMax 0 (x - 1) p+        return $ f : end++limitedInt :: Int -> String -> Parser Int+limitedInt x e = do+    b <- read <$> countMinMax 1 (intDigits x) digit+    if b > x+        then fail e+        else return b+  where+    intDigits = length . show++byte :: Parser Word+byte = fromIntegral <$> limitedInt 255 "Value to large"+

@@ -0,0 +1,117 @@+-- | Parsing network data++module Serokell.Util.Parse.Network+       ( Host (..)+       , port+       , ipv4address+       , ipv6address+       , ipv6addressWithScope+       , hostname+       , host+       , host'+       , connection+       , connection'+       ) where++import           Control.Monad                      (liftM, void)+import           Data.Word                          (Word16)+import           Serokell.Util.Parse.Common         (Parser, asciiAlphaNum, byte,+                                                     countMinMax, limitedInt)+import           Text.Parsec                        (choice, count, many1, oneOf, option,+                                                     try, (<?>), (<|>))+import           Text.ParserCombinators.Parsec.Char (alphaNum, char, hexDigit, string)++data Host = IPv4Address { hostAddress :: String }+          | IPv6Address { hostAddress :: String }+          | HostName    { hostAddress :: String }+    deriving(Show, Eq, Ord)++concatSequence :: (Monad m) => [m [a]] -> m [a]+concatSequence = liftM concat . sequence++port :: Parser Word16+port = fromIntegral <$> limitedInt 65535 "Port number to large"++ipv4address :: Parser String+ipv4address = concatSequence [+    byteStr, string ".",+    byteStr, string ".",+    byteStr, string ".", byteStr] <?> "bad IPv4 address"+  where+    byteStr = show <$> byte++ipv6address :: Parser String+ipv6address = do+    let ipv6variants = (try <$> skippedAtBegin)+                        ++ [try full]+                        ++ (try <$> skippedAtMiddle)+                        ++ (try <$> skippedAtEnd)+                        ++ [last2 False]+    choice ipv6variants <?> "bad IPv6 address"+  where+    hexShortNum = countMinMax 1 4 hexDigit+    h4s = (++) <$> hexShortNum <*> string ":"+    sh4 = (++) <$> string ":" <*> hexShortNum+    execNum 0 = return ""+    execNum n = concat <$> count n h4s+    partNum 0 = return ""+    partNum n = do+        f <- hexShortNum+        e <- countMinMax 0 (n - 1) (try sh4)+        return $ f ++ concat e++    maybeNum n = concat <$> countMinMax 0 n h4s+    last2f = try ipv4address <|> concatSequence [h4s, hexShortNum]+    last2 f = if f+        then last2f+        else choice [try last2f,+                     try $ concatSequence [string "::", hexShortNum],+                     concatSequence [hexShortNum, string "::"]]++    skippedAtBegin =+        map (\i -> concatSequence [string "::", execNum i, last2 True]) [5,4..0]++    skippedAtMiddle = [+        concatSequence [partNum 1, string "::", maybeNum 4, last2 True],+        concatSequence [partNum 2, string "::", maybeNum 3, last2 True],+        concatSequence [partNum 3, string "::", maybeNum 2, last2 True],+        concatSequence [partNum 4, string "::", maybeNum 1, last2 True],+        concatSequence [partNum 5, string "::", last2 True],+        concatSequence [partNum 6, string "::", hexShortNum]]++    skippedAtEnd = [concatSequence [partNum 7, string "::"]]++    full = concatSequence [concat <$> count 6 h4s, last2 True]++ipv6addressWithScope :: Parser String+ipv6addressWithScope = concatSequence [ipv6address, option "" scope]+  where+    scope = concatSequence [string "%", many1 asciiAlphaNum]++hostname :: Parser String+hostname = many1 $ alphaNum <|> oneOf ".-_"++host :: Parser String+host = hostAddress <$> host'++host' :: Parser Host+host' = (IPv6Address <$> try ipv6str)+         <|> (IPv4Address <$> try ipv4address)+         <|> (HostName <$> hostname)+  where+    ipv6str = do+        void $ char '['+        ipv6 <- ipv6addressWithScope+        void $ char ']'+        return ipv6++connection :: Parser (String, Maybe Word16)+connection = (\(h, p) -> (hostAddress h, p)) <$> connection'++connection' :: Parser (Host, Maybe Word16)+connection' = do+    addr <- host'+    p <- maybePort+    return (addr, p)+  where+    maybePort = option Nothing $ char ':' >> Just <$> port

@@ -0,0 +1,14 @@+-- | Compile time assertions+-- Very simple implementation from: http://stackoverflow.com/a/6654903+-- TODO: understand and maybe improve+module Serokell.Util.StaticAssert+       ( staticAssert+       ) where++import           Control.Monad       (unless)+import           Language.Haskell.TH (Q)++staticAssert :: Bool -> String -> Q [a]+staticAssert cond mesg = do+    unless cond $ fail $ "Compile time assertion failed: " ++ mesg+    return [] -- No need to make a dummy declaration

@@ -0,0 +1,244 @@+{-# LANGUAGE GADTs #-}++-- | Utility functions to work with `text` and `text-format`. Feel+-- free to add more if you need. Some functions have two versions, `'`+-- suffix means that function operates on strict Text.++module Serokell.Util.Text+       ( -- * @formatting@ utilities+         show+       , show'+       , FPFormat (..)+       , showFloat+       , showFloat'+       , showFixedPretty'+       , showDecimal+       , showDecimal'++       -- * Formatters+       , pairF+       , tripleF+       , listJson+       , listJsonIndent+       , listCsv+       , mapJson++       -- * Builders+       , pairBuilder+       , tripleBuilder+       , listBuilder+       , listBuilderJSON+       , listBuilderJSONIndent+       , listBuilderCSV+       , mapBuilder+       , mapBuilderJson++       -- * @text-format@ utilities+       , format+       , format'+       , formatSingle+       , formatSingle'+       , buildSingle++       -- * String readers+       , readFractional+       , readDouble+       , readDecimal+       , readUnsignedDecimal+       ) where++import qualified Data.Text                        as T+import           Data.Text.Buildable              (Buildable (build))+import qualified Data.Text.Format                 as F+import           Data.Text.Format.Params          (Params)+import qualified Data.Text.Lazy                   as LT+import qualified Data.Text.Lazy.Builder           as B+import qualified Data.Text.Lazy.Builder.Int       as B+import           Data.Text.Lazy.Builder.RealFloat (FPFormat (Exponent, Fixed, Generic))+import qualified Data.Text.Lazy.Builder.RealFloat as B+import qualified Data.Text.Read                   as T+import           Formatting                       (fixed, sformat, later, Format)+import           GHC.Exts                         (IsList(..))+import           Prelude                          hiding (show, showList)++show :: Buildable a+     => a -> LT.Text+show = B.toLazyText . build++show' :: Buildable a+      => a -> T.Text+show' = LT.toStrict . show++-- | Render a floating point number using normal notation, with the+-- given number of decimal places. This function also truncates+-- redundant terminating zeros.+showFixedPretty'+    :: Real a+    => Int -> a -> T.Text+showFixedPretty' prec =+    T.dropWhileEnd (== '.') . T.dropWhileEnd (== '0') . sformat (fixed prec)++showFloat+  :: (RealFloat a)+  => FPFormat -> Maybe Int -> a -> LT.Text+showFloat f precision v = B.toLazyText $ B.formatRealFloat f precision v++showFloat'+  :: (RealFloat a)+  => FPFormat -> Maybe Int -> a -> T.Text+showFloat' f prec = LT.toStrict . showFloat f prec++showDecimal :: (Integral a)+             => a -> LT.Text+showDecimal = B.toLazyText . B.decimal++showDecimal' :: (Integral a)+              => a -> T.Text+showDecimal' = LT.toStrict . showDecimal++pairF :: (Buildable a, Buildable b) => Format r ((a,b) -> r)+pairF = later pairBuilder++tripleF :: (Buildable a, Buildable b, Buildable c) => Format r ((a,b,c) -> r)+tripleF = later tripleBuilder++listJson :: (Foldable t, Buildable a) => Format r (t a -> r)+listJson = later listBuilderJSON++listJsonIndent :: (Foldable t, Buildable a) => Word -> Format r (t a -> r)+listJsonIndent = later . listBuilderJSONIndent++listCsv :: (Foldable t, Buildable a) => Format r (t a -> r)+listCsv = later listBuilderCSV++mapJson :: (IsList t, Item t ~ (k, v), Buildable k, Buildable v)+        => Format r (t -> r)+mapJson = later mapBuilderJson++-- | Prints pair (a, b) like "(a, b)"+pairBuilder+    :: (Buildable a, Buildable b)+    => (a, b) -> B.Builder+pairBuilder = F.build "({}, {})"++-- | Prints triple (a, b, c) like "(a, b, c)"+tripleBuilder+    :: (Buildable a, Buildable b, Buildable c)+    => (a, b, c) -> B.Builder+tripleBuilder = F.build "({}, {}, {})"++-- | Generic list builder. Prints prefix, then values separated by delimiter and finally suffix+listBuilder+  :: (Buildable prefix, Buildable delimiter, Buildable suffix, Foldable t, Buildable a)+  => prefix -> delimiter -> suffix -> t a -> B.Builder+listBuilder prefix delimiter suffix as =+  mconcat [build prefix, mconcat builders, build suffix]+  where builders = foldr appendBuilder [] as+        appendBuilder a [] = [build a]+        appendBuilder a bs = build a : build delimiter : bs++-- | This function helps to deduce type arising from string literal+_listBuilder+  :: (Foldable t, Buildable a)+  => B.Builder -> B.Builder -> B.Builder -> t a -> B.Builder+_listBuilder = listBuilder++-- | Prints values in JSON-style (e. g. `[111, ololo, blablabla]`)+listBuilderJSON+  :: (Foldable t, Buildable a)+  => t a -> B.Builder+listBuilderJSON = _listBuilder "[" ", " "]"++-- | Like listBuilderJSON, but prints each value on a new line with indentation+listBuilderJSONIndent+  :: (Foldable t, Buildable a)+  => Word -> t a -> B.Builder+listBuilderJSONIndent _ as | null as = "[]"+listBuilderJSONIndent indent as+  | otherwise =+    listBuilder ("[\n" `LT.append` spaces)+                delimiter+                ("\n]" :: B.Builder)+                as+  where spaces =+          LT.replicate (fromIntegral indent)+                       " "+        delimiter = ",\n" `LT.append` spaces++-- | Prints comma separated values+listBuilderCSV+  :: (Foldable t, Buildable a)+  => t a -> B.Builder+listBuilderCSV = _listBuilder "" "," ""++-- | There is no appropriate type class for map, but all reasonable maps+-- provide something like `assocs` function.+-- Map may be printed prettier (e. g. using JSON style), it's future task.+-- Having at least one such function is still good anyway.+mapBuilder+    :: (Traversable t, Buildable k, Buildable v)+    => t (k, v) -> B.Builder+mapBuilder = listBuilderJSON . fmap pairBuilder++mapBuilderJson+    :: (IsList t, Item t ~ (k, v), Buildable k, Buildable v)+    => t -> B.Builder+mapBuilderJson = _listBuilder "{" ", " "}" . map (F.build "{}: {}") . toList++{-# DEPRECATED format, format', formatSingle, formatSingle' "Not typesafe. Use formatting library instead" #-}++-- | Re-export Data.Text.Format.format for convenience+format :: Params ps+       => F.Format -> ps -> LT.Text+format = F.format++-- | Version of Data.Text.Format.format which returns strict Text+format' :: Params ps+        => F.Format -> ps -> T.Text+format' f = LT.toStrict . F.format f++formatSingle :: Buildable a+             => F.Format -> a -> LT.Text+formatSingle f = format f . F.Only++formatSingle' :: Buildable a+              => F.Format -> a -> T.Text+formatSingle' f = LT.toStrict . formatSingle f++buildSingle :: Buildable a+            => F.Format -> a -> B.Builder+buildSingle f = F.build f . F.Only++-- | Read fractional number. Returns error (i. e. Left) if there is something else+readFractional :: Fractional a => T.Text -> Either String a+readFractional = _wrapReader T.rational++-- | Like readFractional, but much more efficient. It may be slightly less accurate+readDouble :: T.Text -> Either String Double+readDouble = _wrapReader T.double++-- | Read signed decimal number. Returns error (i. e. Left) if there is something else+-- WARNING: if input is negative and `a` is unsigned, overflow will occur+readDecimal :: Integral a => T.Text -> Either String a+readDecimal = _wrapReader $ T.signed T.decimal++-- | Read unsigned decimal number. Returns error (i. e. Left) if there is something else+readUnsignedDecimal :: Integral a => T.Text -> Either String a+readUnsignedDecimal = _wrapReader T.decimal++_wrapReader :: T.Reader a -> T.Text -> Either String a+_wrapReader reader t =+  case reader t of+    Left err -> Left $ mconcat [ "failed to parse '"+                               , T.unpack t+                               , "': "+                               , err+                               ]+    Right (res, "") -> Right res+    Right (_, remainder) ->+      Left $+      mconcat [ "failed to parse '"+              , T.unpack t+              , "', because there is a remainder: "+              , T.unpack remainder+              ]

@@ -0,0 +1,52 @@+-- | General-purpose utility functions++module Serokell.Util.Verify+       ( VerificationRes (..)+       , isVerFailure+       , isVerSuccess++       , verifyGeneric+       ) where++import           Data.Semigroup (Semigroup)+import qualified Data.Semigroup as Semigroup+import qualified Data.Text      as T++data VerificationRes+    = VerSuccess+    | VerFailure ![T.Text]+    deriving (Show)++isVerSuccess :: VerificationRes -> Bool+isVerSuccess VerSuccess = True+isVerSuccess _          = False++isVerFailure :: VerificationRes -> Bool+isVerFailure (VerFailure _) = True+isVerFailure _              = False++instance Semigroup VerificationRes where+    VerSuccess <> a = a+    VerFailure xs <> a =+        VerFailure $+        xs +++        case a of+            VerSuccess    -> []+            VerFailure ys -> ys++instance Monoid VerificationRes where+    mempty = VerSuccess+    mappend = (Semigroup.<>)++-- | This function takes list of (predicate, message) pairs and checks+-- each predicate.  If predicate is False it's considered an error.+-- If there is at least one error this function returns VerFailure,+-- otherwise VerSuccess is returned.  It's useful to verify some data+-- before using it.+-- Example usage: `verifyGeneric [(checkA, "A is bad"), (checkB, "B is bad")]`+verifyGeneric :: [(Bool, T.Text)] -> VerificationRes+verifyGeneric errors+    | null messages = VerSuccess+    | otherwise = VerFailure messages+  where+    messages = map snd . filter (not . fst) $ errors

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}

@@ -0,0 +1,5 @@+import           Spec       (spec)+import           Test.Hspec (hspec)++main :: IO ()+main = hspec spec

@@ -0,0 +1,31 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE StandaloneDeriving        #-}++module Test.Serokell.Data.Memory.UnitsSpec+       ( spec+       ) where++import           Test.Hspec                 (Spec, describe)+import           Test.Hspec.QuickCheck      (prop)+import           Test.QuickCheck            ((===))++import           Serokell.Arbitrary         ()+import qualified Serokell.Data.Memory.Units as S++spec :: Spec+spec = describe "Unit conversion" $ do+           describe "Identity Properties" $ do+               prop "Byte" $+                   \(a :: S.Byte) -> a === bytesMid a+               prop "Kilobyte" $+                   \(a :: S.Kilobyte) -> a === bytesMid a+               prop "Megabyte" $+                   \(a :: S.Megabyte) -> a === bytesMid a+               prop "Gigabyte" $+                   \(a :: S.Gigabyte) -> a === bytesMid a+               prop "Terabyte" $+                   \(a :: S.Terabyte) -> a === bytesMid a++bytesMid :: forall u. S.MemoryUnit u => u -> u+bytesMid = S.convertUnit

@@ -0,0 +1,103 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns        #-}++module Test.Serokell.Data.Variant.VariantSpec+       ( spec+       ) where++import qualified Data.Aeson            as A (decode, encode)+import qualified Data.Binary           as B (decode, encode)+import qualified Data.HashMap.Lazy     as HM (elems, fromList, keys)+import           Data.MessagePack      (fromObject, toObject)+import qualified Data.SafeCopy         as SC (safeGet, safePut)+import           Data.Scientific       (floatingOrInteger, fromFloatDigits)+import qualified Data.Serialize        as C (decode, encode, runGet, runPut)+import           Data.Text             (unpack)+import qualified Data.Vector           as V (map)+import           Test.Hspec            (Spec, describe)+import           Test.Hspec.QuickCheck (prop)+import           Test.QuickCheck       ((===))++import           Serokell.Arbitrary    (VariantNoBytes (..),+                                        VariantOnlyBytes (..))+import qualified Serokell.Data.Variant as S+import qualified Serokell.Util.Base64  as S+import           Serokell.Util.Text    (show')++spec :: Spec+spec = describe "Variant" $ do+           describe "Identity Properties" $ do+               describe "JSON" $ do+                   prop "Variant (No VarBytes)" $+                       \(getVariant -> a) -> (jsonFixer a) === jsonMid a+                   prop "Variant (Only VarBytes)" $+                       \(getVarBytes -> a) -> a === (bytesFun $ jsonMid a)+               prop "MessagePack" $+                   \(a :: S.Variant) -> (msgPkFixer a) === msgPkMid a+               prop "Binary" $+                   \(a :: S.Variant) -> a === binMid a+               prop "SafeCopy" $+                   \(a :: S.Variant) -> a === safeCopyMid a+               prop "Serialize" $+                   \(a :: S.Variant) -> a === cerealMid a++jsonFixer :: S.Variant -> S.Variant+jsonFixer (S.VarMap m) = let ks = map toStr $ HM.keys m+                             vs = map jsonFixer $ HM.elems m+                             m' = HM.fromList $ zip ks vs+                         in S.VarMap m'+jsonFixer (S.VarList l) = S.VarList $ V.map jsonFixer l+jsonFixer v@(S.VarInt i) =+    if i < 0 then v+             else (S.VarUInt $ fromIntegral i)+jsonFixer (S.VarFloat f) =+    case floatingOrInteger $ fromFloatDigits f of+        Left float -> S.VarFloat float+        Right int -> if int < 0 then S.VarInt int+                                else S.VarUInt $ fromIntegral int+jsonFixer v = v++toStr :: S.Variant -> S.Variant+toStr var = stringVar var+  where+    stringVar :: S.Variant -> S.Variant+    stringVar = S.VarString . show'++jsonMid :: S.Variant -> S.Variant+jsonMid = maybe err id . A.decode . A.encode+   where+     err = error "[VariantSpec] Failed JSON decoding"++bytesFun :: S.Variant -> S.Variant+bytesFun (S.VarString s) = S.VarBytes right+  where+     right = either (error . unpack) id $ S.decode s+bytesFun _ = error "[bytesFun:] called with Variant that was not VarBytes"++msgPkFixer :: S.Variant -> S.Variant+msgPkFixer (S.VarMap m) = let ks = map msgPkFixer $ HM.keys m+                              vs = map msgPkFixer $ HM.elems m+                              m' = HM.fromList $ zip ks vs+                          in S.VarMap m'+msgPkFixer (S.VarList l) = S.VarList $ V.map msgPkFixer l+msgPkFixer v@(S.VarInt i) =+    if i < 0 then v+             else (S.VarUInt $ fromIntegral i)+msgPkFixer v@(S.VarUInt i) =+    if i >= 0 then v+             else (S.VarInt $ fromIntegral i)+msgPkFixer v = v++msgPkMid :: S.Variant -> S.Variant+msgPkMid = maybe err id . fromObject . toObject+  where+    err = error "[VariantSpec] Failed MessagePack decoding"++binMid :: S.Variant -> S.Variant+binMid = B.decode . B.encode++cerealMid :: S.Variant -> S.Variant+cerealMid = either error id . C.decode . C.encode++safeCopyMid :: S.Variant -> S.Variant+safeCopyMid = either error id . C.runGet SC.safeGet . C.runPut . SC.safePut

@@ -0,0 +1,44 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving  #-}++module Test.Serokell.Util.ByteStringSpec+       ( spec+       ) where++import           Data.Aeson                (decode, encode)+import qualified Data.ByteString           as BS+import           Data.Maybe                (fromJust)+import           Test.Hspec                (Spec, describe)+import           Test.Hspec.QuickCheck     (prop)+import           Test.QuickCheck           ((===))+import           Test.QuickCheck.Instances ()++import           Serokell.Arbitrary        ()+import qualified Serokell.Util.Base16      as C16+import qualified Serokell.Util.Base64      as C64++deriving instance Eq C64.JsonByteString+deriving instance Show C64.JsonByteString++spec :: Spec+spec =+    describe "Serialization" $ do+        describe "Indentity Properties" $ do+            prop "Base16" $+                \(a :: BS.ByteString) -> a === base16Mid a+            prop "Base64" $+                \(a :: BS.ByteString) -> a === base64Mid a+            prop "JSON Base64" $+                \(a :: C64.JsonByteString) -> a === base64JSONMid a++base16Mid,+    base64Mid :: BS.ByteString -> BS.ByteString+base16Mid = fromRight . C16.decode . C16.encode+base64Mid = fromRight . C64.decode . C64.encode++base64JSONMid :: C64.JsonByteString -> C64.JsonByteString+base64JSONMid = fromJust . decode . encode++fromRight :: Either a BS.ByteString -> BS.ByteString+fromRight (Left _)  = error "failed decoding to ByteString"+fromRight (Right b) = b

@@ -0,0 +1,83 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE ViewPatterns              #-}++module Test.Serokell.Util.CommonSpec+       ( spec+       ) where++import           Data.Foldable             (toList)+import           Data.List                 (genericIndex, genericLength,+                                            intersect)+import           Data.Vector               (Vector)+import           Test.Hspec                (Spec, describe)+import           Test.Hspec.QuickCheck     (prop)+import           Test.QuickCheck           (Arbitrary (..), Gen,+                                            NonEmptyList (..), oneof)+import           Test.QuickCheck.Instances ()++import qualified Serokell.Util.Common      as C++spec :: Spec+spec =+    describe "Common" $ do+        describe "enumerate" $+            prop description_enumerateCheck enumerateCheckIndexes+        describe "indexModulo" $+            prop description_indexModulo indexModuloCorrectIndex+        describe "indexedSubList" $+            prop description_indexedSubListNeg indexedSublistWhenNegative+  where+    description_enumerateCheck =+      "enumerates a structure in sequence, " +++      "starting from index 0"+    description_indexModulo =+      "returns the element of the the list with " +++      "given index modulo length of the list"+    description_indexedSubListNeg =+      "negative indices, given that the lower " +++      "bound is lesser than the upper bound, result in valid indexation"++-- TODO: consider using `SomeValue` to generate different types of+-- values.  I don't know how to add more than one quantifier to type+-- definition. Also consider using GADTs to achieve it.+type Value = Int++data SomeTraversable =+    forall t. (Traversable t, Show (t Value), Arbitrary (t Value)) =>+              SomeTraversable (t Value)++instance Show SomeTraversable where+    show (SomeTraversable t) = show t++instance Arbitrary SomeTraversable where+    arbitrary =+        oneof+            [ SomeTraversable <$> (arbitrary :: Gen [Value])+            , SomeTraversable <$> (arbitrary :: Gen (Vector Value))+            ]++enumerateCheckIndexes :: SomeTraversable -> Bool+enumerateCheckIndexes (SomeTraversable values) =+    let indexedVals = C.enumerate values+        indexList   = toList $ fmap fst indexedVals+        indexNum    = genericLength indexList+    in null values || indexList == [0 :: Word .. indexNum-1]++indexModuloCorrectIndex+    :: NonEmptyList Int -> Int -> Bool+indexModuloCorrectIndex (getNonEmpty -> list) ind =+    let len = genericLength list+        atModuloIndex = list `genericIndex` (ind `mod` len)+    in atModuloIndex == C.indexModulo list ind++indexedSublistWhenNegative+    :: (Int, Int) -> [Int] -> Bool+indexedSublistWhenNegative (lo, hi) list+    | hi <= lo = indexList lo hi == []+    | hi <= 0 = indexList lo hi == []+    | len -1 < lo = indexList lo hi == []+    | otherwise = testIndexes lo hi == indexList lo hi+  where+    len = length list+    indexList l h = map fst $ C.indexedSubList (l, h) list+    testIndexes l h = intersect [l .. h - 1] [0 .. len - 1]

@@ -0,0 +1,38 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE StandaloneDeriving        #-}++module Test.Serokell.Util.TextSpec+       ( spec+       ) where++import           Data.Int                  (Int64)+import           Data.Text.Buildable       (Buildable)+import           Data.Word                 (Word64)++import           Test.Hspec                (Spec, describe)+import           Test.Hspec.QuickCheck     (prop)+import           Test.QuickCheck           ((===))+import           Test.QuickCheck.Instances ()++import qualified Serokell.Util.Text        as S++spec :: Spec+spec =+    describe "Text Show/Read" $ do+        describe "Indentity Properties" $ do+            describe "readDecimal" $ do+                prop "Int" $+                    \(a :: Int) -> (Right a) === showReadIntegral a+                prop "Integer" $+                    \(a :: Integer) -> (Right a) === showReadIntegral a+                prop "Word" $+                    \(a :: Word) -> (Right a) === showReadIntegral a+                prop "Int64" $+                    \(a :: Int64) -> (Right a) === showReadIntegral a+                prop "Word64" $+                    \(a :: Word64) -> (Right a) === showReadIntegral a++showReadIntegral+    :: (Buildable a, Integral a) => a -> Either String a+showReadIntegral = S.readDecimal . S.show'