{-# LANGUAGE FlexibleContexts #-}

module Test.Cardano.CLI.Hash
  ( exampleAnchorDataHash
  , exampleAnchorDataHash2
  , serveFilesWhile
  , exampleAnchorDataPathTest
  , exampleAnchorDataPathTest2
  , exampleAnchorDataPathGolden
  , exampleAnchorDataPathGolden2
  , exampleAnchorDataIpfsHash
  , exampleAnchorDataIpfsHash2
  , tamperBase16Hash
  )
where

import           Cardano.Api (MonadIO)

import           Control.Concurrent (forkOS)
import           Control.Exception.Lifted (bracket)
import           Control.Monad (void)
import           Control.Monad.Trans.Control (MonadBaseControl)
import qualified Data.ByteString.UTF8 as BSU8
import           Data.Char (toLower)
import           Data.Foldable (find)
import           Data.List (elemIndex, intercalate)
import           Data.String (IsString (fromString))
import           Data.Text (unpack)
import qualified Data.Text as T
import           Network.HTTP.Types.Status (status200, status404)
import           Network.HTTP.Types.URI (renderQuery)
import           Network.Socket (close)
import           Network.Wai (Request (..), Response, ResponseReceived, pathInfo, responseFile,
                   responseLBS)
import           Network.Wai.Handler.Warp (defaultSettings, openFreePort, runSettingsSocket)

import           Hedgehog as H
import           Hedgehog.Internal.Source (HasCallStack)

exampleAnchorDataHash, exampleAnchorDataHash2 :: String
exampleAnchorDataHash :: String
exampleAnchorDataHash = String
"de38a4f5b8b9d8372386cc923bad19d1a0662298cf355bbe947e5eedf127fa9c"
exampleAnchorDataHash2 :: String
exampleAnchorDataHash2 = String
"8b4fda934272320ec8d11ba5a7904ab74686a8ec97f2c1331b68d11e28bda26f"

exampleAnchorDataPathGolden, exampleAnchorDataPathGolden2 :: String
exampleAnchorDataPathGolden :: String
exampleAnchorDataPathGolden = String
"test/cardano-cli-golden/files/input/example_anchor_data.txt"
exampleAnchorDataPathGolden2 :: String
exampleAnchorDataPathGolden2 = String
"test/cardano-cli-golden/files/input/example_anchor_data2.txt"

exampleAnchorDataPathTest, exampleAnchorDataPathTest2 :: String
exampleAnchorDataPathTest :: String
exampleAnchorDataPathTest = String
"test/cardano-cli-test/files/input/example_anchor_data.txt"
exampleAnchorDataPathTest2 :: String
exampleAnchorDataPathTest2 = String
"test/cardano-cli-golden/files/input/example_anchor_data2.txt"

exampleAnchorDataIpfsHash, exampleAnchorDataIpfsHash2 :: String
exampleAnchorDataIpfsHash :: String
exampleAnchorDataIpfsHash = String
"QmbL5EBFJLf8DdPkWAskG3Euin9tHY8naqQ2JDoHnWHHXJ"
exampleAnchorDataIpfsHash2 :: String
exampleAnchorDataIpfsHash2 = String
"QmdTJ4PabgSabg8K1Z4MNXnSVM8bjJnAikC3rVWfPVExQj"

-- | Tamper with the base16 hash by adding one to the first character
tamperBase16Hash :: String -> Maybe String
tamperBase16Hash :: String -> Maybe String
tamperBase16Hash [] = Maybe String
forall a. Maybe a
Nothing
tamperBase16Hash (Char
headChar : String
tailStr) =
  (Int -> String) -> Maybe Int -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\Int
i -> String
hexChars String -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!! ((Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
hexChars) Char -> String -> String
forall a. a -> [a] -> [a]
: String
lowerCaseRest)
    (Char -> String -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Char
lowerCaseHead String
hexChars)
 where
  lowerCaseHead :: Char
lowerCaseHead = Char -> Char
toLower Char
headChar
  lowerCaseRest :: String
lowerCaseRest = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
tailStr
  hexChars :: String
hexChars = [Char
'0' .. Char
'9'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
'a' .. Char
'f']

-- | Takes a relative url (as a list of segments), a file path, and an action, and it serves
-- the file in the url provided in a random free port that is passed as a parameter to the
-- action. After the action returns, it shuts down the server. It returns the result of the
-- action. It also ensures the server is shut down even if the action throws an exception.
serveFilesWhile
  :: (MonadBaseControl IO m, MonadTest m, MonadIO m, HasCallStack)
  => [([String], FilePath)]
  -- ^ List of pairs of a relative URL where a file will be served
  -- and the file path for the file to serve.
  -- Each element in the relative URL is a segment of the URL.
  -> (Int -> m a)
  -- ^ Action to run while the file is being served.
  -- It receives the port the server is listening on
  -> m a
serveFilesWhile :: forall (m :: * -> *) a.
(MonadBaseControl IO m, MonadTest m, MonadIO m, HasCallStack) =>
[([String], String)] -> (Int -> m a) -> m a
serveFilesWhile [([String], String)]
relativeUrls Int -> m a
action =
  m (Int, Socket)
-> ((Int, Socket) -> m ()) -> ((Int, Socket) -> m a) -> m a
forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
    -- Server setup (resource acquisition)
    ( do
        -- Get the port the server is listening on
        (Int
port, Socket
socket) <- IO (Int, Socket) -> m (Int, Socket)
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO IO (Int, Socket)
openFreePort
        -- Serve the file
        let app :: Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
            app :: Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
app Request
req Response -> IO ResponseReceived
respond = do
              let path :: [String]
path = Text -> String
T.unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> [Text]
pathInfo Request
req
              case (([String], String) -> Bool)
-> [([String], String)] -> Maybe ([String], String)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (([String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String]
path) ([String] -> Bool)
-> (([String], String) -> [String]) -> ([String], String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String], String) -> [String]
forall a b. (a, b) -> a
fst) [([String], String)]
relativeUrls of
                Just ([String]
_, String
filePath) ->
                  Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> String -> Maybe FilePart -> Response
responseFile Status
status200 [(HeaderName
"Content-Type", ByteString
"text/plain")] String
filePath Maybe FilePart
forall a. Maybe a
Nothing
                Maybe ([String], String)
Nothing ->
                  Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$
                    Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status404 [(HeaderName
"Content-Type", ByteString
"text/plain")] (ByteString -> Response) -> ByteString -> Response
forall a b. (a -> b) -> a -> b
$
                      String -> ByteString
forall a. IsString a => String -> a
fromString (String
"404 - Url \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Request -> String
urlFromRequest Request
req String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" - Not Found")

        -- Run server asynchronously in a separate thread
        m ThreadId -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m ThreadId -> m ()) -> m ThreadId -> m ()
forall a b. (a -> b) -> a -> b
$ IO ThreadId -> m ThreadId
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO (IO ThreadId -> m ThreadId) -> IO ThreadId -> m ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkOS (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Settings
-> Socket
-> (Request
    -> (Response -> IO ResponseReceived) -> IO ResponseReceived)
-> IO ()
runSettingsSocket Settings
defaultSettings Socket
socket Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
app
        (Int, Socket) -> m (Int, Socket)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
port, Socket
socket)
    )
    -- Server teardown (resource release)
    (\(Int
_, Socket
socket) -> IO () -> m ()
forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Socket -> IO ()
close Socket
socket)
    -- Test action
    (\(Int
port, Socket
_) -> Int -> m a
action Int
port)
 where
  urlFromRequest :: Request -> String
  urlFromRequest :: Request -> String
urlFromRequest Request
req =
    String
"http://"
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> (ByteString -> String) -> Maybe ByteString -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"localhost" ByteString -> String
BSU8.toString (Request -> Maybe ByteString
requestHeaderHost Request
req)
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/"
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"/" (Text -> String
unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> [Text]
pathInfo Request
req)
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
BSU8.toString (Bool -> Query -> ByteString
renderQuery Bool
True (Request -> Query
queryString Request
req))