fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

chore(versionbump): Adapted to changed upstream type signature of Servant.Server.Internal.CaptureRouter

Browse Source
This commit is contained in:
Stephan Barth 2024-10-08 03:28:44 +02:00
parent e87a9e5623
commit 8661932a28
1 changed files with 5 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Foundation/Servant.hs
View File

@ -36,6 +36,8 @@ import Database.Persist.Sql (transactionUndo)
import qualified Data.CaseInsensitive as CI
import GHC.TypeLits (symbolVal)
import Data.Typeable
instance ( HasServer sub context
, ToJSON restr, FromJSON restr
@ -108,13 +110,14 @@ instance ( HasServer sub context
, SBoolI (FoldLenient mods)
, FromHttpApiData ciphertext
, HasContextEntry context UniWorX
, KnownSymbol sym
) => HasServer (CaptureCryptoID' mods ciphertext sym plaintext :> sub) context where
type ServerT (CaptureCryptoID' mods ciphertext sym plaintext :> sub) m
= If (FoldLenient mods) (Either String plaintext) plaintext -> ServerT sub m
hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy @sub) pc nt . s
route _ context subserver = CaptureRouter .
route _ context subserver = CaptureRouter [hint] .
route (Proxy @sub) context . addCapture subserver $ \txt -> case ( sbool :: SBool (FoldLenient mods)
, decrypt' <$> parseUrlPiece txt
) of
@ -125,6 +128,7 @@ instance ( HasServer sub context
where
decrypt' :: CryptoID ciphertext plaintext -> Either Text plaintext
decrypt' inp = left tshow . runCatch . runReaderT (decrypt inp) . appCryptoIDKey $ getContextEntry context
hint = CaptureHint (Text.pack $ symbolVal $ Proxy @sym) (typeRep (Proxy :: Proxy sym)) -- from Servant.Server.Internal and modified for our usage
type UniWorXContext = Maybe (Route UniWorX) ': Maybe (BearerToken UniWorX) ': IsDryRun ': UniWorX ': '[]