-
Notifications
You must be signed in to change notification settings - Fork 85
/
Orphans.hs
77 lines (62 loc) · 2.12 KB
/
Orphans.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
{-# OPTIONS_GHC -Wno-orphans #-}
-- | Orphans instances partly copied from Plutus, partly coming from us for test
-- purpose.
module Plutus.Orphans where
import Hydra.Prelude
import Data.Aeson (object, withObject, (.:), (.=))
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Base16 as Base16
import qualified Plutus.V1.Ledger.Api as Plutus
import Plutus.V2.Ledger.Api (
CurrencySymbol,
POSIXTime (..),
TokenName,
UpperBound (..),
Value,
fromBuiltin,
getPubKeyHash,
toBuiltin,
upperBound,
)
import qualified PlutusTx.AssocMap as AssocMap
import PlutusTx.Prelude (BuiltinByteString)
import Test.QuickCheck.Instances.ByteString ()
instance Arbitrary BuiltinByteString where
arbitrary = toBuiltin <$> (arbitrary :: Gen ByteString)
instance Arbitrary TokenName where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary CurrencySymbol where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary Value where
arbitrary = genericArbitrary
shrink = genericShrink
instance (Arbitrary k, Arbitrary v) => Arbitrary (AssocMap.Map k v) where
arbitrary = AssocMap.fromList <$> arbitrary
instance Arbitrary POSIXTime where
arbitrary = POSIXTime <$> arbitrary
instance ToJSON POSIXTime where
toJSON (POSIXTime ms) = toJSON ms
instance FromJSON POSIXTime where
parseJSON = fmap POSIXTime . parseJSON
instance Arbitrary a => Arbitrary (UpperBound a) where
arbitrary = upperBound <$> arbitrary
instance ToJSON Plutus.PubKeyHash where
toJSON = \kh ->
object
[ "tag" .= Aeson.String "PubKeyHash"
, "keyHash" .= Aeson.String (decodeUtf8 $ Base16.encode $ fromBuiltin $ getPubKeyHash kh)
]
instance FromJSON Plutus.PubKeyHash where
parseJSON = withObject "PubKeyHash" $ \o -> do
tag <- o .: "tag"
case tag :: Text of
"PubKeyHash" -> do
hexText :: Text <- o .: "keyHash"
case Base16.decode $ encodeUtf8 hexText of
Left e -> fail e
Right bs -> pure $ Plutus.PubKeyHash (toBuiltin bs)
_ -> fail "Expected tag to be PubKeyHash"
instance Arbitrary Plutus.PubKeyHash where
arbitrary = genericArbitrary