mirror of
https://github.com/unisonweb/unison.git
synced 2024-08-15 21:40:50 +03:00
move share hash types into Unison.Share.API.Hash
(awkwardly / temporarily in `unison-share-projects-api` package)
This commit is contained in:
parent
9b6b8b108b
commit
22a3ee5970
@ -21,10 +21,11 @@ import qualified Unison.Codebase.Editor.Output as Output
|
|||||||
import qualified Unison.Codebase.Path as Path
|
import qualified Unison.Codebase.Path as Path
|
||||||
import Unison.Prelude
|
import Unison.Prelude
|
||||||
import Unison.Project (ProjectAndBranch (..), ProjectName, projectNameUserSlug)
|
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.API.Projects as Share.API
|
||||||
import qualified Unison.Share.Sync as Share (downloadEntities)
|
import qualified Unison.Share.Sync as Share (downloadEntities)
|
||||||
import Unison.Sync.Common (hash32ToCausalHash)
|
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)
|
import Witch (unsafeFrom)
|
||||||
|
|
||||||
-- | Clone a remote project.
|
-- | Clone a remote project.
|
||||||
@ -70,8 +71,8 @@ projectClone projectName = do
|
|||||||
Share.API.GetProjectBranchResponseSuccess projectBranch -> pure projectBranch
|
Share.API.GetProjectBranchResponseSuccess projectBranch -> pure projectBranch
|
||||||
|
|
||||||
-- FIXME remote project branch should have HashJWT
|
-- FIXME remote project branch should have HashJWT
|
||||||
let remoteBranchHeadJwt = wundefined (remoteProjectBranch ^. #branchHead)
|
let remoteBranchHeadJwt = remoteProjectBranch ^. #branchHead
|
||||||
let remoteBranchHead = Share.hashJWTHash remoteBranchHeadJwt
|
let remoteBranchHead = Share.API.hashJWTHash remoteBranchHeadJwt
|
||||||
|
|
||||||
-- Pull the remote branch's contents
|
-- Pull the remote branch's contents
|
||||||
Cli.with HandleInput.Pull.withEntitiesDownloadedProgressCallback \downloadedCallback -> do
|
Cli.with HandleInput.Pull.withEntitiesDownloadedProgressCallback \downloadedCallback -> do
|
||||||
|
@ -66,6 +66,7 @@ import Unison.Project
|
|||||||
projectBranchNameUserSlug,
|
projectBranchNameUserSlug,
|
||||||
projectNameUserSlug,
|
projectNameUserSlug,
|
||||||
)
|
)
|
||||||
|
import qualified Unison.Share.API.Hash as Share.API
|
||||||
import qualified Unison.Share.API.Projects as Share.API
|
import qualified Unison.Share.API.Projects as Share.API
|
||||||
import qualified Unison.Share.Codeserver as Codeserver
|
import qualified Unison.Share.Codeserver as Codeserver
|
||||||
import qualified Unison.Share.Sync as Share
|
import qualified Unison.Share.Sync as Share
|
||||||
@ -276,7 +277,7 @@ pushLooseCodeToShareLooseCode localPath remote@WriteShareRemotePath {server, rep
|
|||||||
(Cli.returnEarly . Output.ShareError) case err0 of
|
(Cli.returnEarly . Output.ShareError) case err0 of
|
||||||
Share.SyncError err -> ShareErrorGetCausalHashByPath err
|
Share.SyncError err -> ShareErrorGetCausalHashByPath err
|
||||||
Share.TransportError err -> ShareErrorTransport err
|
Share.TransportError err -> ShareErrorTransport err
|
||||||
checkAndSetPush (Share.hashJWTHash <$> maybeHashJwt)
|
checkAndSetPush (Share.API.hashJWTHash <$> maybeHashJwt)
|
||||||
Cli.respond (ViewOnShare remote)
|
Cli.respond (ViewOnShare remote)
|
||||||
PushBehavior.RequireEmpty -> do
|
PushBehavior.RequireEmpty -> do
|
||||||
checkAndSetPush Nothing
|
checkAndSetPush Nothing
|
||||||
@ -679,7 +680,8 @@ makeFastForwardAfterUploadAction pushing localBranchHead remoteBranch = do
|
|||||||
(Text.pack (Servant.Client.showBaseUrl Share.hardCodedBaseUrl))
|
(Text.pack (Servant.Client.showBaseUrl Share.hardCodedBaseUrl))
|
||||||
(remoteBranch ^. #branchId . to RemoteProjectBranchId)
|
(remoteBranch ^. #branchId . to RemoteProjectBranchId)
|
||||||
where
|
where
|
||||||
remoteBranchHead = remoteBranch ^. #branchHead
|
remoteBranchHead =
|
||||||
|
Share.API.hashJWTHash (remoteBranch ^. #branchHead)
|
||||||
|
|
||||||
-- A couple example repo names derived from the project/branch names:
|
-- A couple example repo names derived from the project/branch names:
|
||||||
--
|
--
|
||||||
|
@ -58,6 +58,7 @@ import qualified Unison.Codebase as Codebase
|
|||||||
import qualified Unison.Debug as Debug
|
import qualified Unison.Debug as Debug
|
||||||
import Unison.Hash32 (Hash32)
|
import Unison.Hash32 (Hash32)
|
||||||
import Unison.Prelude
|
import Unison.Prelude
|
||||||
|
import qualified Unison.Share.API.Hash as Share
|
||||||
import Unison.Share.Sync.Types
|
import Unison.Share.Sync.Types
|
||||||
import qualified Unison.Sqlite as Sqlite
|
import qualified Unison.Sqlite as Sqlite
|
||||||
import qualified Unison.Sync.API as Share (API)
|
import qualified Unison.Sync.API as Share (API)
|
||||||
|
@ -51,6 +51,7 @@ dependencies:
|
|||||||
- unison-pretty-printer
|
- unison-pretty-printer
|
||||||
- unison-util-base32hex
|
- unison-util-base32hex
|
||||||
- unison-util-relation
|
- unison-util-relation
|
||||||
|
- unison-share-projects-api
|
||||||
- unison-sqlite
|
- unison-sqlite
|
||||||
- unison-syntax
|
- unison-syntax
|
||||||
- unliftio
|
- unliftio
|
||||||
|
@ -11,15 +11,6 @@ module Unison.Sync.Types
|
|||||||
pathRepoName,
|
pathRepoName,
|
||||||
pathCodebasePath,
|
pathCodebasePath,
|
||||||
|
|
||||||
-- ** Hash types
|
|
||||||
HashJWT (..),
|
|
||||||
hashJWTHash,
|
|
||||||
HashJWTClaims (..),
|
|
||||||
DecodedHashJWT (..),
|
|
||||||
decodeHashJWT,
|
|
||||||
decodeHashJWTClaims,
|
|
||||||
decodedHashJWTHash,
|
|
||||||
|
|
||||||
-- ** Entity types
|
-- ** Entity types
|
||||||
Entity (..),
|
Entity (..),
|
||||||
TermComponent (..),
|
TermComponent (..),
|
||||||
@ -87,6 +78,7 @@ import qualified Data.Map.Strict as Map
|
|||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
import Data.Set.NonEmpty (NESet)
|
import Data.Set.NonEmpty (NESet)
|
||||||
import qualified Data.Text as Text
|
import qualified Data.Text as Text
|
||||||
|
import Unison.Share.API.Hash (HashJWT)
|
||||||
import qualified Data.Text.Encoding as Text
|
import qualified Data.Text.Encoding as Text
|
||||||
import Servant.Auth.JWT
|
import Servant.Auth.JWT
|
||||||
import Unison.Hash32 (Hash32)
|
import Unison.Hash32 (Hash32)
|
||||||
@ -138,97 +130,6 @@ instance FromJSON Path where
|
|||||||
pathSegments <- obj .: "path"
|
pathSegments <- obj .: "path"
|
||||||
pure 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
|
-- Entity types
|
||||||
|
|
||||||
|
@ -110,6 +110,7 @@ library
|
|||||||
, unison-parser-typechecker
|
, unison-parser-typechecker
|
||||||
, unison-prelude
|
, unison-prelude
|
||||||
, unison-pretty-printer
|
, unison-pretty-printer
|
||||||
|
, unison-share-projects-api
|
||||||
, unison-sqlite
|
, unison-sqlite
|
||||||
, unison-syntax
|
, unison-syntax
|
||||||
, unison-util-base32hex
|
, unison-util-base32hex
|
||||||
|
@ -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
|
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.
|
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` ;)
|
||||||
|
@ -11,7 +11,12 @@ library:
|
|||||||
dependencies:
|
dependencies:
|
||||||
- aeson
|
- aeson
|
||||||
- base
|
- base
|
||||||
|
- containers
|
||||||
|
- jose
|
||||||
|
- jwt
|
||||||
|
- lens
|
||||||
- servant
|
- servant
|
||||||
|
- servant-auth
|
||||||
- text
|
- text
|
||||||
- unison-hash
|
- unison-hash
|
||||||
- unison-hash-orphans-aeson
|
- unison-hash-orphans-aeson
|
||||||
|
114
unison-share-projects-api/src/Unison/Share/API/Hash.hs
Normal file
114
unison-share-projects-api/src/Unison/Share/API/Hash.hs
Normal file
@ -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
|
@ -46,6 +46,7 @@ import Servant.API
|
|||||||
import Unison.Hash32 (Hash32)
|
import Unison.Hash32 (Hash32)
|
||||||
import Unison.Hash32.Orphans.Aeson ()
|
import Unison.Hash32.Orphans.Aeson ()
|
||||||
import Unison.Prelude
|
import Unison.Prelude
|
||||||
|
import Unison.Share.API.Hash (HashJWT)
|
||||||
|
|
||||||
type ProjectsAPI =
|
type ProjectsAPI =
|
||||||
GetProjectAPI
|
GetProjectAPI
|
||||||
@ -342,7 +343,7 @@ data ProjectBranch = ProjectBranch
|
|||||||
projectName :: Text,
|
projectName :: Text,
|
||||||
branchId :: Text,
|
branchId :: Text,
|
||||||
branchName :: Text,
|
branchName :: Text,
|
||||||
branchHead :: Hash32
|
branchHead :: HashJWT
|
||||||
}
|
}
|
||||||
deriving stock (Eq, Show, Generic)
|
deriving stock (Eq, Show, Generic)
|
||||||
|
|
||||||
|
@ -17,6 +17,7 @@ source-repository head
|
|||||||
|
|
||||||
library
|
library
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
|
Unison.Share.API.Hash
|
||||||
Unison.Share.API.Projects
|
Unison.Share.API.Projects
|
||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
src
|
src
|
||||||
@ -52,7 +53,12 @@ library
|
|||||||
build-depends:
|
build-depends:
|
||||||
aeson
|
aeson
|
||||||
, base
|
, base
|
||||||
|
, containers
|
||||||
|
, jose
|
||||||
|
, jwt
|
||||||
|
, lens
|
||||||
, servant
|
, servant
|
||||||
|
, servant-auth
|
||||||
, text
|
, text
|
||||||
, unison-hash
|
, unison-hash
|
||||||
, unison-hash-orphans-aeson
|
, unison-hash-orphans-aeson
|
||||||
|
Loading…
Reference in New Issue
Block a user