From 22a3ee5970a8a040b485929939d54dca0216fd46 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Mon, 6 Mar 2023 11:22:26 -0500 Subject: [PATCH] move share hash types into `Unison.Share.API.Hash` (awkwardly / temporarily in `unison-share-projects-api` package) --- .../Editor/HandleInput/ProjectClone.hs | 7 +- .../Codebase/Editor/HandleInput/Push.hs | 6 +- unison-cli/src/Unison/Share/Sync.hs | 1 + unison-share-api/package.yaml | 1 + unison-share-api/src/Unison/Sync/Types.hs | 101 +--------------- unison-share-api/unison-share-api.cabal | 1 + unison-share-projects-api/README.md | 4 + unison-share-projects-api/package.yaml | 5 + .../src/Unison/Share/API/Hash.hs | 114 ++++++++++++++++++ .../src/Unison/Share/API/Projects.hs | 3 +- .../unison-share-projects-api.cabal | 6 + 11 files changed, 143 insertions(+), 106 deletions(-) create mode 100644 unison-share-projects-api/src/Unison/Share/API/Hash.hs diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs index 0238cff80..a09c267ea 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs @@ -21,10 +21,11 @@ import qualified Unison.Codebase.Editor.Output as Output import qualified Unison.Codebase.Path as Path import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectName, projectNameUserSlug) +import qualified Unison.Share.API.Hash as Share.API import qualified Unison.Share.API.Projects as Share.API import qualified Unison.Share.Sync as Share (downloadEntities) import Unison.Sync.Common (hash32ToCausalHash) -import qualified Unison.Sync.Types as Share (RepoName (..), hashJWTHash) +import qualified Unison.Sync.Types as Share (RepoName (..)) import Witch (unsafeFrom) -- | Clone a remote project. @@ -70,8 +71,8 @@ projectClone projectName = do Share.API.GetProjectBranchResponseSuccess projectBranch -> pure projectBranch -- FIXME remote project branch should have HashJWT - let remoteBranchHeadJwt = wundefined (remoteProjectBranch ^. #branchHead) - let remoteBranchHead = Share.hashJWTHash remoteBranchHeadJwt + let remoteBranchHeadJwt = remoteProjectBranch ^. #branchHead + let remoteBranchHead = Share.API.hashJWTHash remoteBranchHeadJwt -- Pull the remote branch's contents Cli.with HandleInput.Pull.withEntitiesDownloadedProgressCallback \downloadedCallback -> do diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs index e7ba4c8ec..15c291186 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs @@ -66,6 +66,7 @@ import Unison.Project projectBranchNameUserSlug, projectNameUserSlug, ) +import qualified Unison.Share.API.Hash as Share.API import qualified Unison.Share.API.Projects as Share.API import qualified Unison.Share.Codeserver as Codeserver import qualified Unison.Share.Sync as Share @@ -276,7 +277,7 @@ pushLooseCodeToShareLooseCode localPath remote@WriteShareRemotePath {server, rep (Cli.returnEarly . Output.ShareError) case err0 of Share.SyncError err -> ShareErrorGetCausalHashByPath err Share.TransportError err -> ShareErrorTransport err - checkAndSetPush (Share.hashJWTHash <$> maybeHashJwt) + checkAndSetPush (Share.API.hashJWTHash <$> maybeHashJwt) Cli.respond (ViewOnShare remote) PushBehavior.RequireEmpty -> do checkAndSetPush Nothing @@ -679,7 +680,8 @@ makeFastForwardAfterUploadAction pushing localBranchHead remoteBranch = do (Text.pack (Servant.Client.showBaseUrl Share.hardCodedBaseUrl)) (remoteBranch ^. #branchId . to RemoteProjectBranchId) where - remoteBranchHead = remoteBranch ^. #branchHead + remoteBranchHead = + Share.API.hashJWTHash (remoteBranch ^. #branchHead) -- A couple example repo names derived from the project/branch names: -- diff --git a/unison-cli/src/Unison/Share/Sync.hs b/unison-cli/src/Unison/Share/Sync.hs index 0d117cf33..70582fa54 100644 --- a/unison-cli/src/Unison/Share/Sync.hs +++ b/unison-cli/src/Unison/Share/Sync.hs @@ -58,6 +58,7 @@ import qualified Unison.Codebase as Codebase import qualified Unison.Debug as Debug import Unison.Hash32 (Hash32) import Unison.Prelude +import qualified Unison.Share.API.Hash as Share import Unison.Share.Sync.Types import qualified Unison.Sqlite as Sqlite import qualified Unison.Sync.API as Share (API) diff --git a/unison-share-api/package.yaml b/unison-share-api/package.yaml index fbbd504ab..acae4f6e7 100644 --- a/unison-share-api/package.yaml +++ b/unison-share-api/package.yaml @@ -51,6 +51,7 @@ dependencies: - unison-pretty-printer - unison-util-base32hex - unison-util-relation + - unison-share-projects-api - unison-sqlite - unison-syntax - unliftio diff --git a/unison-share-api/src/Unison/Sync/Types.hs b/unison-share-api/src/Unison/Sync/Types.hs index 91a10766f..428edfa1e 100644 --- a/unison-share-api/src/Unison/Sync/Types.hs +++ b/unison-share-api/src/Unison/Sync/Types.hs @@ -11,15 +11,6 @@ module Unison.Sync.Types pathRepoName, pathCodebasePath, - -- ** Hash types - HashJWT (..), - hashJWTHash, - HashJWTClaims (..), - DecodedHashJWT (..), - decodeHashJWT, - decodeHashJWTClaims, - decodedHashJWTHash, - -- ** Entity types Entity (..), TermComponent (..), @@ -87,6 +78,7 @@ import qualified Data.Map.Strict as Map import qualified Data.Set as Set import Data.Set.NonEmpty (NESet) import qualified Data.Text as Text +import Unison.Share.API.Hash (HashJWT) import qualified Data.Text.Encoding as Text import Servant.Auth.JWT import Unison.Hash32 (Hash32) @@ -138,97 +130,6 @@ instance FromJSON Path where pathSegments <- obj .: "path" pure Path {..} ------------------------------------------------------------------------------------------------------------------------- --- Hash types - -newtype HashJWT = HashJWT {unHashJWT :: Text} - deriving newtype (Show, Eq, Ord, ToJSON, FromJSON) - --- | Grab the hash out of a hash JWT. --- --- This decodes the whole JWT, then throws away the claims; use it if you really only need the hash! -hashJWTHash :: HashJWT -> Hash32 -hashJWTHash = - decodedHashJWTHash . decodeHashJWT - -data HashJWTClaims = HashJWTClaims - { hash :: Hash32, - userId :: Maybe Text - } - deriving stock (Show, Eq, Ord) - --- | Adding a type tag to the jwt prevents users from using jwts we issue for other things --- in this spot. All of our jwts should have a type parameter of some kind. -hashJWTType :: String -hashJWTType = "hj" - -instance ToJWT HashJWTClaims where - encodeJWT (HashJWTClaims h u) = - Jose.emptyClaimsSet - & Jose.addClaim "h" (toJSON h) - & Jose.addClaim "u" (toJSON u) - & Jose.addClaim "t" (toJSON hashJWTType) - -instance FromJWT HashJWTClaims where - decodeJWT claims = maybe (Left "Invalid HashJWTClaims") pure $ do - hash <- claims ^? Jose.unregisteredClaims . ix "h" . folding fromJSON - userId <- claims ^? Jose.unregisteredClaims . ix "u" . folding fromJSON - case claims ^? Jose.unregisteredClaims . ix "t" . folding fromJSON of - Just t | t == hashJWTType -> pure () - _ -> empty - pure $ HashJWTClaims {..} - -instance ToJSON HashJWTClaims where - toJSON (HashJWTClaims hash userId) = - object - [ "h" .= hash, - "u" .= userId - ] - -instance FromJSON HashJWTClaims where - parseJSON = Aeson.withObject "HashJWTClaims" \obj -> do - hash <- obj .: "h" - userId <- obj .: "u" - pure HashJWTClaims {..} - --- | A decoded hash JWT that retains the original encoded JWT. -data DecodedHashJWT = DecodedHashJWT - { claims :: HashJWTClaims, - hashJWT :: HashJWT - } - deriving (Eq, Ord, Show) - --- | Decode a hash JWT. -decodeHashJWT :: HashJWT -> DecodedHashJWT -decodeHashJWT hashJWT = - DecodedHashJWT - { claims = decodeHashJWTClaims hashJWT, - hashJWT - } - --- | Decode the claims out of a hash JWT. -decodeHashJWTClaims :: HashJWT -> HashJWTClaims -decodeHashJWTClaims (HashJWT text) = - case JWT.decode text of - Nothing -> error "bad JWT" - Just jwt -> - let object = - jwt - & JWT.claims - & JWT.unregisteredClaims - & JWT.unClaimsMap - & Map.toList - & HashMap.fromList - & Aeson.Object - in case Aeson.fromJSON object of - Aeson.Error err -> error ("bad JWT: " ++ err) - Aeson.Success claims -> claims - --- | Grab the hash out of a decoded hash JWT. -decodedHashJWTHash :: DecodedHashJWT -> Hash32 -decodedHashJWTHash DecodedHashJWT {claims = HashJWTClaims {hash}} = - hash - ------------------------------------------------------------------------------------------------------------------------ -- Entity types diff --git a/unison-share-api/unison-share-api.cabal b/unison-share-api/unison-share-api.cabal index 83b38de3f..e4211d7fc 100644 --- a/unison-share-api/unison-share-api.cabal +++ b/unison-share-api/unison-share-api.cabal @@ -110,6 +110,7 @@ library , unison-parser-typechecker , unison-prelude , unison-pretty-printer + , unison-share-projects-api , unison-sqlite , unison-syntax , unison-util-base32hex diff --git a/unison-share-projects-api/README.md b/unison-share-projects-api/README.md index ac8bdbfff..c1594f328 100644 --- a/unison-share-projects-api/README.md +++ b/unison-share-projects-api/README.md @@ -8,3 +8,7 @@ has a ton of non-Share-API related modules and functionality in it. So rather than rename it, or rip modules out, or anything like that, we decided to make this new package, which should be deleted eventually. + +Small complication: it was discovered that the projects API needs to depend on the `HashJWT` type, which was previously +in the `unison-share-api`. That type has been pulled down here into a module called `Unison.Share.API.Hash`. So already, +`unison-share-projects-api` is a bit of a misnomer: it's really `unison-share-api-for-real-this-time` ;) diff --git a/unison-share-projects-api/package.yaml b/unison-share-projects-api/package.yaml index 6030a47b0..c36523e11 100644 --- a/unison-share-projects-api/package.yaml +++ b/unison-share-projects-api/package.yaml @@ -11,7 +11,12 @@ library: dependencies: - aeson - base + - containers + - jose + - jwt + - lens - servant + - servant-auth - text - unison-hash - unison-hash-orphans-aeson diff --git a/unison-share-projects-api/src/Unison/Share/API/Hash.hs b/unison-share-projects-api/src/Unison/Share/API/Hash.hs new file mode 100644 index 000000000..bdddf983b --- /dev/null +++ b/unison-share-projects-api/src/Unison/Share/API/Hash.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE RecordWildCards #-} + +-- | Hash-related types in the Share API. +module Unison.Share.API.Hash + ( -- * Hash types + HashJWT (..), + hashJWTHash, + HashJWTClaims (..), + DecodedHashJWT (..), + decodeHashJWT, + decodeHashJWTClaims, + decodedHashJWTHash, + ) +where + +import Control.Lens (folding, ix, (^?)) +import qualified Crypto.JWT as Jose +import Data.Aeson +import qualified Data.Aeson as Aeson +import qualified Data.HashMap.Strict as HashMap +import qualified Data.Map.Strict as Map +import qualified Servant.Auth.JWT as Servant.Auth +import Unison.Hash32 (Hash32) +import Unison.Hash32.Orphans.Aeson () +import Unison.Prelude +import qualified Web.JWT as JWT + +newtype HashJWT = HashJWT {unHashJWT :: Text} + deriving newtype (Show, Eq, Ord, ToJSON, FromJSON) + +-- | Grab the hash out of a hash JWT. +-- +-- This decodes the whole JWT, then throws away the claims; use it if you really only need the hash! +hashJWTHash :: HashJWT -> Hash32 +hashJWTHash = + decodedHashJWTHash . decodeHashJWT + +data HashJWTClaims = HashJWTClaims + { hash :: Hash32, + userId :: Maybe Text + } + deriving stock (Show, Eq, Ord) + +-- | Adding a type tag to the jwt prevents users from using jwts we issue for other things +-- in this spot. All of our jwts should have a type parameter of some kind. +hashJWTType :: String +hashJWTType = "hj" + +instance Servant.Auth.ToJWT HashJWTClaims where + encodeJWT (HashJWTClaims h u) = + Jose.emptyClaimsSet + & Jose.addClaim "h" (toJSON h) + & Jose.addClaim "u" (toJSON u) + & Jose.addClaim "t" (toJSON hashJWTType) + +instance Servant.Auth.FromJWT HashJWTClaims where + decodeJWT claims = maybe (Left "Invalid HashJWTClaims") pure $ do + hash <- claims ^? Jose.unregisteredClaims . ix "h" . folding fromJSON + userId <- claims ^? Jose.unregisteredClaims . ix "u" . folding fromJSON + case claims ^? Jose.unregisteredClaims . ix "t" . folding fromJSON of + Just t | t == hashJWTType -> pure () + _ -> empty + pure HashJWTClaims {..} + +instance ToJSON HashJWTClaims where + toJSON (HashJWTClaims hash userId) = + object + [ "h" .= hash, + "u" .= userId + ] + +instance FromJSON HashJWTClaims where + parseJSON = Aeson.withObject "HashJWTClaims" \obj -> do + hash <- obj .: "h" + userId <- obj .: "u" + pure HashJWTClaims {..} + +-- | A decoded hash JWT that retains the original encoded JWT. +data DecodedHashJWT = DecodedHashJWT + { claims :: HashJWTClaims, + hashJWT :: HashJWT + } + deriving (Eq, Ord, Show) + +-- | Decode a hash JWT. +decodeHashJWT :: HashJWT -> DecodedHashJWT +decodeHashJWT hashJWT = + DecodedHashJWT + { claims = decodeHashJWTClaims hashJWT, + hashJWT + } + +-- | Decode the claims out of a hash JWT. +decodeHashJWTClaims :: HashJWT -> HashJWTClaims +decodeHashJWTClaims (HashJWT text) = + case JWT.decode text of + Nothing -> error "bad JWT" + Just jwt -> + let object = + jwt + & JWT.claims + & JWT.unregisteredClaims + & JWT.unClaimsMap + & Map.toList + & HashMap.fromList + & Aeson.Object + in case Aeson.fromJSON object of + Aeson.Error err -> error ("bad JWT: " ++ err) + Aeson.Success claims -> claims + +-- | Grab the hash out of a decoded hash JWT. +decodedHashJWTHash :: DecodedHashJWT -> Hash32 +decodedHashJWTHash DecodedHashJWT {claims = HashJWTClaims {hash}} = + hash diff --git a/unison-share-projects-api/src/Unison/Share/API/Projects.hs b/unison-share-projects-api/src/Unison/Share/API/Projects.hs index deab49878..931396431 100644 --- a/unison-share-projects-api/src/Unison/Share/API/Projects.hs +++ b/unison-share-projects-api/src/Unison/Share/API/Projects.hs @@ -46,6 +46,7 @@ import Servant.API import Unison.Hash32 (Hash32) import Unison.Hash32.Orphans.Aeson () import Unison.Prelude +import Unison.Share.API.Hash (HashJWT) type ProjectsAPI = GetProjectAPI @@ -342,7 +343,7 @@ data ProjectBranch = ProjectBranch projectName :: Text, branchId :: Text, branchName :: Text, - branchHead :: Hash32 + branchHead :: HashJWT } deriving stock (Eq, Show, Generic) diff --git a/unison-share-projects-api/unison-share-projects-api.cabal b/unison-share-projects-api/unison-share-projects-api.cabal index 11938a890..a0f432cd2 100644 --- a/unison-share-projects-api/unison-share-projects-api.cabal +++ b/unison-share-projects-api/unison-share-projects-api.cabal @@ -17,6 +17,7 @@ source-repository head library exposed-modules: + Unison.Share.API.Hash Unison.Share.API.Projects hs-source-dirs: src @@ -52,7 +53,12 @@ library build-depends: aeson , base + , containers + , jose + , jwt + , lens , servant + , servant-auth , text , unison-hash , unison-hash-orphans-aeson