update http servant for p2p protocol version 4
This is all just adding the v4 routes and boilerplate. At this point v4 is implemented the same as v3.
This commit is contained in:
parent
d782b136e0
commit
20df236a13
4 changed files with 79 additions and 45 deletions
13
P2P/Http.hs
13
P2P/Http.hs
|
@ -25,34 +25,44 @@ import Servant
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
|
|
||||||
type P2PHttpAPI
|
type P2PHttpAPI
|
||||||
= "git-annex" :> SU :> PV3 :> "key" :> GetAPI
|
= "git-annex" :> SU :> PV4 :> "key" :> GetAPI
|
||||||
|
:<|> "git-annex" :> SU :> PV3 :> "key" :> GetAPI
|
||||||
:<|> "git-annex" :> SU :> PV2 :> "key" :> GetAPI
|
:<|> "git-annex" :> SU :> PV2 :> "key" :> GetAPI
|
||||||
:<|> "git-annex" :> SU :> PV1 :> "key" :> GetAPI
|
:<|> "git-annex" :> SU :> PV1 :> "key" :> GetAPI
|
||||||
:<|> "git-annex" :> SU :> PV0 :> "key" :> GetAPI
|
:<|> "git-annex" :> SU :> PV0 :> "key" :> GetAPI
|
||||||
|
:<|> "git-annex" :> SU :> PV4 :> "checkpresent" :> CheckPresentAPI
|
||||||
:<|> "git-annex" :> SU :> PV3 :> "checkpresent" :> CheckPresentAPI
|
:<|> "git-annex" :> SU :> PV3 :> "checkpresent" :> CheckPresentAPI
|
||||||
:<|> "git-annex" :> SU :> PV2 :> "checkpresent" :> CheckPresentAPI
|
:<|> "git-annex" :> SU :> PV2 :> "checkpresent" :> CheckPresentAPI
|
||||||
:<|> "git-annex" :> SU :> PV1 :> "checkpresent" :> CheckPresentAPI
|
:<|> "git-annex" :> SU :> PV1 :> "checkpresent" :> CheckPresentAPI
|
||||||
:<|> "git-annex" :> SU :> PV0 :> "checkpresent" :> CheckPresentAPI
|
:<|> "git-annex" :> SU :> PV0 :> "checkpresent" :> CheckPresentAPI
|
||||||
|
:<|> "git-annex" :> SU :> PV4 :> "remove" :> RemoveAPI RemoveResultPlus
|
||||||
:<|> "git-annex" :> SU :> PV3 :> "remove" :> RemoveAPI RemoveResultPlus
|
:<|> "git-annex" :> SU :> PV3 :> "remove" :> RemoveAPI RemoveResultPlus
|
||||||
:<|> "git-annex" :> SU :> PV2 :> "remove" :> RemoveAPI RemoveResultPlus
|
:<|> "git-annex" :> SU :> PV2 :> "remove" :> RemoveAPI RemoveResultPlus
|
||||||
:<|> "git-annex" :> SU :> PV1 :> "remove" :> RemoveAPI RemoveResult
|
:<|> "git-annex" :> SU :> PV1 :> "remove" :> RemoveAPI RemoveResult
|
||||||
:<|> "git-annex" :> SU :> PV0 :> "remove" :> RemoveAPI RemoveResult
|
:<|> "git-annex" :> SU :> PV0 :> "remove" :> RemoveAPI RemoveResult
|
||||||
|
:<|> "git-annex" :> SU :> PV4 :> "remove-before" :> RemoveBeforeAPI
|
||||||
:<|> "git-annex" :> SU :> PV3 :> "remove-before" :> RemoveBeforeAPI
|
:<|> "git-annex" :> SU :> PV3 :> "remove-before" :> RemoveBeforeAPI
|
||||||
|
:<|> "git-annex" :> SU :> PV4 :> "gettimestamp" :> GetTimestampAPI
|
||||||
:<|> "git-annex" :> SU :> PV3 :> "gettimestamp" :> GetTimestampAPI
|
:<|> "git-annex" :> SU :> PV3 :> "gettimestamp" :> GetTimestampAPI
|
||||||
|
:<|> "git-annex" :> SU :> PV4 :> "put" :> PutAPI PutResultPlus
|
||||||
:<|> "git-annex" :> SU :> PV3 :> "put" :> PutAPI PutResultPlus
|
:<|> "git-annex" :> SU :> PV3 :> "put" :> PutAPI PutResultPlus
|
||||||
:<|> "git-annex" :> SU :> PV2 :> "put" :> PutAPI PutResultPlus
|
:<|> "git-annex" :> SU :> PV2 :> "put" :> PutAPI PutResultPlus
|
||||||
:<|> "git-annex" :> SU :> PV1 :> "put" :> PutAPI PutResult
|
:<|> "git-annex" :> SU :> PV1 :> "put" :> PutAPI PutResult
|
||||||
:<|> "git-annex" :> SU :> PV0 :> "put" :> PutAPI PutResult
|
:<|> "git-annex" :> SU :> PV0 :> "put" :> PutAPI PutResult
|
||||||
|
:<|> "git-annex" :> SU :> PV4 :> "putoffset"
|
||||||
|
:> PutOffsetAPI PutOffsetResultPlus
|
||||||
:<|> "git-annex" :> SU :> PV3 :> "putoffset"
|
:<|> "git-annex" :> SU :> PV3 :> "putoffset"
|
||||||
:> PutOffsetAPI PutOffsetResultPlus
|
:> PutOffsetAPI PutOffsetResultPlus
|
||||||
:<|> "git-annex" :> SU :> PV2 :> "putoffset"
|
:<|> "git-annex" :> SU :> PV2 :> "putoffset"
|
||||||
:> PutOffsetAPI PutOffsetResultPlus
|
:> PutOffsetAPI PutOffsetResultPlus
|
||||||
:<|> "git-annex" :> SU :> PV1 :> "putoffset"
|
:<|> "git-annex" :> SU :> PV1 :> "putoffset"
|
||||||
:> PutOffsetAPI PutOffsetResult
|
:> PutOffsetAPI PutOffsetResult
|
||||||
|
:<|> "git-annex" :> SU :> PV4 :> "lockcontent" :> LockContentAPI
|
||||||
:<|> "git-annex" :> SU :> PV3 :> "lockcontent" :> LockContentAPI
|
:<|> "git-annex" :> SU :> PV3 :> "lockcontent" :> LockContentAPI
|
||||||
:<|> "git-annex" :> SU :> PV2 :> "lockcontent" :> LockContentAPI
|
:<|> "git-annex" :> SU :> PV2 :> "lockcontent" :> LockContentAPI
|
||||||
:<|> "git-annex" :> SU :> PV1 :> "lockcontent" :> LockContentAPI
|
:<|> "git-annex" :> SU :> PV1 :> "lockcontent" :> LockContentAPI
|
||||||
:<|> "git-annex" :> SU :> PV0 :> "lockcontent" :> LockContentAPI
|
:<|> "git-annex" :> SU :> PV0 :> "lockcontent" :> LockContentAPI
|
||||||
|
:<|> "git-annex" :> SU :> PV4 :> "keeplocked" :> KeepLockedAPI
|
||||||
:<|> "git-annex" :> SU :> PV3 :> "keeplocked" :> KeepLockedAPI
|
:<|> "git-annex" :> SU :> PV3 :> "keeplocked" :> KeepLockedAPI
|
||||||
:<|> "git-annex" :> SU :> PV2 :> "keeplocked" :> KeepLockedAPI
|
:<|> "git-annex" :> SU :> PV2 :> "keeplocked" :> KeepLockedAPI
|
||||||
:<|> "git-annex" :> SU :> PV1 :> "keeplocked" :> KeepLockedAPI
|
:<|> "git-annex" :> SU :> PV1 :> "keeplocked" :> KeepLockedAPI
|
||||||
|
@ -177,6 +187,7 @@ type LockIDParam = QueryParam' '[Required] "lockid" LockID
|
||||||
|
|
||||||
type AuthHeader = Header "Authorization" Auth
|
type AuthHeader = Header "Authorization" Auth
|
||||||
|
|
||||||
|
type PV4 = Capture "v4" V4
|
||||||
type PV3 = Capture "v3" V3
|
type PV3 = Capture "v3" V3
|
||||||
type PV2 = Capture "v2" V2
|
type PV2 = Capture "v2" V2
|
||||||
type PV1 = Capture "v1" V1
|
type PV1 = Capture "v1" V1
|
||||||
|
|
|
@ -187,13 +187,14 @@ clientGet k af consumer startsz clientenv (ProtocolVersion ver) su cu bypass aut
|
||||||
if dl == len then Valid else Invalid
|
if dl == len then Valid else Invalid
|
||||||
where
|
where
|
||||||
cli =case ver of
|
cli =case ver of
|
||||||
|
4 -> v4 su V4
|
||||||
3 -> v3 su V3
|
3 -> v3 su V3
|
||||||
2 -> v2 su V2
|
2 -> v2 su V2
|
||||||
1 -> v1 su V1
|
1 -> v1 su V1
|
||||||
0 -> v0 su V0
|
0 -> v0 su V0
|
||||||
_ -> error "unsupported protocol version"
|
_ -> error "unsupported protocol version"
|
||||||
|
|
||||||
v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
|
v4 :<|> v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
|
||||||
|
|
||||||
gather = unsafeInterleaveIO . gather'
|
gather = unsafeInterleaveIO . gather'
|
||||||
gather' S.Stop = return LI.Empty
|
gather' S.Stop = return LI.Empty
|
||||||
|
@ -215,14 +216,15 @@ clientCheckPresent key clientenv (ProtocolVersion ver) su cu bypass auth =
|
||||||
Right (CheckPresentResult res) -> return (Right res)
|
Right (CheckPresentResult res) -> return (Right res)
|
||||||
where
|
where
|
||||||
cli = case ver of
|
cli = case ver of
|
||||||
|
4 -> flip v4 V4
|
||||||
3 -> flip v3 V3
|
3 -> flip v3 V3
|
||||||
2 -> flip v2 V2
|
2 -> flip v2 V2
|
||||||
1 -> flip v1 V1
|
1 -> flip v1 V1
|
||||||
0 -> flip v0 V0
|
0 -> flip v0 V0
|
||||||
_ -> error "unsupported protocol version"
|
_ -> error "unsupported protocol version"
|
||||||
|
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
|
v4 :<|> v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
|
||||||
#else
|
#else
|
||||||
clientCheckPresent _ = ()
|
clientCheckPresent _ = ()
|
||||||
#endif
|
#endif
|
||||||
|
@ -264,15 +266,16 @@ clientRemove k clientenv (ProtocolVersion ver) su cu bypass auth =
|
||||||
bk = B64Key k
|
bk = B64Key k
|
||||||
|
|
||||||
cli = case ver of
|
cli = case ver of
|
||||||
|
4 -> v4 su V4 bk cu bypass auth
|
||||||
3 -> v3 su V3 bk cu bypass auth
|
3 -> v3 su V3 bk cu bypass auth
|
||||||
2 -> v2 su V2 bk cu bypass auth
|
2 -> v2 su V2 bk cu bypass auth
|
||||||
1 -> plus <$> v1 su V1 bk cu bypass auth
|
1 -> plus <$> v1 su V1 bk cu bypass auth
|
||||||
0 -> plus <$> v0 su V0 bk cu bypass auth
|
0 -> plus <$> v0 su V0 bk cu bypass auth
|
||||||
_ -> error "unsupported protocol version"
|
_ -> error "unsupported protocol version"
|
||||||
|
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
|
v4 :<|> v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
|
||||||
#else
|
#else
|
||||||
clientRemove _ = ()
|
clientRemove _ = ()
|
||||||
#endif
|
#endif
|
||||||
|
@ -286,13 +289,14 @@ clientRemoveBefore k ts clientenv (ProtocolVersion ver) su cu bypass auth =
|
||||||
liftIO $ withClientM (cli su (B64Key k) cu bypass ts auth) clientenv return
|
liftIO $ withClientM (cli su (B64Key k) cu bypass ts auth) clientenv return
|
||||||
where
|
where
|
||||||
cli = case ver of
|
cli = case ver of
|
||||||
|
4 -> flip v4 V4
|
||||||
3 -> flip v3 V3
|
3 -> flip v3 V3
|
||||||
_ -> error "unsupported protocol version"
|
_ -> error "unsupported protocol version"
|
||||||
|
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|>_ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
v3 :<|> _ = client p2pHttpAPI
|
v4 :<|> v3 :<|> _ = client p2pHttpAPI
|
||||||
#else
|
#else
|
||||||
clientRemoveBefore _ _ = ()
|
clientRemoveBefore _ _ = ()
|
||||||
#endif
|
#endif
|
||||||
|
@ -303,14 +307,15 @@ clientGetTimestamp clientenv (ProtocolVersion ver) su cu bypass auth =
|
||||||
liftIO $ withClientM (cli su cu bypass auth) clientenv return
|
liftIO $ withClientM (cli su cu bypass auth) clientenv return
|
||||||
where
|
where
|
||||||
cli = case ver of
|
cli = case ver of
|
||||||
|
4 -> flip v4 V4
|
||||||
3 -> flip v3 V3
|
3 -> flip v3 V3
|
||||||
_ -> error "unsupported protocol version"
|
_ -> error "unsupported protocol version"
|
||||||
|
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
_ :<|>
|
_ :<|> _ :<|>
|
||||||
v3 :<|> _ = client p2pHttpAPI
|
v4 :<|> v3 :<|> _ = client p2pHttpAPI
|
||||||
#else
|
#else
|
||||||
clientGetTimestamp = ()
|
clientGetTimestamp = ()
|
||||||
#endif
|
#endif
|
||||||
|
@ -396,18 +401,19 @@ clientPut meterupdate k moffset af contentfile contentfilesize validitycheck cli
|
||||||
bk = B64Key k
|
bk = B64Key k
|
||||||
|
|
||||||
cli src = case ver of
|
cli src = case ver of
|
||||||
|
4 -> v4 su V4 len bk cu bypass baf moffset src auth
|
||||||
3 -> v3 su V3 len bk cu bypass baf moffset src auth
|
3 -> v3 su V3 len bk cu bypass baf moffset src auth
|
||||||
2 -> v2 su V2 len bk cu bypass baf moffset src auth
|
2 -> v2 su V2 len bk cu bypass baf moffset src auth
|
||||||
1 -> plus <$> v1 su V1 len bk cu bypass baf moffset src auth
|
1 -> plus <$> v1 su V1 len bk cu bypass baf moffset src auth
|
||||||
0 -> plus <$> v0 su V0 len bk cu bypass baf moffset src auth
|
0 -> plus <$> v0 su V0 len bk cu bypass baf moffset src auth
|
||||||
_ -> error "unsupported protocol version"
|
_ -> error "unsupported protocol version"
|
||||||
|
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
_ :<|>
|
_ :<|> _ :<|>
|
||||||
_ :<|>
|
_ :<|> _ :<|>
|
||||||
v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
|
v4 :<|> v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
|
||||||
#else
|
#else
|
||||||
clientPut _ _ _ _ _ _ _ = ()
|
clientPut _ _ _ _ _ _ _ = ()
|
||||||
#endif
|
#endif
|
||||||
|
@ -423,18 +429,19 @@ clientPutOffset k clientenv (ProtocolVersion ver) su cu bypass auth
|
||||||
bk = B64Key k
|
bk = B64Key k
|
||||||
|
|
||||||
cli = case ver of
|
cli = case ver of
|
||||||
|
4 -> v4 su V4 bk cu bypass auth
|
||||||
3 -> v3 su V3 bk cu bypass auth
|
3 -> v3 su V3 bk cu bypass auth
|
||||||
2 -> v2 su V2 bk cu bypass auth
|
2 -> v2 su V2 bk cu bypass auth
|
||||||
1 -> plus <$> v1 su V1 bk cu bypass auth
|
1 -> plus <$> v1 su V1 bk cu bypass auth
|
||||||
_ -> error "unsupported protocol version"
|
_ -> error "unsupported protocol version"
|
||||||
|
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
_ :<|>
|
_ :<|> _ :<|>
|
||||||
_ :<|>
|
_ :<|> _ :<|>
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
v3 :<|> v2 :<|> v1 :<|> _ = client p2pHttpAPI
|
v4 :<|> v3 :<|> v2 :<|> v1 :<|> _ = client p2pHttpAPI
|
||||||
#else
|
#else
|
||||||
clientPutOffset _ = ()
|
clientPutOffset _ = ()
|
||||||
#endif
|
#endif
|
||||||
|
@ -447,20 +454,21 @@ clientLockContent k clientenv (ProtocolVersion ver) su cu bypass auth =
|
||||||
liftIO $ withClientM (cli (B64Key k) cu bypass auth) clientenv return
|
liftIO $ withClientM (cli (B64Key k) cu bypass auth) clientenv return
|
||||||
where
|
where
|
||||||
cli = case ver of
|
cli = case ver of
|
||||||
|
4 -> v4 su V4
|
||||||
3 -> v3 su V3
|
3 -> v3 su V3
|
||||||
2 -> v2 su V2
|
2 -> v2 su V2
|
||||||
1 -> v1 su V1
|
1 -> v1 su V1
|
||||||
0 -> v0 su V0
|
0 -> v0 su V0
|
||||||
_ -> error "unsupported protocol version"
|
_ -> error "unsupported protocol version"
|
||||||
|
|
||||||
|
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
|
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
|
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
|
_ :<|> _ :<|>
|
||||||
|
_ :<|> _ :<|>
|
||||||
|
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
v4 :<|> v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
|
||||||
_ :<|>
|
|
||||||
_ :<|>
|
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
|
||||||
_ :<|> _ :<|> _ :<|>
|
|
||||||
v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
|
|
||||||
#else
|
#else
|
||||||
clientLockContent _ = ()
|
clientLockContent _ = ()
|
||||||
#endif
|
#endif
|
||||||
|
@ -518,21 +526,22 @@ clientKeepLocked lckid remoteuuid unablelock callback clientenv (ProtocolVersion
|
||||||
else S.Yield (UnlockRequest True) S.Stop
|
else S.Yield (UnlockRequest True) S.Stop
|
||||||
|
|
||||||
cli = case ver of
|
cli = case ver of
|
||||||
|
4 -> v4 su V4
|
||||||
3 -> v3 su V3
|
3 -> v3 su V3
|
||||||
2 -> v2 su V2
|
2 -> v2 su V2
|
||||||
1 -> v1 su V1
|
1 -> v1 su V1
|
||||||
0 -> v0 su V0
|
0 -> v0 su V0
|
||||||
_ -> error "unsupported protocol version"
|
_ -> error "unsupported protocol version"
|
||||||
|
|
||||||
|
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
|
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
|
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
|
_ :<|> _ :<|>
|
||||||
|
_ :<|> _ :<|>
|
||||||
|
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
v4 :<|> v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
|
||||||
_ :<|>
|
|
||||||
_ :<|>
|
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
|
||||||
_ :<|> _ :<|> _ :<|>
|
|
||||||
_ :<|> _ :<|> _ :<|> _ :<|>
|
|
||||||
v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
|
|
||||||
#else
|
#else
|
||||||
clientKeepLocked _ _ _ _ = ()
|
clientKeepLocked _ _ _ _ = ()
|
||||||
#endif
|
#endif
|
||||||
|
|
|
@ -53,27 +53,36 @@ serveP2pHttp st
|
||||||
:<|> serveGet st
|
:<|> serveGet st
|
||||||
:<|> serveGet st
|
:<|> serveGet st
|
||||||
:<|> serveGet st
|
:<|> serveGet st
|
||||||
|
:<|> serveGet st
|
||||||
:<|> serveCheckPresent st
|
:<|> serveCheckPresent st
|
||||||
:<|> serveCheckPresent st
|
:<|> serveCheckPresent st
|
||||||
:<|> serveCheckPresent st
|
:<|> serveCheckPresent st
|
||||||
:<|> serveCheckPresent st
|
:<|> serveCheckPresent st
|
||||||
|
:<|> serveCheckPresent st
|
||||||
|
:<|> serveRemove st id
|
||||||
:<|> serveRemove st id
|
:<|> serveRemove st id
|
||||||
:<|> serveRemove st id
|
:<|> serveRemove st id
|
||||||
:<|> serveRemove st dePlus
|
:<|> serveRemove st dePlus
|
||||||
:<|> serveRemove st dePlus
|
:<|> serveRemove st dePlus
|
||||||
:<|> serveRemoveBefore st
|
:<|> serveRemoveBefore st
|
||||||
|
:<|> serveRemoveBefore st
|
||||||
|
:<|> serveGetTimestamp st
|
||||||
:<|> serveGetTimestamp st
|
:<|> serveGetTimestamp st
|
||||||
:<|> servePut st id
|
:<|> servePut st id
|
||||||
:<|> servePut st id
|
:<|> servePut st id
|
||||||
|
:<|> servePut st id
|
||||||
:<|> servePut st dePlus
|
:<|> servePut st dePlus
|
||||||
:<|> servePut st dePlus
|
:<|> servePut st dePlus
|
||||||
:<|> servePutOffset st id
|
:<|> servePutOffset st id
|
||||||
:<|> servePutOffset st id
|
:<|> servePutOffset st id
|
||||||
|
:<|> servePutOffset st id
|
||||||
:<|> servePutOffset st dePlus
|
:<|> servePutOffset st dePlus
|
||||||
:<|> serveLockContent st
|
:<|> serveLockContent st
|
||||||
:<|> serveLockContent st
|
:<|> serveLockContent st
|
||||||
:<|> serveLockContent st
|
:<|> serveLockContent st
|
||||||
:<|> serveLockContent st
|
:<|> serveLockContent st
|
||||||
|
:<|> serveLockContent st
|
||||||
|
:<|> serveKeepLocked st
|
||||||
:<|> serveKeepLocked st
|
:<|> serveKeepLocked st
|
||||||
:<|> serveKeepLocked st
|
:<|> serveKeepLocked st
|
||||||
:<|> serveKeepLocked st
|
:<|> serveKeepLocked st
|
||||||
|
@ -125,10 +134,11 @@ serveGet st su apiver (B64Key k) cu bypass baf startat sec auth = do
|
||||||
return $ \v -> do
|
return $ \v -> do
|
||||||
liftIO $ atomically $ putTMVar validityv v
|
liftIO $ atomically $ putTMVar validityv v
|
||||||
return True
|
return True
|
||||||
|
let noothermessages = const Nothing
|
||||||
enteringStage (TransferStage Upload) $
|
enteringStage (TransferStage Upload) $
|
||||||
runFullProto (clientRunState conn) (clientP2PConnection conn) $
|
runFullProto (clientRunState conn) (clientP2PConnection conn) $
|
||||||
void $ receiveContent Nothing nullMeterUpdate
|
void $ receiveContent Nothing nullMeterUpdate
|
||||||
sizer storer getreq
|
sizer storer noothermessages getreq
|
||||||
void $ liftIO $ forkIO $ waitfinal endv finalv conn annexworker
|
void $ liftIO $ forkIO $ waitfinal endv finalv conn annexworker
|
||||||
(Len len, bs) <- liftIO $ atomically $ takeTMVar bsv
|
(Len len, bs) <- liftIO $ atomically $ takeTMVar bsv
|
||||||
bv <- liftIO $ newMVar (filter (not . B.null) (L.toChunks bs))
|
bv <- liftIO $ newMVar (filter (not . B.null) (L.toChunks bs))
|
||||||
|
|
|
@ -32,6 +32,7 @@ import Data.Char
|
||||||
import Control.DeepSeq
|
import Control.DeepSeq
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
|
|
||||||
|
data V4 = V4 deriving (Show)
|
||||||
data V3 = V3 deriving (Show)
|
data V3 = V3 deriving (Show)
|
||||||
data V2 = V2 deriving (Show)
|
data V2 = V2 deriving (Show)
|
||||||
data V1 = V1 deriving (Show)
|
data V1 = V1 deriving (Show)
|
||||||
|
@ -40,6 +41,7 @@ data V0 = V0 deriving (Show)
|
||||||
class APIVersion v where
|
class APIVersion v where
|
||||||
protocolVersion :: v -> P2P.ProtocolVersion
|
protocolVersion :: v -> P2P.ProtocolVersion
|
||||||
|
|
||||||
|
instance APIVersion V4 where protocolVersion _ = P2P.ProtocolVersion 4
|
||||||
instance APIVersion V3 where protocolVersion _ = P2P.ProtocolVersion 3
|
instance APIVersion V3 where protocolVersion _ = P2P.ProtocolVersion 3
|
||||||
instance APIVersion V2 where protocolVersion _ = P2P.ProtocolVersion 2
|
instance APIVersion V2 where protocolVersion _ = P2P.ProtocolVersion 2
|
||||||
instance APIVersion V1 where protocolVersion _ = P2P.ProtocolVersion 1
|
instance APIVersion V1 where protocolVersion _ = P2P.ProtocolVersion 1
|
||||||
|
@ -194,11 +196,13 @@ instance ToHttpApiData KeepAlive where
|
||||||
instance FromHttpApiData KeepAlive where
|
instance FromHttpApiData KeepAlive where
|
||||||
parseUrlPiece = Right . KeepAlive
|
parseUrlPiece = Right . KeepAlive
|
||||||
|
|
||||||
|
instance ToHttpApiData V4 where toUrlPiece _ = "v4"
|
||||||
instance ToHttpApiData V3 where toUrlPiece _ = "v3"
|
instance ToHttpApiData V3 where toUrlPiece _ = "v3"
|
||||||
instance ToHttpApiData V2 where toUrlPiece _ = "v2"
|
instance ToHttpApiData V2 where toUrlPiece _ = "v2"
|
||||||
instance ToHttpApiData V1 where toUrlPiece _ = "v1"
|
instance ToHttpApiData V1 where toUrlPiece _ = "v1"
|
||||||
instance ToHttpApiData V0 where toUrlPiece _ = "v0"
|
instance ToHttpApiData V0 where toUrlPiece _ = "v0"
|
||||||
|
|
||||||
|
instance FromHttpApiData V4 where parseUrlPiece = parseAPIVersion V4 "v4"
|
||||||
instance FromHttpApiData V3 where parseUrlPiece = parseAPIVersion V3 "v3"
|
instance FromHttpApiData V3 where parseUrlPiece = parseAPIVersion V3 "v3"
|
||||||
instance FromHttpApiData V2 where parseUrlPiece = parseAPIVersion V2 "v2"
|
instance FromHttpApiData V2 where parseUrlPiece = parseAPIVersion V2 "v2"
|
||||||
instance FromHttpApiData V1 where parseUrlPiece = parseAPIVersion V1 "v1"
|
instance FromHttpApiData V1 where parseUrlPiece = parseAPIVersion V1 "v1"
|
||||||
|
|
Loading…
Reference in a new issue