Merge pull request #1920 from input-output-hk/use-decodeEitherBase16-…

…from-cardano-prelude Use decodeEitherBase16 from cardano-prelude
IntersectMBO · Oct 19, 2020 · 265300f · 265300f
2 parents c6508ab + fb92cec
commit 265300f
Show file tree

Hide file tree

Showing 5 changed files with 47 additions and 37 deletions.
diff --git a/byron/ledger/impl/test/Test/Cardano/Chain/Genesis/Example.hs b/byron/ledger/impl/test/Test/Cardano/Chain/Genesis/Example.hs
@@ -14,7 +14,6 @@ where
 
 import Cardano.Prelude
 
-import qualified Data.ByteString.Base16 as B16
 import qualified Data.Map.Strict as M
 import Data.Maybe (fromJust)
 import qualified Data.Set as Set
@@ -169,11 +168,10 @@ exampleUTCTime0 :: UTCTime
 exampleUTCTime0 = UTCTime (ModifiedJulianDay 10000) (secondsToDiffTime 82401)
 
 hexToBS :: ByteString -> ByteString
-hexToBS ts = case B16.decode ts of
-  (fullyDecoded, "") -> fullyDecoded
-  (partiallyDecoded, invalid) ->
-    panic
-      $  "successfully decoded: "
-      <> show partiallyDecoded
-      <> " decode failed: "
-      <> show invalid
+hexToBS ts = case decodeEitherBase16 ts of
+  Right fullyDecoded -> fullyDecoded
+  Left msg -> panic
+    $  "fail to decode: "
+    <> show ts
+    <> " with error: "
+    <> show msg
diff --git a/cabal.project b/cabal.project
@@ -14,15 +14,14 @@ packages:
   shelley/chain-and-ledger/shelley-spec-ledger-test
   shelley-ma/impl
 
-
 -- Always wrtie GHC env files, because they are needed by the doctests.
 write-ghc-environment-files: always
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-base
-  tag: af6675d6b6c618418c69c37d1307e3b0c97671cb
-  --sha256: 17bkgpdm39wcl8qfg41hs9xm6x6zmlxvfph1ysy6c4p7y9kkvix7
+  tag: 72399b18f1bb7d91b21bc9e0e3c28715cde7d124
+  --sha256: 014jw9jkwq3z30hl5pc0in51hzxrdys4964vpppmn1nim994bykx
   subdir:
     binary
     binary/test
@@ -39,22 +38,24 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-prelude
-  tag: 53f963be6c4b19a6bb710f9fa5e34db1c5a33a01
-  --sha256: 06d21hbl800k018rpf9i8r83d7wjzfgsp3qj23k1mqr2031f55cc
+  tag: a5519e09958ad1605ed438d26dd7aad39167d0f9
+  --sha256: 03v46yn5bnkmwcm1zwihjhqvma4ssh3s1s1bfdizvq18y1janwf1
+  subdir:
+    cardano-prelude
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-prelude
-  tag: 3376feb66f94e4a12ad0b51efa2f252cc7f52967
-  --sha256: 0m6f0m8dsyji1l4c4n8yr7axk8mljwfajk7qp07zaw5fzrsd4abf
+  tag: a5519e09958ad1605ed438d26dd7aad39167d0f9
+  --sha256: 03v46yn5bnkmwcm1zwihjhqvma4ssh3s1s1bfdizvq18y1janwf1
   subdir:
-    test
+    cardano-prelude-test
 
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/iohk-monitoring-framework
-  tag: c9230a97f033187157002ba00fa0c5753f381593
-  --sha256: 1iqjziw0pad0l78lz6l5dhvfk7wqkffbwln2g62vrqsshl1gb08y
+  tag: 034962a2729e0afff82c367121c1cc9637c7f45a
+  --sha256: 0ga5j9r55r3ika48x2w39clp4qh8kjp27qanxsg1s6jrl125yjac
   subdir:   contra-tracer
 
 source-repository-package

diff --git a/nix/sources.json b/nix/sources.json
@@ -5,10 +5,10 @@
         "homepage": "https://input-output-hk.github.io/haskell.nix",
         "owner": "input-output-hk",
         "repo": "haskell.nix",
-        "rev": "33cd29ee330d34c8c99a9ce56fb3529b44cf3224",
-        "sha256": "1jgwz2iahvn43w398aanm4djzjmr5a2hcv1ijzi9vh79circ7ffz",
+        "rev": "800b536c97e58fe7e403b957941dd26ade0fe28f",
+        "sha256": "0zy6ss7qkz6997a62n0kvkdx4hqnr0ym9xn59c1isvlginn54wly",
         "type": "tarball",
-        "url": "https://github.com/input-output-hk/haskell.nix/archive/33cd29ee330d34c8c99a9ce56fb3529b44cf3224.tar.gz",
+        "url": "https://github.com/input-output-hk/haskell.nix/archive/800b536c97e58fe7e403b957941dd26ade0fe28f.tar.gz",
         "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
     },
     "iohk-nix": {
@@ -17,10 +17,10 @@
         "homepage": null,
         "owner": "input-output-hk",
         "repo": "iohk-nix",
-        "rev": "774030b8dbefcdf13842a09a9f28c5bd762d8dc9",
-        "sha256": "16wjiwzhv6bxlnffqi669082l12a3k672811c8xfvcxh267sgvy3",
+        "rev": "f2dee151a917aac96121246ed76fb17e3f9026b0",
+        "sha256": "1d8ygzczk4zbzz04j1yrwzbfld59bc6a6ar7bmlfx1j5m6fhjb8k",
         "type": "tarball",
-        "url": "https://github.com/input-output-hk/iohk-nix/archive/774030b8dbefcdf13842a09a9f28c5bd762d8dc9.tar.gz",
+        "url": "https://github.com/input-output-hk/iohk-nix/archive/f2dee151a917aac96121246ed76fb17e3f9026b0.tar.gz",
         "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
     },
     "ormolu": {
@@ -30,10 +30,10 @@
         "homepage": null,
         "owner": "tweag",
         "repo": "ormolu",
-        "rev": "5f7eb9df93af40524b2ff60276ef05c9fbfcec9f",
-        "sha256": "0g1m502kbhadhq7mwllznkrkmjsb0l7wb24kpq2g7p8gb5qphajv",
+        "rev": "f896262aee3170c823ad70fe11945e64cdc24b9c",
+        "sha256": "0hr94mxkvxys3n8nr5r4kmgmhx2k3y831wr3dfjs2y1nw3ldzrhr",
         "type": "tarball",
-        "url": "https://github.com/tweag/ormolu/archive/5f7eb9df93af40524b2ff60276ef05c9fbfcec9f.tar.gz",
+        "url": "https://github.com/tweag/ormolu/archive/f896262aee3170c823ad70fe11945e64cdc24b9c.tar.gz",
         "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
     }
 }
diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/TxBody.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/TxBody.hs
@@ -91,14 +91,15 @@ import Cardano.Ledger.Era
 import Cardano.Ledger.Shelley (ShelleyBased, ShelleyEra)
 import Cardano.Prelude
   ( cborError,
+    decodeEitherBase16,
     panic,
   )
 import Control.DeepSeq (NFData (rnf))
 import Control.Iterate.SetAlgebra (BaseRep (MapR), Embed (..), Exp (Base), HasExp (toExp))
 import Control.Monad (unless)
-import Data.Aeson (FromJSON (..), ToJSON (..), (.!=), (.:), (.:?), (.=))
+import Data.Aeson (FromJSON (..), ToJSON (..), Value, (.!=), (.:), (.:?), (.=))
 import qualified Data.Aeson as Aeson
-import Data.Aeson.Types (explicitParseField)
+import Data.Aeson.Types (Parser, explicitParseField)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Base16 as Base16
@@ -195,7 +196,7 @@ instance HasExp (StakeCreds era) (Map (Credential 'Staking era) SlotNo) where
 
 instance Embed (StakeCreds era) (Map (Credential 'Staking era) SlotNo) where
   toBase (StakeCreds x) = x
-  fromBase x = (StakeCreds x)
+  fromBase x = StakeCreds x
 
 -- | The delegation of one stake key to another.
 data Delegation era = Delegation
@@ -223,10 +224,17 @@ instance ToJSON PoolMetaData where
 
 instance FromJSON PoolMetaData where
   parseJSON =
-    Aeson.withObject "PoolMetaData" $ \obj ->
-      PoolMetaData
-        <$> obj .: "url"
-        <*> explicitParseField (fmap (fst . Base16.decode . Char8.pack) . parseJSON) obj "hash"
+    Aeson.withObject "PoolMetaData" $ \obj -> do
+      url <- obj .: "url"
+      hash <- explicitParseField parseJsonBase16 obj "hash"
+      return $ PoolMetaData url hash
+
+parseJsonBase16 :: Value -> Parser ByteString
+parseJsonBase16 v = do
+  s <- parseJSON v
+  case decodeEitherBase16 (Char8.pack s) of
+    Right bs -> return bs
+    Left msg -> fail msg
 
 instance NoThunks PoolMetaData
 

diff --git a/...er/shelley-spec-ledger-test/test/Test/Shelley/Spec/Ledger/Serialisation/Golden/Address.hs b/...er/shelley-spec-ledger-test/test/Test/Shelley/Spec/Ledger/Serialisation/Golden/Address.hs
@@ -27,6 +27,7 @@ import qualified Data.ByteString.Base16 as B16
 import qualified Data.ByteString.Base16.Lazy as LB16
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.ByteString.Short as SBS
+import Data.Either
 import Data.Maybe (fromJust)
 import Data.Proxy (Proxy (..))
 import GHC.Stack (HasCallStack)
@@ -48,6 +49,8 @@ import Test.Tasty (TestTree)
 import qualified Test.Tasty as T
 import qualified Test.Tasty.HUnit as T
 
+import Cardano.Prelude (decodeEitherBase16)
+
 tests :: TestTree
 tests =
   T.testGroup
@@ -122,11 +125,11 @@ goldenTests_MockCrypto =
     keyHash :: Credential kh C
     keyHash =
       KeyHashObj . KeyHash . UnsafeHash $
-        SBS.toShort . fst . B16.decode $ "01020304"
+        SBS.toShort . fromRight (error "Unable to decode") . decodeEitherBase16 $ "01020304"
     scriptHash :: Credential kh C
     scriptHash =
       ScriptHashObj . ScriptHash . UnsafeHash $
-        SBS.toShort . fst . B16.decode $ "05060708"
+        SBS.toShort . fromRight (error "Unable to decode") . decodeEitherBase16 $ "05060708"
     ptr :: Ptr
     ptr = Ptr (SlotNo 128) 2 3