move share hash types into Unison.Share.API.Hash

(awkwardly / temporarily in `unison-share-projects-api` package)

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

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:
 --

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)

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

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
 

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

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` ;)

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

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

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)
 

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