stuff

IntersectMBO · Sep 15, 2022 · 046adb4 · 046adb4
1 parent 12433ee
commit 046adb4
Show file tree

Hide file tree

Showing 4 changed files with 54 additions and 8 deletions.
diff --git a/cabal.project b/cabal.project
@@ -27,13 +27,13 @@ source-repository-package
 
 source-repository-package
   type: git
-  location: https://github.com/erikd/nothunks
-  tag: be807ff5411a97c54e997706618c96bd686c2830
+  location: https://github.com/input-output-hk/nothunks
+  tag: 45d066c4f47400e645bda7dc0ffe5070bd2baf42
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-prelude
-  tag: f3548c2bc620c8df4bc6e28830544f813ef533dc
+  tag: 891b93b4121d26437d60625b6e212c51392acbea
   --sha256: 04h8n0m93rgr8xcynypjh6mc7kmb450c17cfvpyzpa36yld599fy
   subdir:
     cardano-prelude
@@ -77,11 +77,11 @@ source-repository-package
 package process
   ghc-options: -Wno-error
 
-source-repository-package
-  type: git
-  location: https://github.com/newhoggy/process
-  tag: f20cf8fa19dc9c63f3490135f1b652e4d95a0cd5
-  post-checkout-command: autoreconf -i
+-- source-repository-package
+--   type: git
+--   location: https://github.com/newhoggy/process
+--   tag: f20cf8fa19dc9c63f3490135f1b652e4d95a0cd5
+--   post-checkout-command: autoreconf -i
 
 package cardano-crypto-class
   ghc-options: -Wno-unused-packages
diff --git a/cardano-crypto-class/src/Cardano/Crypto/Hash/Class.hs b/cardano-crypto-class/src/Cardano/Crypto/Hash/Class.hs
@@ -91,6 +91,8 @@ import Cardano.Prelude (HeapWords (..))
 
 import qualified Data.ByteString.Short.Internal as SBSI
 
+import Cardano.Crypto.Util (decodeHexString)
+
 class (KnownNat (SizeHash h), Typeable h) => HashAlgorithm h where
   --TODO: eliminate this Typeable constraint needed only for the ToCBOR
   -- the ToCBOR should not need it either

diff --git a/cardano-crypto-class/src/Cardano/Crypto/PinnedSizedBytes.hs b/cardano-crypto-class/src/Cardano/Crypto/PinnedSizedBytes.hs
@@ -1,10 +1,12 @@
 {-# LANGUAGE BangPatterns               #-}
 {-# LANGUAGE DerivingVia                #-}
 {-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE KindSignatures             #-}
 {-# LANGUAGE MagicHash                  #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE TemplateHaskell            #-}
 {-# LANGUAGE UnboxedTuples              #-}
 
 -- for pinnedByteArrayFromListN
@@ -65,6 +67,8 @@ import qualified Data.ByteString as BS
 import Cardano.Foreign
 import Cardano.Crypto.Libsodium.C (c_sodium_compare)
 
+import Cardano.Crypto.Util (decodeHexString)
+
 {- HLINT ignore "Reduce duplication" -}
 
 -- $setup

diff --git a/cardano-crypto-class/src/Cardano/Crypto/Util.hs b/cardano-crypto-class/src/Cardano/Crypto/Util.hs
@@ -24,15 +24,26 @@ module Cardano.Crypto.Util
 
   -- * ByteString manipulation
   , slice
+
+  -- * Base16 conversion
+  , decodeHexByteString
+  , decodeHexString
+  , decodeHexStringQ
   )
 where
 
+import           Control.Monad (unless)
+import           Data.Bifunctor (first)
+import           Data.Char (isAscii)
 import           Data.Word
 import           Numeric.Natural
 import           Data.Bits
 import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BSC8
 import qualified Data.ByteString.Internal as BS
 import           Data.ByteString (ByteString)
+import           Data.ByteString.Base16 as BS16
+import           Language.Haskell.TH
 
 import           GHC.Exts (Addr#, Int#, Word#)
 import qualified GHC.Exts    as GHC
@@ -151,3 +162,32 @@ slice :: Word -> Word -> ByteString -> ByteString
 slice offset size = BS.take (fromIntegral size)
                   . BS.drop (fromIntegral offset)
 
+-- | Decode base16 ByteString, while ensuring expected length.
+decodeHexByteString :: ByteString -> Int -> Either String ByteString
+decodeHexByteString bsHex lenExpected = do
+  bs <- first ("Malformed hex: " ++) $ BS16.decode bsHex
+  let lenActual = BS.length bs
+  unless (lenExpected == lenActual) $
+    Left $ "Expected in decoded form to be: " ++
+           show lenExpected ++ " bytes, but got: " ++ show lenActual
+  pure bs
+
+
+-- | Decode base16 String, while ensuring expected length. Unlike
+-- `decodeHexByteString` this function expects a '0x' prefix.
+decodeHexString :: String -> Int -> Either String ByteString
+decodeHexString hexStr' lenExpected = do
+  let hexStr =
+        case hexStr' of
+          '0':'x':str -> str
+          str -> str
+  unless (all isAscii hexStr) $ Left $ "Input string contains invalid characters: " ++ hexStr
+  decodeHexByteString (BSC8.pack hexStr) lenExpected
+
+-- | Decode a `String` with Hex characters, while ensuring expected length.
+decodeHexStringQ :: String -> Int -> Q Exp
+decodeHexStringQ hexStr n = do
+  case decodeHexString hexStr n of
+    Left err -> fail $ "<decodeHexByteString>: " ++ err
+    Right _  -> [| either error id (decodeHexString hexStr n) |]
+