packages feed

azimuth-hs 0.1.1 → 0.2.0

raw patch · 7 files changed

+113/−87 lines, 7 files

Files

CHANGELOG view
@@ -1,5 +1,9 @@ # Changelog +- 0.2.0 (2020-08-13)+    * Generalizes account types to include hs-web3's 'DefaultAccount' and+      'PersonalAccount', in addition to the existing 'LocalKeyAccount'.+ - 0.1.0 (2020-07-14)     * Initial release.
azimuth-hs.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name:          azimuth-hs-version:       0.1.1+version:       0.2.0 synopsis:      Interact with Azimuth from Haskell description:   Haskell bindings for Azimuth (https://github.com/urbit/azimuth) homepage:      https://github.com/urbit/azimuth-hs
lib/Urbit/Azimuth/Account.hs view
@@ -1,8 +1,15 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+ module Urbit.Azimuth.Account (     A.Account(..)   , A.LocalKey(..)   , A.LocalKeyAccount+  , A.PersonalAccount+  , A.DefaultAccount +  , Unlockable+   , C.PrivateKey   , C.PublicKey   , C.importKey@@ -22,6 +29,10 @@ import qualified Crypto.Ethereum as C import qualified Network.Haskoin.Keys as K import qualified Network.Ethereum.Account as A+import qualified Network.Ethereum.Account.Internal as AI+import Network.JsonRpc.TinyClient (JsonRpc)++type Unlockable p m = (JsonRpc m, A.Account p (AI.AccountT p))  -- | Recover a private key from a BIP39 mnemonic, passphrase, and HD derivation --   path.
lib/Urbit/Azimuth/Azimuth.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} @@ -25,8 +26,8 @@   ) where  import qualified Data.Default.Class as Default-import Network.JsonRpc.TinyClient (JsonRpc) import Numeric.Natural+import Urbit.Azimuth.Account import qualified Urbit.Azimuth.Azimuth.Internal as I import Urbit.Azimuth.Contract import Urbit.Azimuth.Point@@ -34,14 +35,14 @@ import qualified Urbit.Ob.Extended as Ob  -- | Fetch a point's details and rights.-getPoint :: JsonRpc m => Ob.Patp -> Azimuth m Point+getPoint :: Unlockable p m => Ob.Patp -> Azimuth p m Point getPoint patp = do   deets  <- getDetails patp   rights <- getRights patp   pure (Point patp deets rights)  -- | Fetch a point's details.-getDetails :: JsonRpc m => Ob.Patp -> Azimuth m Details+getDetails :: Unlockable p m => Ob.Patp -> Azimuth p m Details getDetails patp = withContract azimuth $ do   let point = Ob.patpToPoint patp @@ -59,7 +60,7 @@   pure Details { .. }  -- | Fetch a point's rights.-getRights :: JsonRpc m => Ob.Patp -> Azimuth m Rights+getRights :: Unlockable p m => Ob.Patp -> Azimuth p m Rights getRights patp = withContract azimuth $ do   let unzero x = if isZeroAddress x then Nothing else Just x       point    = Ob.patpToPoint patp@@ -73,35 +74,35 @@   pure Rights { .. }  -- | Get the number of points a point has spawned.-getSpawnCount :: JsonRpc m => Ob.Patp -> Azimuth m Natural+getSpawnCount :: Unlockable p m => Ob.Patp -> Azimuth p m Natural getSpawnCount patp = withContract azimuth $ do   let point = Ob.patpToPoint patp   count <- I.getSpawnCount point   pure $ fromIntegral count  -- | Get a list of points that a point has spawned.-getSpawned :: JsonRpc m => Ob.Patp -> Azimuth m [Ob.Patp]+getSpawned :: Unlockable p m => Ob.Patp -> Azimuth p m [Ob.Patp] getSpawned patp = withContract azimuth $ do   let point = Ob.patpToPoint patp   children <- I.getSpawned point   pure $ fmap Ob.pointToPatp children  -- | Get a list of points that a point is sponsoring.-getSponsoring :: JsonRpc m => Ob.Patp -> Azimuth m [Ob.Patp]+getSponsoring :: Unlockable p m => Ob.Patp -> Azimuth p m [Ob.Patp] getSponsoring patp = withContract azimuth $ do   let point = Ob.patpToPoint patp   children <- I.getSponsoring point   pure $ fmap Ob.pointToPatp children  -- | Get the number of points a point is sponsoring.-getSponsoringCount :: JsonRpc m => Ob.Patp -> Azimuth m Natural+getSponsoringCount :: Unlockable p m => Ob.Patp -> Azimuth p m Natural getSponsoringCount patp = withContract azimuth $ do   let point = Ob.patpToPoint patp   count <- I.getSponsoringCount point   pure $ fromIntegral count  -- | Get a list of points that are requesting escape from a point.-getEscapeRequests :: JsonRpc m => Ob.Patp -> Azimuth m [Ob.Patp]+getEscapeRequests :: Unlockable p m => Ob.Patp -> Azimuth p m [Ob.Patp] getEscapeRequests patp = withContract azimuth $ do   let point = Ob.patpToPoint patp   children <- I.getEscapeRequests point@@ -109,76 +110,76 @@  -- | Get the number of points that are requesting escape from a point. getEscapeRequestsCount-  :: JsonRpc m+  :: Unlockable p m   => Ob.Patp-  -> Azimuth m Natural+  -> Azimuth p m Natural getEscapeRequestsCount patp = withContract azimuth $ do   let point = Ob.patpToPoint patp   count <- I.getEscapeRequestsCount point   pure $ fromIntegral count  -- | Get a list of points that an address owns.-getOwnedPoints :: JsonRpc m => Address -> Azimuth m [Ob.Patp]+getOwnedPoints :: Unlockable p m => Address -> Azimuth p m [Ob.Patp] getOwnedPoints addr = withContract azimuth $ do   children <- I.getOwnedPoints addr   pure $ fmap Ob.pointToPatp children  -- | Get the number of points that an address owns.-getOwnedPointCount :: JsonRpc m => Address -> Azimuth m Natural+getOwnedPointCount :: Unlockable p m => Address -> Azimuth p m Natural getOwnedPointCount addr = withContract azimuth $ do   count <- I.getOwnedPointCount addr   pure $ fromIntegral count  -- | Get a list of points that an address manages.-getManagerFor :: JsonRpc m => Address -> Azimuth m [Ob.Patp]+getManagerFor :: Unlockable p m => Address -> Azimuth p m [Ob.Patp] getManagerFor addr = withContract azimuth $ do   children <- I.getManagerFor addr   pure $ fmap Ob.pointToPatp children  -- | Get the number of points that an address manages.-getManagerForCount :: JsonRpc m => Address -> Azimuth m Natural+getManagerForCount :: Unlockable p m => Address -> Azimuth p m Natural getManagerForCount addr = withContract azimuth $ do   count <- I.getManagerForCount addr   pure $ fromIntegral count  -- | Get a list of points that an address can vote on behalf of.-getVotingFor :: JsonRpc m => Address -> Azimuth m [Ob.Patp]+getVotingFor :: Unlockable p m => Address -> Azimuth p m [Ob.Patp] getVotingFor addr = withContract azimuth $ do   children <- I.getVotingFor addr   pure $ fmap Ob.pointToPatp children  -- | Get the number of points that an address can vote on behalf of.-getVotingForCount :: JsonRpc m => Address -> Azimuth m Natural+getVotingForCount :: Unlockable p m => Address -> Azimuth p m Natural getVotingForCount addr = withContract azimuth $ do   count <- I.getVotingForCount addr   pure $ fromIntegral count  -- | Get a list of points that an address is a spawn proxy for.-getSpawningFor :: JsonRpc m => Address -> Azimuth m [Ob.Patp]+getSpawningFor :: Unlockable p m => Address -> Azimuth p m [Ob.Patp] getSpawningFor addr = withContract azimuth $ do   children <- I.getSpawningFor addr   pure $ fmap Ob.pointToPatp children  -- | Get the number of points that an address is a spawn proxy for.-getSpawningForCount :: JsonRpc m => Address -> Azimuth m Natural+getSpawningForCount :: Unlockable p m => Address -> Azimuth p m Natural getSpawningForCount addr = withContract azimuth $ do   count <- I.getSpawningForCount addr   pure $ fromIntegral count  -- | Get a list of points that an address is a transfer proxy for. getTransferringFor-  :: JsonRpc m+  :: Unlockable p m   => Address-  -> Azimuth m [Ob.Patp]+  -> Azimuth p m [Ob.Patp] getTransferringFor addr = withContract azimuth $ do   children <- I.getTransferringFor addr   pure $ fmap Ob.pointToPatp children  -- | Get the number of points that an address is a transfer proxy for. getTransferringForCount-  :: JsonRpc m+  :: Unlockable p m   => Address-  -> Azimuth m Natural+  -> Azimuth p m Natural getTransferringForCount addr = withContract azimuth $ do   count <- I.getTransferringForCount addr   pure $ fromIntegral count
lib/Urbit/Azimuth/Contract.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}@@ -16,11 +17,11 @@ import Control.Monad.Trans (lift) import Control.Monad.Reader (ReaderT(..), ask) import Data.Solidity.Prim.Address (Address)-import Network.Ethereum.Account (LocalKeyAccount, LocalKey, withAccount) import qualified Network.Ethereum.Account as Ethereum.Account import qualified Network.Ethereum.Account.Internal as AI import qualified Network.Ethereum.Ens as Ethereum.Ens import Network.JsonRpc.TinyClient (JsonRpc)+import Urbit.Azimuth.Account  -- | Supported Azimuth contracts. data Contracts = Contracts {@@ -30,16 +31,16 @@  -- | The Azimuth type represents an authenticated connection to a JSON RPC by --   way of a local private key, and has access to a 'Contracts' object.-newtype Azimuth m a =-    Azimuth (ReaderT Contracts (LocalKeyAccount m) a)+newtype Azimuth p m a =+    Azimuth (ReaderT Contracts (AI.AccountT p m) a)   deriving newtype (Functor, Applicative, Monad)  -- | Run an Azimuth action. runAzimuth-  :: JsonRpc m+  :: Unlockable p m   => Contracts-  -> LocalKey-  -> Azimuth m a+  -> p+  -> Azimuth p m a   -> m a runAzimuth contracts account (Azimuth action) = withAccount account $   runReaderT action contracts@@ -53,10 +54,10 @@  -- | Perform an Azimuth action, targeting the appropriate contract. withContract-  :: Monad m+  :: Unlockable p m   => (Contracts -> Address)-  -> LocalKeyAccount m a-  -> Azimuth m a+  -> AI.AccountT p m a+  -> Azimuth p m a withContract selector action = Azimuth $ do   contracts <- ask   lift $ Ethereum.Account.withParam (\param -> param {
lib/Urbit/Azimuth/Ecliptic.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecordWildCards #-}  module Urbit.Azimuth.Ecliptic (@@ -33,8 +34,8 @@  import qualified Data.Text as T import qualified Network.Ethereum.Api.Types as Api-import Network.JsonRpc.TinyClient (JsonRpc) import Numeric.Natural+import Urbit.Azimuth.Account import Urbit.Azimuth.Contract import qualified Urbit.Azimuth.Ecliptic.Internal as I import Urbit.Azimuth.Point@@ -60,32 +61,32 @@   deriving stock (Eq, Show)  -- | Check if a point is active.-exists :: JsonRpc m => Ob.Patp -> Azimuth m Bool+exists :: Unlockable p m => Ob.Patp -> Azimuth p m Bool exists patp = withContract ecliptic $ do   let point = Ob.patpToSolidity256 patp   I.exists point  -- | Get the approved transfer proxy for a point.-getApproved :: JsonRpc m => Ob.Patp -> Azimuth m Address+getApproved :: Unlockable p m => Ob.Patp -> Azimuth p m Address getApproved patp = withContract ecliptic $ do   let point = Ob.patpToSolidity256 patp   I.getApproved point  -- | Check if an address is an operator for an owner. isApprovedForAll-  :: JsonRpc m+  :: Unlockable p m   => Address   -> Address-  -> Azimuth m Bool+  -> Azimuth p m Bool isApprovedForAll owner operator = withContract ecliptic $   I.isApprovedForAll owner operator  -- | Get the total number of children a point can spawn at some time. getSpawnLimit-  :: JsonRpc m+  :: Unlockable p m   => Ob.Patp   -> Natural-  -> Azimuth m Natural+  -> Azimuth p m Natural getSpawnLimit patp time = withContract ecliptic $ do   let point = Ob.patpToPoint patp   limit <- I.getSpawnLimit point (fromIntegral time)@@ -93,10 +94,10 @@  -- | Check if a point can escape to a sponsor. canEscapeTo-  :: JsonRpc m+  :: Unlockable p m   => Ob.Patp   -> Ob.Patp-  -> Azimuth m Bool+  -> Azimuth p m Bool canEscapeTo point sponsor = withContract ecliptic $ do   let pt = Ob.patpToPoint point       sp = Ob.patpToPoint sponsor@@ -105,32 +106,32 @@ -- | Safely transfer a point between addresses (call recipient if it's a --   contract). safeTransferFrom-  :: JsonRpc m+  :: Unlockable p m   => Address   -> Address   -> Ob.Patp-  -> Azimuth m Api.TxReceipt+  -> Azimuth p m Api.TxReceipt safeTransferFrom from to point = withContract ecliptic $ do   let pt = Ob.patpToSolidity256 point   I.safeTransferFrom from to pt  -- | Transfer a point between addresses (without notifying recipient contract). transferFrom-  :: JsonRpc m+  :: Unlockable p m   => Address   -> Address   -> Ob.Patp-  -> Azimuth m Api.TxReceipt+  -> Azimuth p m Api.TxReceipt transferFrom from to point = withContract ecliptic $ do   let pt = Ob.patpToSolidity256 point   I.transferFrom from to pt  -- | Approve an address to transfer ownership of a point. approve-  :: JsonRpc m+  :: Unlockable p m   => Address   -> Ob.Patp-  -> Azimuth m Api.TxReceipt+  -> Azimuth p m Api.TxReceipt approve addr point = withContract ecliptic $ do   let pt = Ob.patpToSolidity256 point   I.approve addr pt@@ -138,30 +139,30 @@ -- | Allow or disallow an operator to transfer ownership of all points owned by --   the message sender. setApprovalForAll-  :: JsonRpc m+  :: Unlockable p m   => Address   -> Approval-  -> Azimuth m Api.TxReceipt+  -> Azimuth p m Api.TxReceipt setApprovalForAll addr approval = withContract ecliptic $   I.setApprovalForAll addr (approval == Approved)  -- | Configure the management address for a point owned by the message sender. setManagementProxy-  :: JsonRpc m+  :: Unlockable p m   => Ob.Patp   -> Address-  -> Azimuth m Api.TxReceipt+  -> Azimuth p m Api.TxReceipt setManagementProxy patp addr = withContract ecliptic $ do   let pt = Ob.patpToPoint patp   I.setManagementProxy pt addr  -- | Configure a point's keys, optionally incrementing the continuity number. configureKeys-  :: JsonRpc m+  :: Unlockable p m   => Ob.Patp   -> Keys   -> RevisionType-  -> Azimuth m Api.TxReceipt+  -> Azimuth p m Api.TxReceipt configureKeys patp Keys {..} breach = do   let point = Ob.patpToPoint patp       ck    = fromCryptKey keyCrypt@@ -173,20 +174,20 @@  -- | Spawn a point, giving ownership of it to the target address. spawn-  :: JsonRpc m+  :: Unlockable p m   => Ob.Patp   -> Address-  -> Azimuth m Api.TxReceipt+  -> Azimuth p m Api.TxReceipt spawn point addr = withContract ecliptic $ do   let pt = Ob.patpToPoint point   I.spawn pt addr  -- | Give an address the right to spawn points with the given prefix. setSpawnProxy-  :: JsonRpc m+  :: Unlockable p m   => Ob.Patp   -> Address-  -> Azimuth m Api.TxReceipt+  -> Azimuth p m Api.TxReceipt setSpawnProxy patp addr = case Ob.patpToSolidity16 patp of   -- NB a proper way to handle this sort of error would be nice   Left _    -> error (show patp <> " is not a star or galaxy")@@ -194,11 +195,11 @@  -- | Transfer a point between addresses (without notifying recipient contract). transferPoint-  :: JsonRpc m+  :: Unlockable p m   => Ob.Patp   -> Address   -> Reset-  -> Azimuth m Api.TxReceipt+  -> Azimuth p m Api.TxReceipt transferPoint point addr reset = withContract ecliptic $ do   let pt = Ob.patpToPoint point   I.transferPoint pt addr (reset == Clear)@@ -206,20 +207,20 @@ -- | Configure the transfer proxy address for a point owned by the message --   sender. setTransferProxy-  :: JsonRpc m+  :: Unlockable p m   => Ob.Patp   -> Address-  -> Azimuth m Api.TxReceipt+  -> Azimuth p m Api.TxReceipt setTransferProxy patp addr = withContract ecliptic $ do   let pt = Ob.patpToPoint patp   I.setTransferProxy pt addr  -- | Request escape from 'point' to 'sponsor'. escape-  :: JsonRpc m+  :: Unlockable p m   => Ob.Patp   -> Ob.Patp-  -> Azimuth m Api.TxReceipt+  -> Azimuth p m Api.TxReceipt escape point sponsor = withContract ecliptic $ do   let pt = Ob.patpToPoint point       sp = Ob.patpToPoint sponsor@@ -227,36 +228,36 @@  -- | Cancel a point's escape request. cancelEscape-  :: JsonRpc m+  :: Unlockable p m   => Ob.Patp-  -> Azimuth m Api.TxReceipt+  -> Azimuth p m Api.TxReceipt cancelEscape point = withContract ecliptic $ do   let pt = Ob.patpToPoint point   I.cancelEscape pt  -- | As a sponsor, accept a point's escape request. adopt-  :: JsonRpc m+  :: Unlockable p m   => Ob.Patp-  -> Azimuth m Api.TxReceipt+  -> Azimuth p m Api.TxReceipt adopt escapee = withContract ecliptic $ do   let pt = Ob.patpToPoint escapee   I.adopt pt  -- | As a sponsor, reject a point's escape request. reject-  :: JsonRpc m+  :: Unlockable p m   => Ob.Patp-  -> Azimuth m Api.TxReceipt+  -> Azimuth p m Api.TxReceipt reject escapee = withContract ecliptic $ do   let pt = Ob.patpToPoint escapee   I.reject pt  -- | As a sponsor, stop sponsoring a point. detach-  :: JsonRpc m+  :: Unlockable p m   => Ob.Patp-  -> Azimuth m Api.TxReceipt+  -> Azimuth p m Api.TxReceipt detach escapee = withContract ecliptic $ do   let pt = Ob.patpToPoint escapee   I.detach pt@@ -264,10 +265,10 @@ -- | Configure the voting proxy address for a point owned by the message --   sender. setVotingProxy-  :: JsonRpc m+  :: Unlockable p m   => Ob.Patp   -> Address-  -> Azimuth m Api.TxReceipt+  -> Azimuth p m Api.TxReceipt setVotingProxy patp addr = case Ob.patpToGalaxy patp of   -- NB a proper way to handle this sort of error would be nice   Left _    -> error (show patp <> " is not a galaxy")@@ -275,20 +276,20 @@  -- | Set primary, secondary, and tertiary DNS domains for the ecliptic. setDnsDomains-  :: JsonRpc m+  :: Unlockable p m   => T.Text   -> T.Text   -> T.Text-  -> Azimuth m Api.TxReceipt+  -> Azimuth p m Api.TxReceipt setDnsDomains prim seco tert = withContract ecliptic $   I.setDnsDomains prim seco tert  -- | Create the specified galaxy. createGalaxy-  :: JsonRpc m+  :: Unlockable p m   => Ob.Patp   -> Address-  -> Azimuth m Api.TxReceipt+  -> Azimuth p m Api.TxReceipt createGalaxy patp addr = case Ob.patpToGalaxy patp of   -- NB a proper way to handle this sort of error would be nice   Left _    -> error (show patp <> " is not a galaxy")
test/Doc.hs view
@@ -16,24 +16,32 @@   endpoint  <- A.defaultSettings infura   contracts <- A.runWeb3 endpoint A.getContracts +  let zod = Ob.patp 0+      nec = Ob.patp 1++  -- fetch ~zod's public info, using endpoint's default account+  zodInfo <- A.runWeb3 endpoint $+    A.runAzimuth contracts () $+      A.getPoint zod++  -- to use an account..+   -- use a test mnemonic   let mnem = "benefit crew supreme gesture quantum "           <> "web media hazard theory mercy wing kitten" -  -- and a standard HD path (m/44'/60'/0'/0/0)-  let hdpath  = A.Deriv A.:| 44 A.:| 60 A.:| 0 A.:/ 0 A.:/ 0+  -- and a standard HD path+  let hdpath  = "m/44'/60'/0'/0/0" :: A.DerivPath -  -- unlock the corresponding account   let account = case A.toPrivateKey mnem mempty hdpath of         Left _    -> error "bogus creds"         Right acc -> acc -  let zod = Ob.patp 0--  -- fetch ~zod's public info-  point <- A.runWeb3 endpoint $+  -- fetch ~nec's public info, using a local account+  necInfo <- A.runWeb3 endpoint $     A.runAzimuth contracts account $       A.getPoint zod -  -- print it-  print point+  -- print the details+  print zodInfo+  print necInfo