module Main (main) where import qualified Data.ByteString as BS import qualified Data.Text as T import Network.Wai (Request) import Network.Wai.Handler.Warp (testWithApplication) import Nuthatch.Api import Nuthatch.Types import Servant import Servant.Server.Experimental.Auth ( AuthHandler , mkAuthHandler ) import Servant.Types.SourceT (source) import System.Process (callProcess) main :: IO () main = testWithApplication (pure application) $ \port -> callProcess "node" [ "web/test/contract-integration.mjs" , "http://127.0.0.1:" <> show port ] application :: Application application = serveWithContext (Proxy :: Proxy ProductApi) (authentication :. EmptyContext) productServer authentication :: AuthHandler Request SessionContext authentication = mkAuthHandler $ \_ -> pure SessionContext { sessionUser = SessionUser { suIssuer = "issuer" , suSubject = "subject" , suUserId = UserId "user-1" , suDisplay = Just "User" } , sessionCsrf = Just (CsrfToken "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa") } productServer :: Server ProductApi productServer = sessionHandler :<|> browseHandler :<|> downloadHandler :<|> uploadHandler :<|> deleteHandler :<|> deletePlanHandler :<|> deleteBatchHandler sessionHandler :: SessionContext -> Handler SessionResponse sessionHandler session = pure SessionResponse { sessionResponseUserId = suUserId (sessionUser session) , sessionResponseDisplay = suDisplay (sessionUser session) , sessionResponseCsrf = CsrfToken "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" } browseHandler :: SessionContext -> Maybe Root -> Maybe BrowsePrefix -> Maybe SearchQuery -> Maybe PaginationToken -> Handler BrowseResponse browseHandler _ _ prefix query continuation = pure BrowseResponse { browseEntries = [ EntryResponse { entryResponseName = maybe "root" browsePrefixName prefix , entryResponseIsPrefix = False , entryResponseSize = Just 3 , entryResponsePath = maybe "root" browsePrefixName prefix } ] , browseContinuation = continuation , browsePartial = maybe False (const True) query } where browsePrefixName (BrowsePrefix selected) = maybe "" unRelativePath selected downloadHandler :: SessionContext -> Root -> RelativePath -> Maybe T.Text -> Handler DownloadSuccess downloadHandler _ _ _ _ = pure $ addHeader "attachment; filename=\"file.txt\"" $ addHeader "nosniff" $ addHeader "default-src 'none'" $ addHeader 3 (source ["abc"]) uploadHandler :: SessionContext -> Root -> RelativePath -> OperationId -> DeclaredSize -> ContentSha256 -> CsrfToken -> SourceIO BS.ByteString -> Handler UploadResponse uploadHandler _ _ _ operation _ _ _ _ = pure UploadResponse { uploadResponseOperationId = operation , uploadResponseResult = MutationSucceeded , uploadResponseIdempotencyWindowSeconds = 3600 } deleteHandler :: SessionContext -> DeleteRequest -> Handler DeleteResponse deleteHandler _ request = pure DeleteResponse { deleteResponseOperationId = deleteOperationId request , deleteResponseResult = MutationSucceeded , deleteResponseIdempotencyWindowSeconds = 3600 } deletePlanHandler :: SessionContext -> Root -> RelativePath -> Maybe PaginationToken -> Handler DeletePlanResponse deletePlanHandler _ _ path continuation = pure DeletePlanResponse { deletePlanPaths = [path] , deletePlanContinuation = continuation } deleteBatchHandler :: SessionContext -> DeleteBatchRequest -> Handler DeleteBatchResponse deleteBatchHandler _ request = pure $ DeleteBatchResponse [ DeleteItemResponse { deleteItemPath = deleteBatchPath item , deleteItemOperationId = deleteBatchOperationId item , deleteItemOutcome = DeleteItemCompleted MutationSucceeded } | item <- deleteBatchItems request ]