Compare commits
6 Commits
3441ab2bbb
...
master
Author | SHA1 | Date | |
---|---|---|---|
56e1823589 | |||
0cae4d898c | |||
c883efcf41 | |||
f2665335b3 | |||
e6cf2bc659 | |||
cdaf3339c8 |
2
.gitignore
vendored
2
.gitignore
vendored
@ -1,2 +1,2 @@
|
|||||||
result
|
result*
|
||||||
dist/
|
dist/
|
||||||
|
@ -52,7 +52,7 @@ executable rauhala-api
|
|||||||
hs-source-dirs: executables
|
hs-source-dirs: executables
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
executable generator
|
executable rauhala-api-js-gen
|
||||||
main-is: generator.hs
|
main-is: generator.hs
|
||||||
-- other-modules:
|
-- other-modules:
|
||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
|
@ -16,6 +16,7 @@ let
|
|||||||
_pkgs.binutils-unwrapped
|
_pkgs.binutils-unwrapped
|
||||||
haskellPackages.ghcid
|
haskellPackages.ghcid
|
||||||
haskellPackages.hasktags
|
haskellPackages.hasktags
|
||||||
|
haskellPackages.cabal-install
|
||||||
(haskellPackages.ghcWithHoogle (_: pkg.buildInputs ++ pkg.propagatedBuildInputs))
|
(haskellPackages.ghcWithHoogle (_: pkg.buildInputs ++ pkg.propagatedBuildInputs))
|
||||||
];
|
];
|
||||||
};
|
};
|
||||||
|
16
src/API.hs
16
src/API.hs
@ -5,16 +5,16 @@
|
|||||||
{-# Language OverloadedStrings #-}
|
{-# Language OverloadedStrings #-}
|
||||||
module API where
|
module API where
|
||||||
|
|
||||||
import Servant.API
|
import Servant.API
|
||||||
import ClassyPrelude
|
import ClassyPrelude
|
||||||
|
|
||||||
import qualified API.IPFS as IPFS
|
import qualified API.IPFS as IPFS
|
||||||
|
|
||||||
import Text.Pandoc.Readers.Markdown (readMarkdown)
|
import Network.HTTP.Media ((//), (/:))
|
||||||
import Text.Pandoc.Writers.HTML (writeHtml5String)
|
import Text.Pandoc.Class (runPure)
|
||||||
import Text.Pandoc.Class (runPure, PandocMonad)
|
import Text.Pandoc.Options (def)
|
||||||
import Text.Pandoc.Options (def)
|
import Text.Pandoc.Readers.Markdown (readMarkdown)
|
||||||
import Network.HTTP.Media ((//), (/:))
|
import Text.Pandoc.Writers.HTML (writeHtml5String)
|
||||||
|
|
||||||
data HTML
|
data HTML
|
||||||
|
|
||||||
@ -29,7 +29,7 @@ instance MimeRender HTML Docs where
|
|||||||
instance Accept HTML where
|
instance Accept HTML where
|
||||||
contentType _ = "text" // "html" /: ("charset", "utf-8")
|
contentType _ = "text" // "html" /: ("charset", "utf-8")
|
||||||
|
|
||||||
type API = "ipfs" :> IPFS.API
|
type API = "api" :> ("ipfs" :> IPFS.API)
|
||||||
|
|
||||||
type DocumentedAPI = API
|
type DocumentedAPI = API
|
||||||
:<|> "help" :> Get '[PlainText, HTML] Docs
|
:<|> "help" :> Get '[PlainText, HTML] Docs
|
||||||
|
@ -5,12 +5,10 @@
|
|||||||
module Server.IPFS where
|
module Server.IPFS where
|
||||||
|
|
||||||
import API.IPFS
|
import API.IPFS
|
||||||
import Servant
|
import ClassyPrelude hiding (hash)
|
||||||
import ClassyPrelude
|
|
||||||
|
|
||||||
import Network.DNS
|
|
||||||
|
|
||||||
import Control.Lens (over, _Left)
|
import Control.Lens (over, _Left)
|
||||||
|
import Network.DNS
|
||||||
|
import Servant
|
||||||
|
|
||||||
handler :: Server API
|
handler :: Server API
|
||||||
handler = liftIO getHash >>= either (const (throwError err500)) return
|
handler = liftIO getHash >>= either (const (throwError err500)) return
|
||||||
@ -23,6 +21,6 @@ handler = liftIO getHash >>= either (const (throwError err500)) return
|
|||||||
-- This is terrible
|
-- This is terrible
|
||||||
return (eTxt >>= maybe (Left "Could not find dnslink") Right . hash)
|
return (eTxt >>= maybe (Left "Could not find dnslink") Right . hash)
|
||||||
hash [x] = case x of
|
hash [x] = case x of
|
||||||
(stripPrefix "dnslink" -> Just h) -> Just . VersionHash . decodeUtf8 $ h
|
(stripPrefix "dnslink=" -> Just h) -> Just . VersionHash . decodeUtf8 $ h
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
hash _ = Nothing
|
hash _ = Nothing
|
||||||
|
Reference in New Issue
Block a user